Move all locking logic into thread.c.
[emacs.git] / src / buffer.c
blob05d498e19c7855605d8145ca1110db65de8d252c
1 /* Buffer manipulation primitives for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994,
3 1995, 1997, 1998, 1999, 2000, 2001, 2002,
4 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
5 Free Software Foundation, Inc.
7 This file is part of GNU Emacs.
9 GNU Emacs is free software: you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
14 GNU Emacs is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
22 #include <config.h>
24 #include <sys/types.h>
25 #include <sys/stat.h>
26 #include <sys/param.h>
27 #include <errno.h>
28 #include <stdio.h>
29 #include <setjmp.h>
31 #ifndef USE_CRT_DLL
32 extern int errno;
33 #endif
36 #ifdef HAVE_UNISTD_H
37 #include <unistd.h>
38 #endif
40 #include <pthread.h>
42 #include "lisp.h"
43 #include "intervals.h"
44 #include "window.h"
45 #include "commands.h"
46 #include "buffer.h"
47 #include "character.h"
48 #include "region-cache.h"
49 #include "indent.h"
50 #include "blockinput.h"
51 #include "keyboard.h"
52 #include "keymap.h"
53 #include "frame.h"
55 /* First buffer in chain of all buffers (in reverse order of creation).
56 Threaded through ->next. */
58 struct buffer *all_buffers;
60 /* This structure holds the default values of the buffer-local variables
61 defined with DEFVAR_PER_BUFFER, that have special slots in each buffer.
62 The default value occupies the same slot in this structure
63 as an individual buffer's value occupies in that buffer.
64 Setting the default value also goes through the alist of buffers
65 and stores into each buffer that does not say it has a local value. */
67 DECL_ALIGN (struct buffer, buffer_defaults);
69 /* A Lisp_Object pointer to the above, used for staticpro */
71 static Lisp_Object Vbuffer_defaults;
73 /* This structure marks which slots in a buffer have corresponding
74 default values in buffer_defaults.
75 Each such slot has a nonzero value in this structure.
76 The value has only one nonzero bit.
78 When a buffer has its own local value for a slot,
79 the entry for that slot (found in the same slot in this structure)
80 is turned on in the buffer's local_flags array.
82 If a slot in this structure is -1, then even though there may
83 be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
84 and the corresponding slot in buffer_defaults is not used.
86 If a slot is -2, then there is no DEFVAR_PER_BUFFER for it,
87 but there is a default value which is copied into each buffer.
89 If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is
90 zero, that is a bug */
92 struct buffer buffer_local_flags;
94 /* This structure holds the names of symbols whose values may be
95 buffer-local. It is indexed and accessed in the same way as the above. */
97 DECL_ALIGN (struct buffer, buffer_local_symbols);
99 /* A Lisp_Object pointer to the above, used for staticpro */
100 static Lisp_Object Vbuffer_local_symbols;
102 /* Flags indicating which built-in buffer-local variables
103 are permanent locals. */
104 static char buffer_permanent_local_flags[MAX_PER_BUFFER_VARS];
106 /* Number of per-buffer variables used. */
108 int last_per_buffer_idx;
110 EXFUN (Fset_buffer, 1);
111 void set_buffer_internal P_ ((struct buffer *b));
112 void set_buffer_internal_1 P_ ((struct buffer *b));
113 static void call_overlay_mod_hooks P_ ((Lisp_Object list, Lisp_Object overlay,
114 int after, Lisp_Object arg1,
115 Lisp_Object arg2, Lisp_Object arg3));
116 static void swap_out_buffer_local_variables P_ ((struct buffer *b));
117 static void reset_buffer_local_variables P_ ((struct buffer *b, int permanent_too));
119 /* Alist of all buffer names vs the buffers. */
120 /* This used to be a variable, but is no longer,
121 to prevent lossage due to user rplac'ing this alist or its elements. */
122 Lisp_Object Vbuffer_alist;
124 /* Functions to call before and after each text change. */
125 Lisp_Object impl_Vbefore_change_functions;
126 Lisp_Object impl_Vafter_change_functions;
128 Lisp_Object impl_Vtransient_mark_mode;
130 /* t means ignore all read-only text properties.
131 A list means ignore such a property if its value is a member of the list.
132 Any non-nil value means ignore buffer-read-only. */
133 Lisp_Object impl_Vinhibit_read_only;
135 /* List of functions to call that can query about killing a buffer.
136 If any of these functions returns nil, we don't kill it. */
137 Lisp_Object impl_Vkill_buffer_query_functions;
138 Lisp_Object Qkill_buffer_query_functions;
140 /* Hook run before changing a major mode. */
141 Lisp_Object impl_Vchange_major_mode_hook, Qchange_major_mode_hook;
143 /* List of functions to call before changing an unmodified buffer. */
144 Lisp_Object impl_Vfirst_change_hook;
146 Lisp_Object Qfirst_change_hook;
147 Lisp_Object Qbefore_change_functions;
148 Lisp_Object Qafter_change_functions;
149 Lisp_Object Qucs_set_table_for_input;
151 /* If nonzero, all modification hooks are suppressed. */
152 int inhibit_modification_hooks;
154 Lisp_Object Qfundamental_mode, Qmode_class, Qpermanent_local;
155 Lisp_Object Qpermanent_local_hook;
157 Lisp_Object Qprotected_field;
159 Lisp_Object QSFundamental; /* A string "Fundamental" */
161 Lisp_Object Qkill_buffer_hook;
163 Lisp_Object Qget_file_buffer;
165 Lisp_Object Qoverlayp;
167 Lisp_Object Qpriority, Qwindow, Qevaporate, Qbefore_string, Qafter_string;
169 Lisp_Object Qmodification_hooks;
170 Lisp_Object Qinsert_in_front_hooks;
171 Lisp_Object Qinsert_behind_hooks;
173 static void alloc_buffer_text P_ ((struct buffer *, size_t));
174 static void free_buffer_text P_ ((struct buffer *b));
175 static struct Lisp_Overlay * copy_overlays P_ ((struct buffer *, struct Lisp_Overlay *));
176 static void modify_overlay P_ ((struct buffer *, EMACS_INT, EMACS_INT));
177 static Lisp_Object buffer_lisp_local_variables P_ ((struct buffer *));
179 extern char * emacs_strerror P_ ((int));
181 /* For debugging; temporary. See set_buffer_internal. */
182 /* Lisp_Object Qlisp_mode, Vcheck_symbol; */
184 void
185 nsberror (spec)
186 Lisp_Object spec;
188 if (STRINGP (spec))
189 error ("No buffer named %s", SDATA (spec));
190 error ("Invalid buffer argument");
193 DEFUN ("buffer-live-p", Fbuffer_live_p, Sbuffer_live_p, 1, 1, 0,
194 doc: /* Return non-nil if OBJECT is a buffer which has not been killed.
195 Value is nil if OBJECT is not a buffer or if it has been killed. */)
196 (object)
197 Lisp_Object object;
199 return ((BUFFERP (object) && ! NILP (XBUFFER (object)->name))
200 ? Qt : Qnil);
203 DEFUN ("buffer-list", Fbuffer_list, Sbuffer_list, 0, 1, 0,
204 doc: /* Return a list of all existing live buffers.
205 If the optional arg FRAME is a frame, we return the buffer list
206 in the proper order for that frame: the buffers in FRAME's `buffer-list'
207 frame parameter come first, followed by the rest of the buffers. */)
208 (frame)
209 Lisp_Object frame;
211 Lisp_Object general;
212 general = Fmapcar (Qcdr, Vbuffer_alist);
214 if (FRAMEP (frame))
216 Lisp_Object framelist, prevlist, tail;
217 Lisp_Object args[3];
219 CHECK_FRAME (frame);
221 framelist = Fcopy_sequence (XFRAME (frame)->buffer_list);
222 prevlist = Fnreverse (Fcopy_sequence (XFRAME (frame)->buried_buffer_list));
224 /* Remove from GENERAL any buffer that duplicates one in
225 FRAMELIST or PREVLIST. */
226 tail = framelist;
227 while (CONSP (tail))
229 general = Fdelq (XCAR (tail), general);
230 tail = XCDR (tail);
232 tail = prevlist;
233 while (CONSP (tail))
235 general = Fdelq (XCAR (tail), general);
236 tail = XCDR (tail);
239 args[0] = framelist;
240 args[1] = general;
241 args[2] = prevlist;
242 return Fnconc (3, args);
245 return general;
248 /* Like Fassoc, but use Fstring_equal to compare
249 (which ignores text properties),
250 and don't ever QUIT. */
252 static Lisp_Object
253 assoc_ignore_text_properties (key, list)
254 register Lisp_Object key;
255 Lisp_Object list;
257 register Lisp_Object tail;
258 for (tail = list; CONSP (tail); tail = XCDR (tail))
260 register Lisp_Object elt, tem;
261 elt = XCAR (tail);
262 tem = Fstring_equal (Fcar (elt), key);
263 if (!NILP (tem))
264 return elt;
266 return Qnil;
269 DEFUN ("get-buffer", Fget_buffer, Sget_buffer, 1, 1, 0,
270 doc: /* Return the buffer named BUFFER-OR-NAME.
271 BUFFER-OR-NAME must be either a string or a buffer. If BUFFER-OR-NAME
272 is a string and there is no buffer with that name, return nil. If
273 BUFFER-OR-NAME is a buffer, return it as given. */)
274 (buffer_or_name)
275 register Lisp_Object buffer_or_name;
277 if (BUFFERP (buffer_or_name))
278 return buffer_or_name;
279 CHECK_STRING (buffer_or_name);
281 return Fcdr (assoc_ignore_text_properties (buffer_or_name, Vbuffer_alist));
284 DEFUN ("get-file-buffer", Fget_file_buffer, Sget_file_buffer, 1, 1, 0,
285 doc: /* Return the buffer visiting file FILENAME (a string).
286 The buffer's `buffer-file-name' must match exactly the expansion of FILENAME.
287 If there is no such live buffer, return nil.
288 See also `find-buffer-visiting'. */)
289 (filename)
290 register Lisp_Object filename;
292 register Lisp_Object tail, buf, tem;
293 Lisp_Object handler;
295 CHECK_STRING (filename);
296 filename = Fexpand_file_name (filename, Qnil);
298 /* If the file name has special constructs in it,
299 call the corresponding file handler. */
300 handler = Ffind_file_name_handler (filename, Qget_file_buffer);
301 if (!NILP (handler))
302 return call2 (handler, Qget_file_buffer, filename);
304 for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
306 buf = Fcdr (XCAR (tail));
307 if (!BUFFERP (buf)) continue;
308 if (!STRINGP (XBUFFER (buf)->filename)) continue;
309 tem = Fstring_equal (XBUFFER (buf)->filename, filename);
310 if (!NILP (tem))
311 return buf;
313 return Qnil;
316 Lisp_Object
317 get_truename_buffer (filename)
318 register Lisp_Object filename;
320 register Lisp_Object tail, buf, tem;
322 for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
324 buf = Fcdr (XCAR (tail));
325 if (!BUFFERP (buf)) continue;
326 if (!STRINGP (XBUFFER (buf)->file_truename)) continue;
327 tem = Fstring_equal (XBUFFER (buf)->file_truename, filename);
328 if (!NILP (tem))
329 return buf;
331 return Qnil;
334 DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 1, 0,
335 doc: /* Return the buffer specified by BUFFER-OR-NAME, creating a new one if needed.
336 If BUFFER-OR-NAME is a string and a live buffer with that name exists,
337 return that buffer. If no such buffer exists, create a new buffer with
338 that name and return it. If BUFFER-OR-NAME starts with a space, the new
339 buffer does not keep undo information.
341 If BUFFER-OR-NAME is a buffer instead of a string, return it as given,
342 even if it is dead. The return value is never nil. */)
343 (buffer_or_name)
344 register Lisp_Object buffer_or_name;
346 register Lisp_Object buffer, name;
347 register struct buffer *b;
349 buffer = Fget_buffer (buffer_or_name);
350 if (!NILP (buffer))
351 return buffer;
353 if (SCHARS (buffer_or_name) == 0)
354 error ("Empty string for buffer name is not allowed");
356 b = allocate_buffer ();
358 /* An ordinary buffer uses its own struct buffer_text. */
359 b->text = &b->own_text;
360 b->base_buffer = 0;
362 BUF_GAP_SIZE (b) = 20;
363 BLOCK_INPUT;
364 /* We allocate extra 1-byte at the tail and keep it always '\0' for
365 anchoring a search. */
366 alloc_buffer_text (b, BUF_GAP_SIZE (b) + 1);
367 UNBLOCK_INPUT;
368 if (! BUF_BEG_ADDR (b))
369 buffer_memory_full ();
371 BUF_PT (b) = BEG;
372 BUF_GPT (b) = BEG;
373 BUF_BEGV (b) = BEG;
374 BUF_ZV (b) = BEG;
375 BUF_Z (b) = BEG;
376 BUF_PT_BYTE (b) = BEG_BYTE;
377 BUF_GPT_BYTE (b) = BEG_BYTE;
378 BUF_BEGV_BYTE (b) = BEG_BYTE;
379 BUF_ZV_BYTE (b) = BEG_BYTE;
380 BUF_Z_BYTE (b) = BEG_BYTE;
381 BUF_MODIFF (b) = 1;
382 BUF_CHARS_MODIFF (b) = 1;
383 BUF_OVERLAY_MODIFF (b) = 1;
384 BUF_SAVE_MODIFF (b) = 1;
385 BUF_INTERVALS (b) = 0;
386 BUF_UNCHANGED_MODIFIED (b) = 1;
387 BUF_OVERLAY_UNCHANGED_MODIFIED (b) = 1;
388 BUF_END_UNCHANGED (b) = 0;
389 BUF_BEG_UNCHANGED (b) = 0;
390 *(BUF_GPT_ADDR (b)) = *(BUF_Z_ADDR (b)) = 0; /* Put an anchor '\0'. */
392 b->newline_cache = 0;
393 b->width_run_cache = 0;
394 b->width_table = Qnil;
395 b->prevent_redisplay_optimizations_p = 1;
397 /* Put this on the chain of all buffers including killed ones. */
398 b->next = all_buffers;
399 all_buffers = b;
401 /* An ordinary buffer normally doesn't need markers
402 to handle BEGV and ZV. */
403 b->pt_marker = Qnil;
404 b->begv_marker = Qnil;
405 b->zv_marker = Qnil;
407 name = Fcopy_sequence (buffer_or_name);
408 STRING_SET_INTERVALS (name, NULL_INTERVAL);
409 b->name = name;
411 b->undo_list = (SREF (name, 0) != ' ') ? Qnil : Qt;
413 reset_buffer (b);
414 reset_buffer_local_variables (b, 1);
416 b->mark = Fmake_marker ();
417 BUF_MARKERS (b) = NULL;
418 b->name = name;
419 b->owner = Qnil;
420 b->prev_owner = Qnil;
422 /* Put this in the alist of all live buffers. */
423 XSETBUFFER (buffer, b);
424 Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buffer), Qnil));
426 /* An error in calling the function here (should someone redefine it)
427 can lead to infinite regress until you run out of stack. rms
428 says that's not worth protecting against. */
429 if (!NILP (Ffboundp (Qucs_set_table_for_input)))
430 /* buffer is on buffer-alist, so no gcpro. */
431 call1 (Qucs_set_table_for_input, buffer);
433 return buffer;
437 /* Return a list of overlays which is a copy of the overlay list
438 LIST, but for buffer B. */
440 static struct Lisp_Overlay *
441 copy_overlays (b, list)
442 struct buffer *b;
443 struct Lisp_Overlay *list;
445 Lisp_Object buffer;
446 struct Lisp_Overlay *result = NULL, *tail = NULL;
448 XSETBUFFER (buffer, b);
450 for (; list; list = list->next)
452 Lisp_Object overlay, start, end, old_overlay;
453 EMACS_INT charpos;
455 XSETMISC (old_overlay, list);
456 charpos = marker_position (OVERLAY_START (old_overlay));
457 start = Fmake_marker ();
458 Fset_marker (start, make_number (charpos), buffer);
459 XMARKER (start)->insertion_type
460 = XMARKER (OVERLAY_START (old_overlay))->insertion_type;
462 charpos = marker_position (OVERLAY_END (old_overlay));
463 end = Fmake_marker ();
464 Fset_marker (end, make_number (charpos), buffer);
465 XMARKER (end)->insertion_type
466 = XMARKER (OVERLAY_END (old_overlay))->insertion_type;
468 overlay = allocate_misc ();
469 XMISCTYPE (overlay) = Lisp_Misc_Overlay;
470 OVERLAY_START (overlay) = start;
471 OVERLAY_END (overlay) = end;
472 OVERLAY_PLIST (overlay) = Fcopy_sequence (OVERLAY_PLIST (old_overlay));
473 XOVERLAY (overlay)->next = NULL;
475 if (tail)
476 tail = tail->next = XOVERLAY (overlay);
477 else
478 result = tail = XOVERLAY (overlay);
481 return result;
485 /* Clone per-buffer values of buffer FROM.
487 Buffer TO gets the same per-buffer values as FROM, with the
488 following exceptions: (1) TO's name is left untouched, (2) markers
489 are copied and made to refer to TO, and (3) overlay lists are
490 copied. */
492 static void
493 clone_per_buffer_values (from, to)
494 struct buffer *from, *to;
496 Lisp_Object to_buffer;
497 int offset;
499 XSETBUFFER (to_buffer, to);
501 /* buffer-local Lisp variables start at `undo_list',
502 tho only the ones from `name' on are GC'd normally. */
503 for (offset = PER_BUFFER_VAR_OFFSET (undo_list);
504 offset < sizeof *to;
505 offset += sizeof (Lisp_Object))
507 Lisp_Object obj;
509 /* Don't touch the `name' which should be unique for every buffer. */
510 if (offset == PER_BUFFER_VAR_OFFSET (name))
511 continue;
513 obj = PER_BUFFER_VALUE (from, offset);
514 if (MARKERP (obj))
516 struct Lisp_Marker *m = XMARKER (obj);
517 obj = Fmake_marker ();
518 XMARKER (obj)->insertion_type = m->insertion_type;
519 set_marker_both (obj, to_buffer, m->charpos, m->bytepos);
522 PER_BUFFER_VALUE (to, offset) = obj;
525 bcopy (from->local_flags, to->local_flags, sizeof to->local_flags);
527 to->overlays_before = copy_overlays (to, from->overlays_before);
528 to->overlays_after = copy_overlays (to, from->overlays_after);
530 /* Get (a copy of) the alist of Lisp-level local variables of FROM
531 and install that in TO. */
532 to->local_var_alist = buffer_lisp_local_variables (from);
535 DEFUN ("make-indirect-buffer", Fmake_indirect_buffer, Smake_indirect_buffer,
536 2, 3,
537 "bMake indirect buffer (to buffer): \nBName of indirect buffer: ",
538 doc: /* Create and return an indirect buffer for buffer BASE-BUFFER, named NAME.
539 BASE-BUFFER should be a live buffer, or the name of an existing buffer.
540 NAME should be a string which is not the name of an existing buffer.
541 Optional argument CLONE non-nil means preserve BASE-BUFFER's state,
542 such as major and minor modes, in the indirect buffer.
543 CLONE nil means the indirect buffer's state is reset to default values. */)
544 (base_buffer, name, clone)
545 Lisp_Object base_buffer, name, clone;
547 Lisp_Object buf, tem;
548 struct buffer *b;
550 CHECK_STRING (name);
551 buf = Fget_buffer (name);
552 if (!NILP (buf))
553 error ("Buffer name `%s' is in use", SDATA (name));
555 tem = base_buffer;
556 base_buffer = Fget_buffer (base_buffer);
557 if (NILP (base_buffer))
558 error ("No such buffer: `%s'", SDATA (tem));
559 if (NILP (XBUFFER (base_buffer)->name))
560 error ("Base buffer has been killed");
562 if (SCHARS (name) == 0)
563 error ("Empty string for buffer name is not allowed");
565 b = allocate_buffer ();
567 b->base_buffer = (XBUFFER (base_buffer)->base_buffer
568 ? XBUFFER (base_buffer)->base_buffer
569 : XBUFFER (base_buffer));
571 /* Use the base buffer's text object. */
572 b->text = b->base_buffer->text;
574 BUF_BEGV (b) = BUF_BEGV (b->base_buffer);
575 BUF_ZV (b) = BUF_ZV (b->base_buffer);
576 BUF_PT (b) = BUF_PT (b->base_buffer);
577 BUF_BEGV_BYTE (b) = BUF_BEGV_BYTE (b->base_buffer);
578 BUF_ZV_BYTE (b) = BUF_ZV_BYTE (b->base_buffer);
579 BUF_PT_BYTE (b) = BUF_PT_BYTE (b->base_buffer);
581 b->newline_cache = 0;
582 b->width_run_cache = 0;
583 b->width_table = Qnil;
585 /* Put this on the chain of all buffers including killed ones. */
586 b->next = all_buffers;
587 all_buffers = b;
589 name = Fcopy_sequence (name);
590 STRING_SET_INTERVALS (name, NULL_INTERVAL);
591 b->name = name;
593 reset_buffer (b);
594 reset_buffer_local_variables (b, 1);
596 /* Put this in the alist of all live buffers. */
597 XSETBUFFER (buf, b);
598 Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));
600 b->mark = Fmake_marker ();
601 b->name = name;
602 b->owner = Qnil;
604 /* The multibyte status belongs to the base buffer. */
605 b->enable_multibyte_characters = b->base_buffer->enable_multibyte_characters;
607 /* Make sure the base buffer has markers for its narrowing. */
608 if (NILP (b->base_buffer->pt_marker))
610 b->base_buffer->pt_marker = Fmake_marker ();
611 set_marker_both (b->base_buffer->pt_marker, base_buffer,
612 BUF_PT (b->base_buffer),
613 BUF_PT_BYTE (b->base_buffer));
615 if (NILP (b->base_buffer->begv_marker))
617 b->base_buffer->begv_marker = Fmake_marker ();
618 set_marker_both (b->base_buffer->begv_marker, base_buffer,
619 BUF_BEGV (b->base_buffer),
620 BUF_BEGV_BYTE (b->base_buffer));
622 if (NILP (b->base_buffer->zv_marker))
624 b->base_buffer->zv_marker = Fmake_marker ();
625 set_marker_both (b->base_buffer->zv_marker, base_buffer,
626 BUF_ZV (b->base_buffer),
627 BUF_ZV_BYTE (b->base_buffer));
628 XMARKER (b->base_buffer->zv_marker)->insertion_type = 1;
631 if (NILP (clone))
633 /* Give the indirect buffer markers for its narrowing. */
634 b->pt_marker = Fmake_marker ();
635 set_marker_both (b->pt_marker, buf, BUF_PT (b), BUF_PT_BYTE (b));
636 b->begv_marker = Fmake_marker ();
637 set_marker_both (b->begv_marker, buf, BUF_BEGV (b), BUF_BEGV_BYTE (b));
638 b->zv_marker = Fmake_marker ();
639 set_marker_both (b->zv_marker, buf, BUF_ZV (b), BUF_ZV_BYTE (b));
640 XMARKER (b->zv_marker)->insertion_type = 1;
642 else
644 struct buffer *old_b = current_buffer;
646 clone_per_buffer_values (b->base_buffer, b);
647 b->filename = Qnil;
648 b->file_truename = Qnil;
649 b->display_count = make_number (0);
650 b->backed_up = Qnil;
651 b->auto_save_file_name = Qnil;
652 set_buffer_internal_1 (b);
653 Fset (intern ("buffer-save-without-query"), Qnil);
654 Fset (intern ("buffer-file-number"), Qnil);
655 Fset (intern ("buffer-stale-function"), Qnil);
656 set_buffer_internal_1 (old_b);
659 return buf;
662 void
663 delete_all_overlays (b)
664 struct buffer *b;
666 Lisp_Object overlay;
668 /* `reset_buffer' blindly sets the list of overlays to NULL, so we
669 have to empty the list, otherwise we end up with overlays that
670 think they belong to this buffer while the buffer doesn't know about
671 them any more. */
672 while (b->overlays_before)
674 XSETMISC (overlay, b->overlays_before);
675 Fdelete_overlay (overlay);
677 while (b->overlays_after)
679 XSETMISC (overlay, b->overlays_after);
680 Fdelete_overlay (overlay);
682 eassert (b->overlays_before == NULL);
683 eassert (b->overlays_after == NULL);
686 /* Reinitialize everything about a buffer except its name and contents
687 and local variables.
688 If called on an already-initialized buffer, the list of overlays
689 should be deleted before calling this function, otherwise we end up
690 with overlays that claim to belong to the buffer but the buffer
691 claims it doesn't belong to it. */
693 void
694 reset_buffer (b)
695 register struct buffer *b;
697 b->filename = Qnil;
698 b->file_truename = Qnil;
699 b->directory = (current_buffer) ? current_buffer->directory : Qnil;
700 b->modtime = 0;
701 XSETFASTINT (b->save_length, 0);
702 b->last_window_start = 1;
703 /* It is more conservative to start out "changed" than "unchanged". */
704 b->clip_changed = 0;
705 b->prevent_redisplay_optimizations_p = 1;
706 b->backed_up = Qnil;
707 BUF_AUTOSAVE_MODIFF (b) = 0;
708 b->auto_save_failure_time = -1;
709 b->auto_save_file_name = Qnil;
710 b->read_only = Qnil;
711 b->overlays_before = NULL;
712 b->overlays_after = NULL;
713 b->overlay_center = BEG;
714 b->mark_active = Qnil;
715 b->point_before_scroll = Qnil;
716 b->file_format = Qnil;
717 b->auto_save_file_format = Qt;
718 b->last_selected_window = Qnil;
719 XSETINT (b->display_count, 0);
720 b->display_time = Qnil;
721 b->enable_multibyte_characters = buffer_defaults.enable_multibyte_characters;
722 b->cursor_type = buffer_defaults.cursor_type;
723 b->extra_line_spacing = buffer_defaults.extra_line_spacing;
725 b->display_error_modiff = 0;
728 /* Reset buffer B's local variables info.
729 Don't use this on a buffer that has already been in use;
730 it does not treat permanent locals consistently.
731 Instead, use Fkill_all_local_variables.
733 If PERMANENT_TOO is 1, then we reset permanent
734 buffer-local variables. If PERMANENT_TOO is 0,
735 we preserve those. */
737 static void
738 reset_buffer_local_variables (b, permanent_too)
739 register struct buffer *b;
740 int permanent_too;
742 register int offset;
743 int i;
745 /* Reset the major mode to Fundamental, together with all the
746 things that depend on the major mode.
747 default-major-mode is handled at a higher level.
748 We ignore it here. */
749 b->major_mode = Qfundamental_mode;
750 b->keymap = Qnil;
751 b->mode_name = QSFundamental;
752 b->minor_modes = Qnil;
754 /* If the standard case table has been altered and invalidated,
755 fix up its insides first. */
756 if (! (CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[0])
757 && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[1])
758 && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[2])))
759 Fset_standard_case_table (Vascii_downcase_table);
761 b->downcase_table = Vascii_downcase_table;
762 b->upcase_table = XCHAR_TABLE (Vascii_downcase_table)->extras[0];
763 b->case_canon_table = XCHAR_TABLE (Vascii_downcase_table)->extras[1];
764 b->case_eqv_table = XCHAR_TABLE (Vascii_downcase_table)->extras[2];
765 b->invisibility_spec = Qt;
766 #ifndef DOS_NT
767 b->buffer_file_type = Qnil;
768 #endif
770 /* Reset all (or most) per-buffer variables to their defaults. */
771 if (permanent_too)
772 b->local_var_alist = Qnil;
773 else
775 Lisp_Object tmp, prop, last = Qnil;
776 for (tmp = b->local_var_alist; CONSP (tmp); tmp = XCDR (tmp))
777 if (CONSP (XCAR (tmp))
778 && SYMBOLP (XCAR (XCAR (tmp)))
779 && !NILP (prop = Fget (XCAR (XCAR (tmp)), Qpermanent_local)))
781 /* If permanent-local, keep it. */
782 last = tmp;
783 if (EQ (prop, Qpermanent_local_hook))
785 /* This is a partially permanent hook variable.
786 Preserve only the elements that want to be preserved. */
787 Lisp_Object list, newlist;
788 list = XCDR (XCAR (tmp));
789 if (!CONSP (list))
790 newlist = list;
791 else
792 for (newlist = Qnil; CONSP (list); list = XCDR (list))
794 Lisp_Object elt = XCAR (list);
795 /* Preserve element ELT if it's t,
796 if it is a function with a `permanent-local-hook' property,
797 or if it's not a symbol. */
798 if (! SYMBOLP (elt)
799 || EQ (elt, Qt)
800 || !NILP (Fget (elt, Qpermanent_local_hook)))
801 newlist = Fcons (elt, newlist);
803 XSETCDR (XCAR (tmp), Fnreverse (newlist));
806 /* Delete this local variable. */
807 else if (NILP (last))
808 b->local_var_alist = XCDR (tmp);
809 else
810 XSETCDR (last, XCDR (tmp));
813 for (i = 0; i < last_per_buffer_idx; ++i)
814 if (permanent_too || buffer_permanent_local_flags[i] == 0)
815 SET_PER_BUFFER_VALUE_P (b, i, 0);
817 /* For each slot that has a default value,
818 copy that into the slot. */
820 /* buffer-local Lisp variables start at `undo_list',
821 tho only the ones from `name' on are GC'd normally. */
822 for (offset = PER_BUFFER_VAR_OFFSET (undo_list);
823 offset < sizeof *b;
824 offset += sizeof (Lisp_Object))
826 int idx = PER_BUFFER_IDX (offset);
827 if ((idx > 0
828 && (permanent_too
829 || buffer_permanent_local_flags[idx] == 0))
830 /* Is -2 used anywhere? */
831 || idx == -2)
832 PER_BUFFER_VALUE (b, offset) = PER_BUFFER_DEFAULT (offset);
836 /* We split this away from generate-new-buffer, because rename-buffer
837 and set-visited-file-name ought to be able to use this to really
838 rename the buffer properly. */
840 DEFUN ("generate-new-buffer-name", Fgenerate_new_buffer_name, Sgenerate_new_buffer_name,
841 1, 2, 0,
842 doc: /* Return a string that is the name of no existing buffer based on NAME.
843 If there is no live buffer named NAME, then return NAME.
844 Otherwise modify name by appending `<NUMBER>', incrementing NUMBER
845 \(starting at 2) until an unused name is found, and then return that name.
846 Optional second argument IGNORE specifies a name that is okay to use (if
847 it is in the sequence to be tried) even if a buffer with that name exists. */)
848 (name, ignore)
849 register Lisp_Object name, ignore;
851 register Lisp_Object gentemp, tem;
852 int count;
853 char number[10];
855 CHECK_STRING (name);
857 tem = Fstring_equal (name, ignore);
858 if (!NILP (tem))
859 return name;
860 tem = Fget_buffer (name);
861 if (NILP (tem))
862 return name;
864 count = 1;
865 while (1)
867 sprintf (number, "<%d>", ++count);
868 gentemp = concat2 (name, build_string (number));
869 tem = Fstring_equal (gentemp, ignore);
870 if (!NILP (tem))
871 return gentemp;
872 tem = Fget_buffer (gentemp);
873 if (NILP (tem))
874 return gentemp;
879 DEFUN ("buffer-name", Fbuffer_name, Sbuffer_name, 0, 1, 0,
880 doc: /* Return the name of BUFFER, as a string.
881 BUFFER defaults to the current buffer.
882 Return nil if BUFFER has been killed. */)
883 (buffer)
884 register Lisp_Object buffer;
886 if (NILP (buffer))
887 return current_buffer->name;
888 CHECK_BUFFER (buffer);
889 return XBUFFER (buffer)->name;
892 DEFUN ("buffer-file-name", Fbuffer_file_name, Sbuffer_file_name, 0, 1, 0,
893 doc: /* Return name of file BUFFER is visiting, or nil if none.
894 No argument or nil as argument means use the current buffer. */)
895 (buffer)
896 register Lisp_Object buffer;
898 if (NILP (buffer))
899 return current_buffer->filename;
900 CHECK_BUFFER (buffer);
901 return XBUFFER (buffer)->filename;
904 DEFUN ("buffer-base-buffer", Fbuffer_base_buffer, Sbuffer_base_buffer,
905 0, 1, 0,
906 doc: /* Return the base buffer of indirect buffer BUFFER.
907 If BUFFER is not indirect, return nil.
908 BUFFER defaults to the current buffer. */)
909 (buffer)
910 register Lisp_Object buffer;
912 struct buffer *base;
913 Lisp_Object base_buffer;
915 if (NILP (buffer))
916 base = current_buffer->base_buffer;
917 else
919 CHECK_BUFFER (buffer);
920 base = XBUFFER (buffer)->base_buffer;
923 if (! base)
924 return Qnil;
925 XSETBUFFER (base_buffer, base);
926 return base_buffer;
929 DEFUN ("buffer-local-value", Fbuffer_local_value,
930 Sbuffer_local_value, 2, 2, 0,
931 doc: /* Return the value of VARIABLE in BUFFER.
932 If VARIABLE does not have a buffer-local binding in BUFFER, the value
933 is the default binding of the variable. */)
934 (variable, buffer)
935 register Lisp_Object variable;
936 register Lisp_Object buffer;
938 register struct buffer *buf;
939 register Lisp_Object result;
940 struct Lisp_Symbol *sym;
942 CHECK_SYMBOL (variable);
943 CHECK_BUFFER (buffer);
944 buf = XBUFFER (buffer);
946 sym = indirect_variable (XSYMBOL (variable));
947 XSETSYMBOL (variable, sym);
949 /* Look in local_var_list */
950 result = Fassoc (variable, buf->local_var_alist);
951 if (NILP (result))
953 int offset, idx;
954 int found = 0;
956 /* Look in special slots */
957 /* buffer-local Lisp variables start at `undo_list',
958 tho only the ones from `name' on are GC'd normally. */
959 for (offset = PER_BUFFER_VAR_OFFSET (undo_list);
960 offset < sizeof (struct buffer);
961 /* sizeof EMACS_INT == sizeof Lisp_Object */
962 offset += (sizeof (EMACS_INT)))
964 idx = PER_BUFFER_IDX (offset);
965 if ((idx == -1 || PER_BUFFER_VALUE_P (buf, idx))
966 && SYMBOLP (PER_BUFFER_SYMBOL (offset))
967 && EQ (PER_BUFFER_SYMBOL (offset), variable))
969 result = PER_BUFFER_VALUE (buf, offset);
970 found = 1;
971 break;
975 if (!found)
976 result = Fdefault_value (variable);
978 else
980 Lisp_Object valcontents;
981 Lisp_Object current_alist_element;
983 /* What binding is loaded right now? */
984 valcontents = sym->value;
985 current_alist_element
986 = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr);
988 /* The value of the currently loaded binding is not
989 stored in it, but rather in the realvalue slot.
990 Store that value into the binding it belongs to
991 in case that is the one we are about to use. */
993 Fsetcdr (current_alist_element,
994 do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue));
996 /* Now get the (perhaps updated) value out of the binding. */
997 result = XCDR (result);
1000 if (!EQ (result, Qunbound))
1001 return result;
1003 xsignal1 (Qvoid_variable, variable);
1006 /* Return an alist of the Lisp-level buffer-local bindings of
1007 buffer BUF. That is, don't include the variables maintained
1008 in special slots in the buffer object. */
1010 static Lisp_Object
1011 buffer_lisp_local_variables (buf)
1012 struct buffer *buf;
1014 Lisp_Object result = Qnil;
1015 register Lisp_Object tail;
1016 for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail))
1018 Lisp_Object val, elt;
1020 elt = XCAR (tail);
1022 /* Reference each variable in the alist in buf.
1023 If inquiring about the current buffer, this gets the current values,
1024 so store them into the alist so the alist is up to date.
1025 If inquiring about some other buffer, this swaps out any values
1026 for that buffer, making the alist up to date automatically. */
1027 val = find_symbol_value (XCAR (elt));
1028 /* Use the current buffer value only if buf is the current buffer. */
1029 if (buf != current_buffer)
1030 val = XCDR (elt);
1032 /* If symbol is unbound, put just the symbol in the list. */
1033 if (EQ (val, Qunbound))
1034 result = Fcons (XCAR (elt), result);
1035 /* Otherwise, put (symbol . value) in the list. */
1036 else
1037 result = Fcons (Fcons (XCAR (elt), val), result);
1040 return result;
1043 DEFUN ("buffer-local-variables", Fbuffer_local_variables,
1044 Sbuffer_local_variables, 0, 1, 0,
1045 doc: /* Return an alist of variables that are buffer-local in BUFFER.
1046 Most elements look like (SYMBOL . VALUE), describing one variable.
1047 For a symbol that is locally unbound, just the symbol appears in the value.
1048 Note that storing new VALUEs in these elements doesn't change the variables.
1049 No argument or nil as argument means use current buffer as BUFFER. */)
1050 (buffer)
1051 register Lisp_Object buffer;
1053 register struct buffer *buf;
1054 register Lisp_Object result;
1056 if (NILP (buffer))
1057 buf = current_buffer;
1058 else
1060 CHECK_BUFFER (buffer);
1061 buf = XBUFFER (buffer);
1064 result = buffer_lisp_local_variables (buf);
1066 /* Add on all the variables stored in special slots. */
1068 int offset, idx;
1070 /* buffer-local Lisp variables start at `undo_list',
1071 tho only the ones from `name' on are GC'd normally. */
1072 for (offset = PER_BUFFER_VAR_OFFSET (undo_list);
1073 offset < sizeof (struct buffer);
1074 /* sizeof EMACS_INT == sizeof Lisp_Object */
1075 offset += (sizeof (EMACS_INT)))
1077 idx = PER_BUFFER_IDX (offset);
1078 if ((idx == -1 || PER_BUFFER_VALUE_P (buf, idx))
1079 && SYMBOLP (PER_BUFFER_SYMBOL (offset)))
1080 result = Fcons (Fcons (PER_BUFFER_SYMBOL (offset),
1081 PER_BUFFER_VALUE (buf, offset)),
1082 result);
1086 return result;
1089 DEFUN ("buffer-modified-p", Fbuffer_modified_p, Sbuffer_modified_p,
1090 0, 1, 0,
1091 doc: /* Return t if BUFFER was modified since its file was last read or saved.
1092 No argument or nil as argument means use current buffer as BUFFER. */)
1093 (buffer)
1094 register Lisp_Object buffer;
1096 register struct buffer *buf;
1097 if (NILP (buffer))
1098 buf = current_buffer;
1099 else
1101 CHECK_BUFFER (buffer);
1102 buf = XBUFFER (buffer);
1105 return BUF_SAVE_MODIFF (buf) < BUF_MODIFF (buf) ? Qt : Qnil;
1108 DEFUN ("set-buffer-modified-p", Fset_buffer_modified_p, Sset_buffer_modified_p,
1109 1, 1, 0,
1110 doc: /* Mark current buffer as modified or unmodified according to FLAG.
1111 A non-nil FLAG means mark the buffer modified. */)
1112 (flag)
1113 register Lisp_Object flag;
1115 register int already;
1116 register Lisp_Object fn;
1117 Lisp_Object buffer, window;
1119 #ifdef CLASH_DETECTION
1120 /* If buffer becoming modified, lock the file.
1121 If buffer becoming unmodified, unlock the file. */
1123 fn = current_buffer->file_truename;
1124 /* Test buffer-file-name so that binding it to nil is effective. */
1125 if (!NILP (fn) && ! NILP (current_buffer->filename))
1127 already = SAVE_MODIFF < MODIFF;
1128 if (!already && !NILP (flag))
1129 lock_file (fn);
1130 else if (already && NILP (flag))
1131 unlock_file (fn);
1133 #endif /* CLASH_DETECTION */
1135 /* Here we have a problem. SAVE_MODIFF is used here to encode
1136 buffer-modified-p (as SAVE_MODIFF<MODIFF) as well as
1137 recent-auto-save-p (as SAVE_MODIFF<auto_save_modified). So if we
1138 modify SAVE_MODIFF to affect one, we may affect the other
1139 as well.
1140 E.g. if FLAG is nil we need to set SAVE_MODIFF to MODIFF, but
1141 if SAVE_MODIFF<auto_save_modified that means we risk changing
1142 recent-auto-save-p from t to nil.
1143 Vice versa, if FLAG is non-nil and SAVE_MODIFF>=auto_save_modified
1144 we risk changing recent-auto-save-p from nil to t. */
1145 SAVE_MODIFF = (NILP (flag)
1146 /* FIXME: This unavoidably sets recent-auto-save-p to nil. */
1147 ? MODIFF
1148 /* Let's try to preserve recent-auto-save-p. */
1149 : SAVE_MODIFF < MODIFF ? SAVE_MODIFF
1150 /* If SAVE_MODIFF == auto_save_modified == MODIFF,
1151 we can either decrease SAVE_MODIFF and auto_save_modified
1152 or increase MODIFF. */
1153 : MODIFF++);
1155 /* Set update_mode_lines only if buffer is displayed in some window.
1156 Packages like jit-lock or lazy-lock preserve a buffer's modified
1157 state by recording/restoring the state around blocks of code.
1158 Setting update_mode_lines makes redisplay consider all windows
1159 (on all frames). Stealth fontification of buffers not displayed
1160 would incur additional redisplay costs if we'd set
1161 update_modes_lines unconditionally.
1163 Ideally, I think there should be another mechanism for fontifying
1164 buffers without "modifying" buffers, or redisplay should be
1165 smarter about updating the `*' in mode lines. --gerd */
1166 XSETBUFFER (buffer, current_buffer);
1167 window = Fget_buffer_window (buffer, Qt);
1168 if (WINDOWP (window))
1170 ++update_mode_lines;
1171 current_buffer->prevent_redisplay_optimizations_p = 1;
1174 return flag;
1177 DEFUN ("restore-buffer-modified-p", Frestore_buffer_modified_p,
1178 Srestore_buffer_modified_p, 1, 1, 0,
1179 doc: /* Like `set-buffer-modified-p', with a difference concerning redisplay.
1180 It is not ensured that mode lines will be updated to show the modified
1181 state of the current buffer. Use with care. */)
1182 (flag)
1183 Lisp_Object flag;
1185 #ifdef CLASH_DETECTION
1186 Lisp_Object fn;
1188 /* If buffer becoming modified, lock the file.
1189 If buffer becoming unmodified, unlock the file. */
1191 fn = current_buffer->file_truename;
1192 /* Test buffer-file-name so that binding it to nil is effective. */
1193 if (!NILP (fn) && ! NILP (current_buffer->filename))
1195 int already = SAVE_MODIFF < MODIFF;
1196 if (!already && !NILP (flag))
1197 lock_file (fn);
1198 else if (already && NILP (flag))
1199 unlock_file (fn);
1201 #endif /* CLASH_DETECTION */
1203 SAVE_MODIFF = NILP (flag) ? MODIFF : 0;
1204 return flag;
1207 DEFUN ("buffer-modified-tick", Fbuffer_modified_tick, Sbuffer_modified_tick,
1208 0, 1, 0,
1209 doc: /* Return BUFFER's tick counter, incremented for each change in text.
1210 Each buffer has a tick counter which is incremented each time the
1211 text in that buffer is changed. It wraps around occasionally.
1212 No argument or nil as argument means use current buffer as BUFFER. */)
1213 (buffer)
1214 register Lisp_Object buffer;
1216 register struct buffer *buf;
1217 if (NILP (buffer))
1218 buf = current_buffer;
1219 else
1221 CHECK_BUFFER (buffer);
1222 buf = XBUFFER (buffer);
1225 return make_number (BUF_MODIFF (buf));
1228 DEFUN ("buffer-chars-modified-tick", Fbuffer_chars_modified_tick,
1229 Sbuffer_chars_modified_tick, 0, 1, 0,
1230 doc: /* Return BUFFER's character-change tick counter.
1231 Each buffer has a character-change tick counter, which is set to the
1232 value of the buffer's tick counter \(see `buffer-modified-tick'), each
1233 time text in that buffer is inserted or deleted. By comparing the
1234 values returned by two individual calls of `buffer-chars-modified-tick',
1235 you can tell whether a character change occurred in that buffer in
1236 between these calls. No argument or nil as argument means use current
1237 buffer as BUFFER. */)
1238 (buffer)
1239 register Lisp_Object buffer;
1241 register struct buffer *buf;
1242 if (NILP (buffer))
1243 buf = current_buffer;
1244 else
1246 CHECK_BUFFER (buffer);
1247 buf = XBUFFER (buffer);
1250 return make_number (BUF_CHARS_MODIFF (buf));
1253 DEFUN ("rename-buffer", Frename_buffer, Srename_buffer, 1, 2,
1254 "(list (read-string \"Rename buffer (to new name): \" \
1255 nil 'buffer-name-history (buffer-name (current-buffer))) \
1256 current-prefix-arg)",
1257 doc: /* Change current buffer's name to NEWNAME (a string).
1258 If second arg UNIQUE is nil or omitted, it is an error if a
1259 buffer named NEWNAME already exists.
1260 If UNIQUE is non-nil, come up with a new name using
1261 `generate-new-buffer-name'.
1262 Interactively, you can set UNIQUE with a prefix argument.
1263 We return the name we actually gave the buffer.
1264 This does not change the name of the visited file (if any). */)
1265 (newname, unique)
1266 register Lisp_Object newname, unique;
1268 register Lisp_Object tem, buf;
1270 CHECK_STRING (newname);
1272 if (SCHARS (newname) == 0)
1273 error ("Empty string is invalid as a buffer name");
1275 tem = Fget_buffer (newname);
1276 if (!NILP (tem))
1278 /* Don't short-circuit if UNIQUE is t. That is a useful way to
1279 rename the buffer automatically so you can create another
1280 with the original name. It makes UNIQUE equivalent to
1281 (rename-buffer (generate-new-buffer-name NEWNAME)). */
1282 if (NILP (unique) && XBUFFER (tem) == current_buffer)
1283 return current_buffer->name;
1284 if (!NILP (unique))
1285 newname = Fgenerate_new_buffer_name (newname, current_buffer->name);
1286 else
1287 error ("Buffer name `%s' is in use", SDATA (newname));
1290 current_buffer->name = newname;
1292 /* Catch redisplay's attention. Unless we do this, the mode lines for
1293 any windows displaying current_buffer will stay unchanged. */
1294 update_mode_lines++;
1296 XSETBUFFER (buf, current_buffer);
1297 Fsetcar (Frassq (buf, Vbuffer_alist), newname);
1298 if (NILP (current_buffer->filename)
1299 && !NILP (current_buffer->auto_save_file_name))
1300 call0 (intern ("rename-auto-save-file"));
1301 /* Refetch since that last call may have done GC. */
1302 return current_buffer->name;
1305 DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 3, 0,
1306 doc: /* Return most recently selected buffer other than BUFFER.
1307 Buffers not visible in windows are preferred to visible buffers,
1308 unless optional second argument VISIBLE-OK is non-nil.
1309 If the optional third argument FRAME is non-nil, use that frame's
1310 buffer list instead of the selected frame's buffer list.
1311 If no other buffer exists, the buffer `*scratch*' is returned.
1312 If BUFFER is omitted or nil, some interesting buffer is returned. */)
1313 (buffer, visible_ok, frame)
1314 register Lisp_Object buffer, visible_ok, frame;
1316 Lisp_Object Fset_buffer_major_mode ();
1317 register Lisp_Object tail, buf, notsogood, tem, pred, add_ons;
1318 notsogood = Qnil;
1320 if (NILP (frame))
1321 frame = selected_frame;
1323 tail = Vbuffer_alist;
1324 pred = frame_buffer_predicate (frame);
1326 /* Consider buffers that have been seen in the selected frame
1327 before other buffers. */
1329 tem = frame_buffer_list (frame);
1330 add_ons = Qnil;
1331 while (CONSP (tem))
1333 if (BUFFERP (XCAR (tem)))
1334 add_ons = Fcons (Fcons (Qnil, XCAR (tem)), add_ons);
1335 tem = XCDR (tem);
1337 tail = nconc2 (Fnreverse (add_ons), tail);
1339 for (; CONSP (tail); tail = XCDR (tail))
1341 buf = Fcdr (XCAR (tail));
1342 if (EQ (buf, buffer))
1343 continue;
1344 if (NILP (buf))
1345 continue;
1346 if (NILP (XBUFFER (buf)->name))
1347 continue;
1348 if (SREF (XBUFFER (buf)->name, 0) == ' ')
1349 continue;
1350 /* If the selected frame has a buffer_predicate,
1351 disregard buffers that don't fit the predicate. */
1352 if (!NILP (pred))
1354 tem = call1 (pred, buf);
1355 if (NILP (tem))
1356 continue;
1359 if (NILP (visible_ok))
1360 tem = Fget_buffer_window (buf, Qvisible);
1361 else
1362 tem = Qnil;
1363 if (NILP (tem))
1364 return buf;
1365 if (NILP (notsogood))
1366 notsogood = buf;
1368 if (!NILP (notsogood))
1369 return notsogood;
1370 buf = Fget_buffer (build_string ("*scratch*"));
1371 if (NILP (buf))
1373 buf = Fget_buffer_create (build_string ("*scratch*"));
1374 Fset_buffer_major_mode (buf);
1376 return buf;
1379 DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, Sbuffer_enable_undo,
1380 0, 1, "",
1381 doc: /* Start keeping undo information for buffer BUFFER.
1382 No argument or nil as argument means do this for the current buffer. */)
1383 (buffer)
1384 register Lisp_Object buffer;
1386 Lisp_Object real_buffer;
1388 if (NILP (buffer))
1389 XSETBUFFER (real_buffer, current_buffer);
1390 else
1392 real_buffer = Fget_buffer (buffer);
1393 if (NILP (real_buffer))
1394 nsberror (buffer);
1397 if (EQ (XBUFFER (real_buffer)->undo_list, Qt))
1398 XBUFFER (real_buffer)->undo_list = Qnil;
1400 return Qnil;
1404 DEFVAR_LISP ("kill-buffer-hook", no_cell, "\
1405 Hook to be run (by `run-hooks', which see) when a buffer is killed.\n\
1406 The buffer being killed will be current while the hook is running.\n\
1407 See `kill-buffer'."
1409 DEFUN ("kill-buffer", Fkill_buffer, Skill_buffer, 0, 1, "bKill buffer: ",
1410 doc: /* Kill buffer BUFFER-OR-NAME.
1411 The argument may be a buffer or the name of an existing buffer.
1412 Argument nil or omitted means kill the current buffer. Return t if the
1413 buffer is actually killed, nil otherwise.
1415 This function calls `replace-buffer-in-windows' for cleaning up all
1416 windows currently displaying the buffer to be killed. The functions in
1417 `kill-buffer-query-functions' are called with the buffer to be killed as
1418 the current buffer. If any of them returns nil, the buffer is not
1419 killed. The hook `kill-buffer-hook' is run before the buffer is
1420 actually killed. The buffer being killed will be current while the hook
1421 is running.
1423 Any processes that have this buffer as the `process-buffer' are killed
1424 with SIGHUP. */)
1425 (buffer_or_name)
1426 Lisp_Object buffer_or_name;
1428 Lisp_Object buffer;
1429 register struct buffer *b;
1430 register Lisp_Object tem;
1431 register struct Lisp_Marker *m;
1432 struct gcpro gcpro1;
1434 if (NILP (buffer_or_name))
1435 buffer = Fcurrent_buffer ();
1436 else
1437 buffer = Fget_buffer (buffer_or_name);
1438 if (NILP (buffer))
1439 nsberror (buffer_or_name);
1441 b = XBUFFER (buffer);
1443 /* Avoid trouble for buffer already dead. */
1444 if (NILP (b->name))
1445 return Qnil;
1447 tem = get_current_thread ();
1448 if (!EQ (b->owner, Qnil) && !EQ (b->owner, tem))
1449 error ("Buffer locked by another thread");
1451 /* Query if the buffer is still modified. */
1452 if (INTERACTIVE && !NILP (b->filename)
1453 && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b))
1455 GCPRO1 (buffer);
1456 tem = do_yes_or_no_p (format2 ("Buffer %s modified; kill anyway? ",
1457 b->name, make_number (0)));
1458 UNGCPRO;
1459 if (NILP (tem))
1460 return Qnil;
1463 /* Run hooks with the buffer to be killed the current buffer. */
1465 int count = SPECPDL_INDEX ();
1466 Lisp_Object arglist[1];
1468 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1469 set_buffer_internal (b);
1471 /* First run the query functions; if any query is answered no,
1472 don't kill the buffer. */
1473 arglist[0] = Qkill_buffer_query_functions;
1474 tem = Frun_hook_with_args_until_failure (1, arglist);
1475 if (NILP (tem))
1476 return unbind_to (count, Qnil);
1478 /* Then run the hooks. */
1479 Frun_hooks (1, &Qkill_buffer_hook);
1480 unbind_to (count, Qnil);
1483 /* We have no more questions to ask. Verify that it is valid
1484 to kill the buffer. This must be done after the questions
1485 since anything can happen within do_yes_or_no_p. */
1487 /* Don't kill the minibuffer now current. */
1488 if (EQ (buffer, XWINDOW (minibuf_window)->buffer))
1489 return Qnil;
1491 if (NILP (b->name))
1492 return Qnil;
1494 /* When we kill a base buffer, kill all its indirect buffers.
1495 We do it at this stage so nothing terrible happens if they
1496 ask questions or their hooks get errors. */
1497 if (! b->base_buffer)
1499 struct buffer *other;
1501 GCPRO1 (buffer);
1503 for (other = all_buffers; other; other = other->next)
1504 /* all_buffers contains dead buffers too;
1505 don't re-kill them. */
1506 if (other->base_buffer == b && !NILP (other->name))
1508 Lisp_Object buffer;
1509 XSETBUFFER (buffer, other);
1510 Fkill_buffer (buffer);
1513 UNGCPRO;
1516 /* Make this buffer not be current.
1517 In the process, notice if this is the sole visible buffer
1518 and give up if so. */
1519 if (b == current_buffer)
1521 tem = Fother_buffer (buffer, Qnil, Qnil);
1522 Fset_buffer (tem);
1523 if (b == current_buffer)
1524 return Qnil;
1527 /* Notice if the buffer to kill is the sole visible buffer
1528 when we're currently in the mini-buffer, and give up if so. */
1529 XSETBUFFER (tem, current_buffer);
1530 if (EQ (tem, XWINDOW (minibuf_window)->buffer))
1532 tem = Fother_buffer (buffer, Qnil, Qnil);
1533 if (EQ (buffer, tem))
1534 return Qnil;
1537 /* Now there is no question: we can kill the buffer. */
1539 #ifdef CLASH_DETECTION
1540 /* Unlock this buffer's file, if it is locked. */
1541 unlock_buffer (b);
1542 #endif /* CLASH_DETECTION */
1544 GCPRO1 (buffer);
1545 kill_buffer_processes (buffer);
1546 UNGCPRO;
1548 /* Killing buffer processes may run sentinels which may
1549 have called kill-buffer. */
1551 if (NILP (b->name))
1552 return Qnil;
1554 clear_charpos_cache (b);
1556 tem = Vinhibit_quit;
1557 Vinhibit_quit = Qt;
1558 replace_buffer_in_all_windows (buffer);
1559 Vbuffer_alist = Fdelq (Frassq (buffer, Vbuffer_alist), Vbuffer_alist);
1560 frames_discard_buffer (buffer);
1561 Vinhibit_quit = tem;
1563 /* Delete any auto-save file, if we saved it in this session.
1564 But not if the buffer is modified. */
1565 if (STRINGP (b->auto_save_file_name)
1566 && BUF_AUTOSAVE_MODIFF (b) != 0
1567 && BUF_SAVE_MODIFF (b) < BUF_AUTOSAVE_MODIFF (b)
1568 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
1569 && NILP (Fsymbol_value (intern ("auto-save-visited-file-name"))))
1571 Lisp_Object tem;
1572 tem = Fsymbol_value (intern ("delete-auto-save-files"));
1573 if (! NILP (tem))
1574 internal_delete_file (b->auto_save_file_name);
1577 if (b->base_buffer)
1579 /* Unchain all markers that belong to this indirect buffer.
1580 Don't unchain the markers that belong to the base buffer
1581 or its other indirect buffers. */
1582 for (m = BUF_MARKERS (b); m; )
1584 struct Lisp_Marker *next = m->next;
1585 if (m->buffer == b)
1586 unchain_marker (m);
1587 m = next;
1590 else
1592 /* Unchain all markers of this buffer and its indirect buffers.
1593 and leave them pointing nowhere. */
1594 for (m = BUF_MARKERS (b); m; )
1596 struct Lisp_Marker *next = m->next;
1597 m->buffer = 0;
1598 m->next = NULL;
1599 m = next;
1601 BUF_MARKERS (b) = NULL;
1602 BUF_INTERVALS (b) = NULL_INTERVAL;
1604 /* Perhaps we should explicitly free the interval tree here... */
1607 /* Reset the local variables, so that this buffer's local values
1608 won't be protected from GC. They would be protected
1609 if they happened to remain encached in their symbols.
1610 This gets rid of them for certain. */
1611 swap_out_buffer_local_variables (b);
1612 reset_buffer_local_variables (b, 1);
1614 b->name = Qnil;
1616 BLOCK_INPUT;
1617 if (! b->base_buffer)
1618 free_buffer_text (b);
1620 if (b->newline_cache)
1622 free_region_cache (b->newline_cache);
1623 b->newline_cache = 0;
1625 if (b->width_run_cache)
1627 free_region_cache (b->width_run_cache);
1628 b->width_run_cache = 0;
1630 b->width_table = Qnil;
1631 UNBLOCK_INPUT;
1632 b->undo_list = Qnil;
1634 return Qt;
1637 /* Move the assoc for buffer BUF to the front of buffer-alist. Since
1638 we do this each time BUF is selected visibly, the more recently
1639 selected buffers are always closer to the front of the list. This
1640 means that other_buffer is more likely to choose a relevant buffer. */
1642 void
1643 record_buffer (buf)
1644 Lisp_Object buf;
1646 register Lisp_Object link, prev;
1647 Lisp_Object frame;
1648 frame = selected_frame;
1650 prev = Qnil;
1651 for (link = Vbuffer_alist; CONSP (link); link = XCDR (link))
1653 if (EQ (XCDR (XCAR (link)), buf))
1654 break;
1655 prev = link;
1658 /* Effectively do Vbuffer_alist = Fdelq (link, Vbuffer_alist);
1659 we cannot use Fdelq itself here because it allows quitting. */
1661 if (NILP (prev))
1662 Vbuffer_alist = XCDR (Vbuffer_alist);
1663 else
1664 XSETCDR (prev, XCDR (XCDR (prev)));
1666 XSETCDR (link, Vbuffer_alist);
1667 Vbuffer_alist = link;
1669 /* Effectively do a delq on buried_buffer_list. */
1671 prev = Qnil;
1672 for (link = XFRAME (frame)->buried_buffer_list; CONSP (link);
1673 link = XCDR (link))
1675 if (EQ (XCAR (link), buf))
1677 if (NILP (prev))
1678 XFRAME (frame)->buried_buffer_list = XCDR (link);
1679 else
1680 XSETCDR (prev, XCDR (XCDR (prev)));
1681 break;
1683 prev = link;
1686 /* Now move this buffer to the front of frame_buffer_list also. */
1688 prev = Qnil;
1689 for (link = frame_buffer_list (frame); CONSP (link);
1690 link = XCDR (link))
1692 if (EQ (XCAR (link), buf))
1693 break;
1694 prev = link;
1697 /* Effectively do delq. */
1699 if (CONSP (link))
1701 if (NILP (prev))
1702 set_frame_buffer_list (frame,
1703 XCDR (frame_buffer_list (frame)));
1704 else
1705 XSETCDR (prev, XCDR (XCDR (prev)));
1707 XSETCDR (link, frame_buffer_list (frame));
1708 set_frame_buffer_list (frame, link);
1710 else
1711 set_frame_buffer_list (frame, Fcons (buf, frame_buffer_list (frame)));
1714 DEFUN ("set-buffer-major-mode", Fset_buffer_major_mode, Sset_buffer_major_mode, 1, 1, 0,
1715 doc: /* Set an appropriate major mode for BUFFER.
1716 For the *scratch* buffer, use `initial-major-mode', otherwise choose a mode
1717 according to `default-major-mode'.
1718 Use this function before selecting the buffer, since it may need to inspect
1719 the current buffer's major mode. */)
1720 (buffer)
1721 Lisp_Object buffer;
1723 int count;
1724 Lisp_Object function;
1726 CHECK_BUFFER (buffer);
1728 if (STRINGP (XBUFFER (buffer)->name)
1729 && strcmp (SDATA (XBUFFER (buffer)->name), "*scratch*") == 0)
1730 function = find_symbol_value (intern ("initial-major-mode"));
1731 else
1733 function = buffer_defaults.major_mode;
1734 if (NILP (function)
1735 && NILP (Fget (current_buffer->major_mode, Qmode_class)))
1736 function = current_buffer->major_mode;
1739 if (NILP (function) || EQ (function, Qfundamental_mode))
1740 return Qnil;
1742 count = SPECPDL_INDEX ();
1744 /* To select a nonfundamental mode,
1745 select the buffer temporarily and then call the mode function. */
1747 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1749 Fset_buffer (buffer);
1750 call0 (function);
1752 return unbind_to (count, Qnil);
1755 /* Switch to buffer BUFFER in the selected window.
1756 If NORECORD is non-nil, don't call record_buffer. */
1758 Lisp_Object
1759 switch_to_buffer_1 (buffer_or_name, norecord)
1760 Lisp_Object buffer_or_name, norecord;
1762 register Lisp_Object buffer;
1764 if (NILP (buffer_or_name))
1765 buffer = Fother_buffer (Fcurrent_buffer (), Qnil, Qnil);
1766 else
1768 buffer = Fget_buffer (buffer_or_name);
1769 if (NILP (buffer))
1771 buffer = Fget_buffer_create (buffer_or_name);
1772 Fset_buffer_major_mode (buffer);
1775 Fset_buffer (buffer);
1776 if (NILP (norecord))
1777 record_buffer (buffer);
1779 Fset_window_buffer (EQ (selected_window, minibuf_window)
1780 ? Fnext_window (minibuf_window, Qnil, Qnil)
1781 : selected_window,
1782 buffer, Qnil);
1784 return buffer;
1787 DEFUN ("switch-to-buffer", Fswitch_to_buffer, Sswitch_to_buffer, 1, 2,
1788 "(list (read-buffer-to-switch \"Switch to buffer: \"))",
1789 doc: /* Make BUFFER-OR-NAME current and display it in selected window.
1790 BUFFER-OR-NAME may be a buffer, a string \(a buffer name), or
1791 nil. Return the buffer switched to.
1793 If BUFFER-OR-NAME is a string and does not identify an existing
1794 buffer, create a new buffer with that name. Interactively, if
1795 `confirm-nonexistent-file-or-buffer' is non-nil, request
1796 confirmation before creating a new buffer. If BUFFER-OR-NAME is
1797 nil, switch to buffer returned by `other-buffer'.
1799 Optional second arg NORECORD non-nil means do not put this buffer
1800 at the front of the list of recently selected ones. This
1801 function returns the buffer it switched to as a Lisp object.
1803 If the selected window is the minibuffer window or dedicated to
1804 its buffer, use `pop-to-buffer' for displaying the buffer.
1806 WARNING: This is NOT the way to work on another buffer temporarily
1807 within a Lisp program! Use `set-buffer' instead. That avoids
1808 messing with the window-buffer correspondences. */)
1809 (buffer_or_name, norecord)
1810 Lisp_Object buffer_or_name, norecord;
1812 char *err;
1814 if (EQ (buffer_or_name, Fwindow_buffer (selected_window)))
1816 /* Basically a NOP. Avoid signalling an error in the case where
1817 the selected window is dedicated, or a minibuffer. */
1819 /* But do put this buffer at the front of the buffer list, unless
1820 that has been inhibited. Note that even if BUFFER-OR-NAME is
1821 at the front of the main buffer-list already, we still want to
1822 move it to the front of the frame's buffer list. */
1823 if (NILP (norecord))
1824 record_buffer (buffer_or_name);
1825 return Fset_buffer (buffer_or_name);
1827 else if (EQ (minibuf_window, selected_window)
1828 /* If `dedicated' is neither nil nor t, it means it's
1829 dedicatedness can be overridden by an explicit request
1830 such as a call to switch-to-buffer. */
1831 || EQ (Fwindow_dedicated_p (selected_window), Qt))
1832 /* We can't use the selected window so let `pop-to-buffer' try some
1833 other window. */
1834 return call3 (intern ("pop-to-buffer"), buffer_or_name, Qnil, norecord);
1835 else
1836 return switch_to_buffer_1 (buffer_or_name, norecord);
1839 DEFUN ("current-buffer", Fcurrent_buffer, Scurrent_buffer, 0, 0, 0,
1840 doc: /* Return the current buffer as a Lisp object. */)
1843 register Lisp_Object buf;
1844 XSETBUFFER (buf, current_buffer);
1845 return buf;
1848 /* Set the current buffer to B.
1850 We previously set windows_or_buffers_changed here to invalidate
1851 global unchanged information in beg_unchanged and end_unchanged.
1852 This is no longer necessary because we now compute unchanged
1853 information on a buffer-basis. Every action affecting other
1854 windows than the selected one requires a select_window at some
1855 time, and that increments windows_or_buffers_changed. */
1857 void
1858 set_buffer_internal (b)
1859 register struct buffer *b;
1861 if (current_buffer != b)
1862 set_buffer_internal_1 (b);
1865 /* Set the current buffer to B, and do not set windows_or_buffers_changed.
1866 This is used by redisplay. */
1868 void
1869 set_buffer_internal_1 (b)
1870 register struct buffer *b;
1872 register struct buffer *old_buf;
1873 register Lisp_Object tail, valcontents;
1874 Lisp_Object tem;
1876 #ifdef USE_MMAP_FOR_BUFFERS
1877 if (b->text->beg == NULL)
1878 enlarge_buffer_text (b, 0);
1879 #endif /* USE_MMAP_FOR_BUFFERS */
1881 if (current_buffer == b)
1882 return;
1884 old_buf = current_buffer;
1885 flush_stack_call_func (thread_acquire_buffer, b);
1886 current_buffer = b;
1887 last_known_column_point = -1; /* invalidate indentation cache */
1889 if (old_buf)
1891 /* Put the undo list back in the base buffer, so that it appears
1892 that an indirect buffer shares the undo list of its base. */
1893 if (old_buf->base_buffer)
1894 old_buf->base_buffer->undo_list = old_buf->undo_list;
1896 /* If the old current buffer has markers to record PT, BEGV and ZV
1897 when it is not current, update them now. */
1898 if (! NILP (old_buf->pt_marker))
1900 Lisp_Object obuf;
1901 XSETBUFFER (obuf, old_buf);
1902 set_marker_both (old_buf->pt_marker, obuf,
1903 BUF_PT (old_buf), BUF_PT_BYTE (old_buf));
1905 if (! NILP (old_buf->begv_marker))
1907 Lisp_Object obuf;
1908 XSETBUFFER (obuf, old_buf);
1909 set_marker_both (old_buf->begv_marker, obuf,
1910 BUF_BEGV (old_buf), BUF_BEGV_BYTE (old_buf));
1912 if (! NILP (old_buf->zv_marker))
1914 Lisp_Object obuf;
1915 XSETBUFFER (obuf, old_buf);
1916 set_marker_both (old_buf->zv_marker, obuf,
1917 BUF_ZV (old_buf), BUF_ZV_BYTE (old_buf));
1921 /* Get the undo list from the base buffer, so that it appears
1922 that an indirect buffer shares the undo list of its base. */
1923 if (b->base_buffer)
1924 b->undo_list = b->base_buffer->undo_list;
1926 /* If the new current buffer has markers to record PT, BEGV and ZV
1927 when it is not current, fetch them now. */
1928 if (! NILP (b->pt_marker))
1930 BUF_PT (b) = marker_position (b->pt_marker);
1931 BUF_PT_BYTE (b) = marker_byte_position (b->pt_marker);
1933 if (! NILP (b->begv_marker))
1935 BUF_BEGV (b) = marker_position (b->begv_marker);
1936 BUF_BEGV_BYTE (b) = marker_byte_position (b->begv_marker);
1938 if (! NILP (b->zv_marker))
1940 BUF_ZV (b) = marker_position (b->zv_marker);
1941 BUF_ZV_BYTE (b) = marker_byte_position (b->zv_marker);
1944 /* Look down buffer's list of local Lisp variables
1945 to find and update any that forward into C variables. */
1947 for (tail = b->local_var_alist; CONSP (tail); tail = XCDR (tail))
1949 if (CONSP (XCAR (tail))
1950 && SYMBOLP (XCAR (XCAR (tail)))
1951 && (valcontents = SYMBOL_VALUE (XCAR (XCAR (tail))),
1952 (BUFFER_LOCAL_VALUEP (valcontents)))
1953 && (tem = XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
1954 (BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem))))
1955 /* Just reference the variable to cause it to become set for
1956 this buffer. */
1957 Fsymbol_value (XCAR (XCAR (tail)));
1960 /* Do the same with any others that were local to the previous buffer */
1962 if (old_buf)
1963 for (tail = old_buf->local_var_alist; CONSP (tail); tail = XCDR (tail))
1965 if (CONSP (tail)
1966 && SYMBOLP (XCAR (XCAR (tail)))
1967 && (valcontents = SYMBOL_VALUE (XCAR (XCAR (tail))),
1968 (BUFFER_LOCAL_VALUEP (valcontents)))
1969 && (tem = XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
1970 (BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem))))
1971 /* Just reference the variable to cause it to become set for
1972 this buffer. */
1973 Fsymbol_value (XCAR (XCAR (tail)));
1977 /* Switch to buffer B temporarily for redisplay purposes.
1978 This avoids certain things that don't need to be done within redisplay. */
1980 void
1981 set_buffer_temp (b)
1982 struct buffer *b;
1984 register struct buffer *old_buf;
1986 if (current_buffer == b)
1987 return;
1989 old_buf = current_buffer;
1990 current_buffer = b;
1992 if (old_buf)
1994 /* If the old current buffer has markers to record PT, BEGV and ZV
1995 when it is not current, update them now. */
1996 if (! NILP (old_buf->pt_marker))
1998 Lisp_Object obuf;
1999 XSETBUFFER (obuf, old_buf);
2000 set_marker_both (old_buf->pt_marker, obuf,
2001 BUF_PT (old_buf), BUF_PT_BYTE (old_buf));
2003 if (! NILP (old_buf->begv_marker))
2005 Lisp_Object obuf;
2006 XSETBUFFER (obuf, old_buf);
2007 set_marker_both (old_buf->begv_marker, obuf,
2008 BUF_BEGV (old_buf), BUF_BEGV_BYTE (old_buf));
2010 if (! NILP (old_buf->zv_marker))
2012 Lisp_Object obuf;
2013 XSETBUFFER (obuf, old_buf);
2014 set_marker_both (old_buf->zv_marker, obuf,
2015 BUF_ZV (old_buf), BUF_ZV_BYTE (old_buf));
2019 /* If the new current buffer has markers to record PT, BEGV and ZV
2020 when it is not current, fetch them now. */
2021 if (! NILP (b->pt_marker))
2023 BUF_PT (b) = marker_position (b->pt_marker);
2024 BUF_PT_BYTE (b) = marker_byte_position (b->pt_marker);
2026 if (! NILP (b->begv_marker))
2028 BUF_BEGV (b) = marker_position (b->begv_marker);
2029 BUF_BEGV_BYTE (b) = marker_byte_position (b->begv_marker);
2031 if (! NILP (b->zv_marker))
2033 BUF_ZV (b) = marker_position (b->zv_marker);
2034 BUF_ZV_BYTE (b) = marker_byte_position (b->zv_marker);
2038 DEFUN ("set-buffer", Fset_buffer, Sset_buffer, 1, 1, 0,
2039 doc: /* Make buffer BUFFER-OR-NAME current for editing operations.
2040 BUFFER-OR-NAME may be a buffer or the name of an existing buffer. See
2041 also `save-excursion' when you want to make a buffer current
2042 temporarily. This function does not display the buffer, so its effect
2043 ends when the current command terminates. Use `switch-to-buffer' or
2044 `pop-to-buffer' to switch buffers permanently. */)
2045 (buffer_or_name)
2046 register Lisp_Object buffer_or_name;
2048 register Lisp_Object buffer;
2049 buffer = Fget_buffer (buffer_or_name);
2050 if (NILP (buffer))
2051 nsberror (buffer_or_name);
2052 if (NILP (XBUFFER (buffer)->name))
2053 error ("Selecting deleted buffer");
2054 set_buffer_internal (XBUFFER (buffer));
2055 return buffer;
2058 /* Set the current buffer to BUFFER provided it is alive. */
2060 Lisp_Object
2061 set_buffer_if_live (buffer)
2062 Lisp_Object buffer;
2064 if (! NILP (XBUFFER (buffer)->name))
2065 Fset_buffer (buffer);
2066 return Qnil;
2069 DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only,
2070 Sbarf_if_buffer_read_only, 0, 0, 0,
2071 doc: /* Signal a `buffer-read-only' error if the current buffer is read-only. */)
2074 if (!NILP (current_buffer->read_only)
2075 && NILP (Vinhibit_read_only))
2076 xsignal1 (Qbuffer_read_only, Fcurrent_buffer ());
2077 return Qnil;
2080 DEFUN ("bury-buffer", Fbury_buffer, Sbury_buffer, 0, 1, "",
2081 doc: /* Put BUFFER-OR-NAME at the end of the list of all buffers.
2082 There it is the least likely candidate for `other-buffer' to return;
2083 thus, the least likely buffer for \\[switch-to-buffer] to select by
2084 default.
2086 The argument may be a buffer name or an actual buffer object. If
2087 BUFFER-OR-NAME is nil or omitted, bury the current buffer and remove it
2088 from the selected window if it is displayed there. If the selected
2089 window is dedicated to its buffer, delete that window if there are other
2090 windows on the same frame. If the selected window is the only window on
2091 its frame, iconify that frame. */)
2092 (buffer_or_name)
2093 register Lisp_Object buffer_or_name;
2095 Lisp_Object buffer;
2097 /* Figure out what buffer we're going to bury. */
2098 if (NILP (buffer_or_name))
2100 Lisp_Object tem;
2101 XSETBUFFER (buffer, current_buffer);
2103 tem = Fwindow_buffer (selected_window);
2104 /* If we're burying the current buffer, unshow it. */
2105 if (EQ (buffer, tem))
2107 if (NILP (Fwindow_dedicated_p (selected_window)))
2108 Fswitch_to_buffer (Fother_buffer (buffer, Qnil, Qnil), Qnil);
2109 else if (NILP (XWINDOW (selected_window)->parent))
2110 Ficonify_frame (Fwindow_frame (selected_window));
2111 else
2112 Fdelete_window (selected_window);
2115 else
2117 buffer = Fget_buffer (buffer_or_name);
2118 if (NILP (buffer))
2119 nsberror (buffer_or_name);
2122 /* Move buffer to the end of the buffer list. Do nothing if the
2123 buffer is killed. */
2124 if (!NILP (XBUFFER (buffer)->name))
2126 Lisp_Object aelt, link;
2128 aelt = Frassq (buffer, Vbuffer_alist);
2129 link = Fmemq (aelt, Vbuffer_alist);
2130 Vbuffer_alist = Fdelq (aelt, Vbuffer_alist);
2131 XSETCDR (link, Qnil);
2132 Vbuffer_alist = nconc2 (Vbuffer_alist, link);
2134 XFRAME (selected_frame)->buffer_list
2135 = Fdelq (buffer, XFRAME (selected_frame)->buffer_list);
2136 XFRAME (selected_frame)->buried_buffer_list
2137 = Fcons (buffer, Fdelq (buffer, XFRAME (selected_frame)->buried_buffer_list));
2140 return Qnil;
2143 DEFUN ("erase-buffer", Ferase_buffer, Serase_buffer, 0, 0, "*",
2144 doc: /* Delete the entire contents of the current buffer.
2145 Any narrowing restriction in effect (see `narrow-to-region') is removed,
2146 so the buffer is truly empty after this. */)
2149 Fwiden ();
2151 del_range (BEG, Z);
2153 current_buffer->last_window_start = 1;
2154 /* Prevent warnings, or suspension of auto saving, that would happen
2155 if future size is less than past size. Use of erase-buffer
2156 implies that the future text is not really related to the past text. */
2157 XSETFASTINT (current_buffer->save_length, 0);
2158 return Qnil;
2161 void
2162 validate_region (b, e)
2163 register Lisp_Object *b, *e;
2165 CHECK_NUMBER_COERCE_MARKER (*b);
2166 CHECK_NUMBER_COERCE_MARKER (*e);
2168 if (XINT (*b) > XINT (*e))
2170 Lisp_Object tem;
2171 tem = *b; *b = *e; *e = tem;
2174 if (!(BEGV <= XINT (*b) && XINT (*b) <= XINT (*e)
2175 && XINT (*e) <= ZV))
2176 args_out_of_range (*b, *e);
2179 /* Advance BYTE_POS up to a character boundary
2180 and return the adjusted position. */
2182 static int
2183 advance_to_char_boundary (byte_pos)
2184 int byte_pos;
2186 int c;
2188 if (byte_pos == BEG)
2189 /* Beginning of buffer is always a character boundary. */
2190 return BEG;
2192 c = FETCH_BYTE (byte_pos);
2193 if (! CHAR_HEAD_P (c))
2195 /* We should advance BYTE_POS only when C is a constituent of a
2196 multibyte sequence. */
2197 int orig_byte_pos = byte_pos;
2201 byte_pos--;
2202 c = FETCH_BYTE (byte_pos);
2204 while (! CHAR_HEAD_P (c) && byte_pos > BEG);
2205 INC_POS (byte_pos);
2206 if (byte_pos < orig_byte_pos)
2207 byte_pos = orig_byte_pos;
2208 /* If C is a constituent of a multibyte sequence, BYTE_POS was
2209 surely advance to the correct character boundary. If C is
2210 not, BYTE_POS was unchanged. */
2213 return byte_pos;
2216 #ifdef REL_ALLOC
2217 extern void r_alloc_reset_variable P_ ((POINTER_TYPE *, POINTER_TYPE *));
2218 #endif /* REL_ALLOC */
2220 DEFUN ("buffer-swap-text", Fbuffer_swap_text, Sbuffer_swap_text,
2221 1, 1, 0,
2222 doc: /* Swap the text between current buffer and BUFFER. */)
2223 (buffer)
2224 Lisp_Object buffer;
2226 struct buffer *other_buffer;
2227 CHECK_BUFFER (buffer);
2228 other_buffer = XBUFFER (buffer);
2230 if (NILP (other_buffer->name))
2231 error ("Cannot swap a dead buffer's text");
2233 /* Actually, it probably works just fine.
2234 * if (other_buffer == current_buffer)
2235 * error ("Cannot swap a buffer's text with itself"); */
2237 /* Actually, this may be workable as well, tho probably only if they're
2238 *both* indirect. */
2239 if (other_buffer->base_buffer
2240 || current_buffer->base_buffer)
2241 error ("Cannot swap indirect buffers's text");
2243 { /* This is probably harder to make work. */
2244 struct buffer *other;
2245 for (other = all_buffers; other; other = other->next)
2246 if (other->base_buffer == other_buffer
2247 || other->base_buffer == current_buffer)
2248 error ("One of the buffers to swap has indirect buffers");
2251 #define swapfield(field, type) \
2252 do { \
2253 type tmp##field = other_buffer->field; \
2254 other_buffer->field = current_buffer->field; \
2255 current_buffer->field = tmp##field; \
2256 } while (0)
2258 swapfield (own_text, struct buffer_text);
2259 eassert (current_buffer->text == &current_buffer->own_text);
2260 eassert (other_buffer->text == &other_buffer->own_text);
2261 #ifdef REL_ALLOC
2262 r_alloc_reset_variable ((POINTER_TYPE **) &current_buffer->own_text.beg,
2263 (POINTER_TYPE **) &other_buffer->own_text.beg);
2264 r_alloc_reset_variable ((POINTER_TYPE **) &other_buffer->own_text.beg,
2265 (POINTER_TYPE **) &current_buffer->own_text.beg);
2266 #endif /* REL_ALLOC */
2268 swapfield (pt, EMACS_INT);
2269 swapfield (pt_byte, EMACS_INT);
2270 swapfield (begv, EMACS_INT);
2271 swapfield (begv_byte, EMACS_INT);
2272 swapfield (zv, EMACS_INT);
2273 swapfield (zv_byte, EMACS_INT);
2274 eassert (!current_buffer->base_buffer);
2275 eassert (!other_buffer->base_buffer);
2276 current_buffer->clip_changed = 1; other_buffer->clip_changed = 1;
2277 swapfield (newline_cache, struct region_cache *);
2278 swapfield (width_run_cache, struct region_cache *);
2279 current_buffer->prevent_redisplay_optimizations_p = 1;
2280 other_buffer->prevent_redisplay_optimizations_p = 1;
2281 swapfield (overlays_before, struct Lisp_Overlay *);
2282 swapfield (overlays_after, struct Lisp_Overlay *);
2283 swapfield (overlay_center, EMACS_INT);
2284 swapfield (undo_list, Lisp_Object);
2285 swapfield (mark, Lisp_Object);
2286 swapfield (enable_multibyte_characters, Lisp_Object);
2287 /* FIXME: Not sure what we should do with these *_marker fields.
2288 Hopefully they're just nil anyway. */
2289 swapfield (pt_marker, Lisp_Object);
2290 swapfield (begv_marker, Lisp_Object);
2291 swapfield (zv_marker, Lisp_Object);
2292 current_buffer->point_before_scroll = Qnil;
2293 other_buffer->point_before_scroll = Qnil;
2295 current_buffer->text->modiff++; other_buffer->text->modiff++;
2296 current_buffer->text->chars_modiff++; other_buffer->text->chars_modiff++;
2297 current_buffer->text->overlay_modiff++; other_buffer->text->overlay_modiff++;
2298 current_buffer->text->beg_unchanged = current_buffer->text->gpt;
2299 current_buffer->text->end_unchanged = current_buffer->text->gpt;
2300 other_buffer->text->beg_unchanged = other_buffer->text->gpt;
2301 other_buffer->text->end_unchanged = other_buffer->text->gpt;
2303 struct Lisp_Marker *m;
2304 for (m = BUF_MARKERS (current_buffer); m; m = m->next)
2305 if (m->buffer == other_buffer)
2306 m->buffer = current_buffer;
2307 else
2308 /* Since there's no indirect buffer in sight, markers on
2309 BUF_MARKERS(buf) should either be for `buf' or dead. */
2310 eassert (!m->buffer);
2311 for (m = BUF_MARKERS (other_buffer); m; m = m->next)
2312 if (m->buffer == current_buffer)
2313 m->buffer = other_buffer;
2314 else
2315 /* Since there's no indirect buffer in sight, markers on
2316 BUF_MARKERS(buf) should either be for `buf' or dead. */
2317 eassert (!m->buffer);
2319 { /* Some of the C code expects that w->buffer == w->pointm->buffer.
2320 So since we just swapped the markers between the two buffers, we need
2321 to undo the effect of this swap for window markers. */
2322 Lisp_Object w = Fselected_window (), ws = Qnil;
2323 Lisp_Object buf1, buf2;
2324 XSETBUFFER (buf1, current_buffer); XSETBUFFER (buf2, other_buffer);
2326 while (NILP (Fmemq (w, ws)))
2328 ws = Fcons (w, ws);
2329 if (MARKERP (XWINDOW (w)->pointm)
2330 && (EQ (XWINDOW (w)->buffer, buf1)
2331 || EQ (XWINDOW (w)->buffer, buf2)))
2332 Fset_marker (XWINDOW (w)->pointm,
2333 make_number (BUF_BEGV (XBUFFER (XWINDOW (w)->buffer))),
2334 XWINDOW (w)->buffer);
2335 w = Fnext_window (w, Qt, Qt);
2339 if (current_buffer->text->intervals)
2340 (eassert (EQ (current_buffer->text->intervals->up.obj, buffer)),
2341 XSETBUFFER (current_buffer->text->intervals->up.obj, current_buffer));
2342 if (other_buffer->text->intervals)
2343 (eassert (EQ (other_buffer->text->intervals->up.obj, Fcurrent_buffer ())),
2344 XSETBUFFER (other_buffer->text->intervals->up.obj, other_buffer));
2346 return Qnil;
2349 DEFUN ("set-buffer-multibyte", Fset_buffer_multibyte, Sset_buffer_multibyte,
2350 1, 1, 0,
2351 doc: /* Set the multibyte flag of the current buffer to FLAG.
2352 If FLAG is t, this makes the buffer a multibyte buffer.
2353 If FLAG is nil, this makes the buffer a single-byte buffer.
2354 In these cases, the buffer contents remain unchanged as a sequence of
2355 bytes but the contents viewed as characters do change.
2356 If FLAG is `to', this makes the buffer a multibyte buffer by changing
2357 all eight-bit bytes to eight-bit characters.
2358 If the multibyte flag was really changed, undo information of the
2359 current buffer is cleared. */)
2360 (flag)
2361 Lisp_Object flag;
2363 struct Lisp_Marker *tail, *markers;
2364 struct buffer *other;
2365 int begv, zv;
2366 int narrowed = (BEG != BEGV || Z != ZV);
2367 int modified_p = !NILP (Fbuffer_modified_p (Qnil));
2368 Lisp_Object old_undo = current_buffer->undo_list;
2369 struct gcpro gcpro1;
2371 if (current_buffer->base_buffer)
2372 error ("Cannot do `set-buffer-multibyte' on an indirect buffer");
2374 /* Do nothing if nothing actually changes. */
2375 if (NILP (flag) == NILP (current_buffer->enable_multibyte_characters))
2376 return flag;
2378 GCPRO1 (old_undo);
2380 /* Don't record these buffer changes. We will put a special undo entry
2381 instead. */
2382 current_buffer->undo_list = Qt;
2384 /* If the cached position is for this buffer, clear it out. */
2385 clear_charpos_cache (current_buffer);
2387 if (NILP (flag))
2388 begv = BEGV_BYTE, zv = ZV_BYTE;
2389 else
2390 begv = BEGV, zv = ZV;
2392 if (narrowed)
2393 Fwiden ();
2395 if (NILP (flag))
2397 int pos, stop;
2398 unsigned char *p;
2400 /* Do this first, so it can use CHAR_TO_BYTE
2401 to calculate the old correspondences. */
2402 set_intervals_multibyte (0);
2404 current_buffer->enable_multibyte_characters = Qnil;
2406 Z = Z_BYTE;
2407 BEGV = BEGV_BYTE;
2408 ZV = ZV_BYTE;
2409 GPT = GPT_BYTE;
2410 TEMP_SET_PT_BOTH (PT_BYTE, PT_BYTE);
2413 for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
2414 tail->charpos = tail->bytepos;
2416 /* Convert multibyte form of 8-bit characters to unibyte. */
2417 pos = BEG;
2418 stop = GPT;
2419 p = BEG_ADDR;
2420 while (1)
2422 int c, bytes;
2424 if (pos == stop)
2426 if (pos == Z)
2427 break;
2428 p = GAP_END_ADDR;
2429 stop = Z;
2431 if (ASCII_BYTE_P (*p))
2432 p++, pos++;
2433 else if (CHAR_BYTE8_HEAD_P (*p))
2435 c = STRING_CHAR_AND_LENGTH (p, bytes);
2436 /* Delete all bytes for this 8-bit character but the
2437 last one, and change the last one to the charcter
2438 code. */
2439 bytes--;
2440 del_range_2 (pos, pos, pos + bytes, pos + bytes, 0);
2441 p = GAP_END_ADDR;
2442 *p++ = c;
2443 pos++;
2444 if (begv > pos)
2445 begv -= bytes;
2446 if (zv > pos)
2447 zv -= bytes;
2448 stop = Z;
2450 else
2452 bytes = BYTES_BY_CHAR_HEAD (*p);
2453 p += bytes, pos += bytes;
2456 if (narrowed)
2457 Fnarrow_to_region (make_number (begv), make_number (zv));
2459 else
2461 int pt = PT;
2462 int pos, stop;
2463 unsigned char *p, *pend;
2465 /* Be sure not to have a multibyte sequence striding over the GAP.
2466 Ex: We change this: "...abc\302 _GAP_ \241def..."
2467 to: "...abc _GAP_ \302\241def..." */
2469 if (EQ (flag, Qt)
2470 && GPT_BYTE > 1 && GPT_BYTE < Z_BYTE
2471 && ! CHAR_HEAD_P (*(GAP_END_ADDR)))
2473 unsigned char *p = GPT_ADDR - 1;
2475 while (! CHAR_HEAD_P (*p) && p > BEG_ADDR) p--;
2476 if (BASE_LEADING_CODE_P (*p))
2478 int new_gpt = GPT_BYTE - (GPT_ADDR - p);
2480 move_gap_both (new_gpt, new_gpt);
2484 /* Make the buffer contents valid as multibyte by converting
2485 8-bit characters to multibyte form. */
2486 pos = BEG;
2487 stop = GPT;
2488 p = BEG_ADDR;
2489 pend = GPT_ADDR;
2490 while (1)
2492 int bytes;
2494 if (pos == stop)
2496 if (pos == Z)
2497 break;
2498 p = GAP_END_ADDR;
2499 pend = Z_ADDR;
2500 stop = Z;
2503 if (ASCII_BYTE_P (*p))
2504 p++, pos++;
2505 else if (EQ (flag, Qt)
2506 && ! CHAR_BYTE8_HEAD_P (*p)
2507 && (bytes = MULTIBYTE_LENGTH (p, pend)) > 0)
2508 p += bytes, pos += bytes;
2509 else
2511 unsigned char tmp[MAX_MULTIBYTE_LENGTH];
2512 int c;
2514 c = BYTE8_TO_CHAR (*p);
2515 bytes = CHAR_STRING (c, tmp);
2516 *p = tmp[0];
2517 TEMP_SET_PT_BOTH (pos + 1, pos + 1);
2518 bytes--;
2519 insert_1_both (tmp + 1, bytes, bytes, 1, 0, 0);
2520 /* Now the gap is after the just inserted data. */
2521 pos = GPT;
2522 p = GAP_END_ADDR;
2523 if (pos <= begv)
2524 begv += bytes;
2525 if (pos <= zv)
2526 zv += bytes;
2527 if (pos <= pt)
2528 pt += bytes;
2529 pend = Z_ADDR;
2530 stop = Z;
2534 if (pt != PT)
2535 TEMP_SET_PT (pt);
2537 if (narrowed)
2538 Fnarrow_to_region (make_number (begv), make_number (zv));
2540 /* Do this first, so that chars_in_text asks the right question.
2541 set_intervals_multibyte needs it too. */
2542 current_buffer->enable_multibyte_characters = Qt;
2544 GPT_BYTE = advance_to_char_boundary (GPT_BYTE);
2545 GPT = chars_in_text (BEG_ADDR, GPT_BYTE - BEG_BYTE) + BEG;
2547 Z = chars_in_text (GAP_END_ADDR, Z_BYTE - GPT_BYTE) + GPT;
2549 BEGV_BYTE = advance_to_char_boundary (BEGV_BYTE);
2550 if (BEGV_BYTE > GPT_BYTE)
2551 BEGV = chars_in_text (GAP_END_ADDR, BEGV_BYTE - GPT_BYTE) + GPT;
2552 else
2553 BEGV = chars_in_text (BEG_ADDR, BEGV_BYTE - BEG_BYTE) + BEG;
2555 ZV_BYTE = advance_to_char_boundary (ZV_BYTE);
2556 if (ZV_BYTE > GPT_BYTE)
2557 ZV = chars_in_text (GAP_END_ADDR, ZV_BYTE - GPT_BYTE) + GPT;
2558 else
2559 ZV = chars_in_text (BEG_ADDR, ZV_BYTE - BEG_BYTE) + BEG;
2562 int pt_byte = advance_to_char_boundary (PT_BYTE);
2563 int pt;
2565 if (pt_byte > GPT_BYTE)
2566 pt = chars_in_text (GAP_END_ADDR, pt_byte - GPT_BYTE) + GPT;
2567 else
2568 pt = chars_in_text (BEG_ADDR, pt_byte - BEG_BYTE) + BEG;
2569 TEMP_SET_PT_BOTH (pt, pt_byte);
2572 tail = markers = BUF_MARKERS (current_buffer);
2574 /* This prevents BYTE_TO_CHAR (that is, buf_bytepos_to_charpos) from
2575 getting confused by the markers that have not yet been updated.
2576 It is also a signal that it should never create a marker. */
2577 BUF_MARKERS (current_buffer) = NULL;
2579 for (; tail; tail = tail->next)
2581 tail->bytepos = advance_to_char_boundary (tail->bytepos);
2582 tail->charpos = BYTE_TO_CHAR (tail->bytepos);
2585 /* Make sure no markers were put on the chain
2586 while the chain value was incorrect. */
2587 if (BUF_MARKERS (current_buffer))
2588 abort ();
2590 BUF_MARKERS (current_buffer) = markers;
2592 /* Do this last, so it can calculate the new correspondences
2593 between chars and bytes. */
2594 set_intervals_multibyte (1);
2597 if (!EQ (old_undo, Qt))
2599 /* Represent all the above changes by a special undo entry. */
2600 extern Lisp_Object Qapply;
2601 current_buffer->undo_list = Fcons (list3 (Qapply,
2602 intern ("set-buffer-multibyte"),
2603 NILP (flag) ? Qt : Qnil),
2604 old_undo);
2607 UNGCPRO;
2609 /* Changing the multibyteness of a buffer means that all windows
2610 showing that buffer must be updated thoroughly. */
2611 current_buffer->prevent_redisplay_optimizations_p = 1;
2612 ++windows_or_buffers_changed;
2614 /* Copy this buffer's new multibyte status
2615 into all of its indirect buffers. */
2616 for (other = all_buffers; other; other = other->next)
2617 if (other->base_buffer == current_buffer && !NILP (other->name))
2619 other->enable_multibyte_characters
2620 = current_buffer->enable_multibyte_characters;
2621 other->prevent_redisplay_optimizations_p = 1;
2624 /* Restore the modifiedness of the buffer. */
2625 if (!modified_p && !NILP (Fbuffer_modified_p (Qnil)))
2626 Fset_buffer_modified_p (Qnil);
2628 #ifdef subprocesses
2629 /* Update coding systems of this buffer's process (if any). */
2631 Lisp_Object process;
2633 process = Fget_buffer_process (Fcurrent_buffer ());
2634 if (PROCESSP (process))
2635 setup_process_coding_systems (process);
2637 #endif /* subprocesses */
2639 return flag;
2642 DEFUN ("kill-all-local-variables", Fkill_all_local_variables, Skill_all_local_variables,
2643 0, 0, 0,
2644 doc: /* Switch to Fundamental mode by killing current buffer's local variables.
2645 Most local variable bindings are eliminated so that the default values
2646 become effective once more. Also, the syntax table is set from
2647 `standard-syntax-table', the local keymap is set to nil,
2648 and the abbrev table from `fundamental-mode-abbrev-table'.
2649 This function also forces redisplay of the mode line.
2651 Every function to select a new major mode starts by
2652 calling this function.
2654 As a special exception, local variables whose names have
2655 a non-nil `permanent-local' property are not eliminated by this function.
2657 The first thing this function does is run
2658 the normal hook `change-major-mode-hook'. */)
2661 if (!NILP (Vrun_hooks))
2662 call1 (Vrun_hooks, Qchange_major_mode_hook);
2664 /* Make sure none of the bindings in local_var_alist
2665 remain swapped in, in their symbols. */
2667 swap_out_buffer_local_variables (current_buffer);
2669 /* Actually eliminate all local bindings of this buffer. */
2671 reset_buffer_local_variables (current_buffer, 0);
2673 /* Force mode-line redisplay. Useful here because all major mode
2674 commands call this function. */
2675 update_mode_lines++;
2677 return Qnil;
2680 /* Make sure no local variables remain set up with buffer B
2681 for their current values. */
2683 static void
2684 swap_out_buffer_local_variables (b)
2685 struct buffer *b;
2687 Lisp_Object oalist, alist, sym, buffer;
2689 XSETBUFFER (buffer, b);
2690 oalist = b->local_var_alist;
2692 for (alist = oalist; CONSP (alist); alist = XCDR (alist))
2694 if (CONSP (XCAR (alist))
2695 && (sym = XCAR (XCAR (alist)), SYMBOLP (sym))
2696 /* Need not do anything if some other buffer's binding is
2697 now encached. */
2698 && EQ (XBUFFER_LOCAL_VALUE (SYMBOL_VALUE (sym))->buffer,
2699 buffer))
2701 /* Symbol is set up for this buffer's old local value:
2702 swap it out! */
2703 swap_in_global_binding (sym);
2708 /* Find all the overlays in the current buffer that contain position POS.
2709 Return the number found, and store them in a vector in *VEC_PTR.
2710 Store in *LEN_PTR the size allocated for the vector.
2711 Store in *NEXT_PTR the next position after POS where an overlay starts,
2712 or ZV if there are no more overlays between POS and ZV.
2713 Store in *PREV_PTR the previous position before POS where an overlay ends,
2714 or where an overlay starts which ends at or after POS;
2715 or BEGV if there are no such overlays from BEGV to POS.
2716 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
2718 *VEC_PTR and *LEN_PTR should contain a valid vector and size
2719 when this function is called.
2721 If EXTEND is non-zero, we make the vector bigger if necessary.
2722 If EXTEND is zero, we never extend the vector,
2723 and we store only as many overlays as will fit.
2724 But we still return the total number of overlays.
2726 If CHANGE_REQ is true, then any position written into *PREV_PTR or
2727 *NEXT_PTR is guaranteed to be not equal to POS, unless it is the
2728 default (BEGV or ZV). */
2731 overlays_at (pos, extend, vec_ptr, len_ptr, next_ptr, prev_ptr, change_req)
2732 EMACS_INT pos;
2733 int extend;
2734 Lisp_Object **vec_ptr;
2735 int *len_ptr;
2736 EMACS_INT *next_ptr;
2737 EMACS_INT *prev_ptr;
2738 int change_req;
2740 Lisp_Object overlay, start, end;
2741 struct Lisp_Overlay *tail;
2742 int idx = 0;
2743 int len = *len_ptr;
2744 Lisp_Object *vec = *vec_ptr;
2745 int next = ZV;
2746 int prev = BEGV;
2747 int inhibit_storing = 0;
2749 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
2751 int startpos, endpos;
2753 XSETMISC (overlay, tail);
2755 start = OVERLAY_START (overlay);
2756 end = OVERLAY_END (overlay);
2757 endpos = OVERLAY_POSITION (end);
2758 if (endpos < pos)
2760 if (prev < endpos)
2761 prev = endpos;
2762 break;
2764 startpos = OVERLAY_POSITION (start);
2765 /* This one ends at or after POS
2766 so its start counts for PREV_PTR if it's before POS. */
2767 if (prev < startpos && startpos < pos)
2768 prev = startpos;
2769 if (endpos == pos)
2770 continue;
2771 if (startpos <= pos)
2773 if (idx == len)
2775 /* The supplied vector is full.
2776 Either make it bigger, or don't store any more in it. */
2777 if (extend)
2779 /* Make it work with an initial len == 0. */
2780 len *= 2;
2781 if (len == 0)
2782 len = 4;
2783 *len_ptr = len;
2784 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2785 *vec_ptr = vec;
2787 else
2788 inhibit_storing = 1;
2791 if (!inhibit_storing)
2792 vec[idx] = overlay;
2793 /* Keep counting overlays even if we can't return them all. */
2794 idx++;
2796 else if (startpos < next)
2797 next = startpos;
2800 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
2802 int startpos, endpos;
2804 XSETMISC (overlay, tail);
2806 start = OVERLAY_START (overlay);
2807 end = OVERLAY_END (overlay);
2808 startpos = OVERLAY_POSITION (start);
2809 if (pos < startpos)
2811 if (startpos < next)
2812 next = startpos;
2813 break;
2815 endpos = OVERLAY_POSITION (end);
2816 if (pos < endpos)
2818 if (idx == len)
2820 if (extend)
2822 /* Make it work with an initial len == 0. */
2823 len *= 2;
2824 if (len == 0)
2825 len = 4;
2826 *len_ptr = len;
2827 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2828 *vec_ptr = vec;
2830 else
2831 inhibit_storing = 1;
2834 if (!inhibit_storing)
2835 vec[idx] = overlay;
2836 idx++;
2838 if (startpos < pos && startpos > prev)
2839 prev = startpos;
2841 else if (endpos < pos && endpos > prev)
2842 prev = endpos;
2843 else if (endpos == pos && startpos > prev
2844 && (!change_req || startpos < pos))
2845 prev = startpos;
2848 if (next_ptr)
2849 *next_ptr = next;
2850 if (prev_ptr)
2851 *prev_ptr = prev;
2852 return idx;
2855 /* Find all the overlays in the current buffer that overlap the range
2856 BEG-END, or are empty at BEG, or are empty at END provided END
2857 denotes the position at the end of the current buffer.
2859 Return the number found, and store them in a vector in *VEC_PTR.
2860 Store in *LEN_PTR the size allocated for the vector.
2861 Store in *NEXT_PTR the next position after POS where an overlay starts,
2862 or ZV if there are no more overlays.
2863 Store in *PREV_PTR the previous position before POS where an overlay ends,
2864 or BEGV if there are no previous overlays.
2865 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
2867 *VEC_PTR and *LEN_PTR should contain a valid vector and size
2868 when this function is called.
2870 If EXTEND is non-zero, we make the vector bigger if necessary.
2871 If EXTEND is zero, we never extend the vector,
2872 and we store only as many overlays as will fit.
2873 But we still return the total number of overlays. */
2875 static int
2876 overlays_in (beg, end, extend, vec_ptr, len_ptr, next_ptr, prev_ptr)
2877 int beg, end;
2878 int extend;
2879 Lisp_Object **vec_ptr;
2880 int *len_ptr;
2881 int *next_ptr;
2882 int *prev_ptr;
2884 Lisp_Object overlay, ostart, oend;
2885 struct Lisp_Overlay *tail;
2886 int idx = 0;
2887 int len = *len_ptr;
2888 Lisp_Object *vec = *vec_ptr;
2889 int next = ZV;
2890 int prev = BEGV;
2891 int inhibit_storing = 0;
2892 int end_is_Z = end == Z;
2894 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
2896 int startpos, endpos;
2898 XSETMISC (overlay, tail);
2900 ostart = OVERLAY_START (overlay);
2901 oend = OVERLAY_END (overlay);
2902 endpos = OVERLAY_POSITION (oend);
2903 if (endpos < beg)
2905 if (prev < endpos)
2906 prev = endpos;
2907 break;
2909 startpos = OVERLAY_POSITION (ostart);
2910 /* Count an interval if it overlaps the range, is empty at the
2911 start of the range, or is empty at END provided END denotes the
2912 end of the buffer. */
2913 if ((beg < endpos && startpos < end)
2914 || (startpos == endpos
2915 && (beg == endpos || (end_is_Z && endpos == end))))
2917 if (idx == len)
2919 /* The supplied vector is full.
2920 Either make it bigger, or don't store any more in it. */
2921 if (extend)
2923 /* Make it work with an initial len == 0. */
2924 len *= 2;
2925 if (len == 0)
2926 len = 4;
2927 *len_ptr = len;
2928 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2929 *vec_ptr = vec;
2931 else
2932 inhibit_storing = 1;
2935 if (!inhibit_storing)
2936 vec[idx] = overlay;
2937 /* Keep counting overlays even if we can't return them all. */
2938 idx++;
2940 else if (startpos < next)
2941 next = startpos;
2944 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
2946 int startpos, endpos;
2948 XSETMISC (overlay, tail);
2950 ostart = OVERLAY_START (overlay);
2951 oend = OVERLAY_END (overlay);
2952 startpos = OVERLAY_POSITION (ostart);
2953 if (end < startpos)
2955 if (startpos < next)
2956 next = startpos;
2957 break;
2959 endpos = OVERLAY_POSITION (oend);
2960 /* Count an interval if it overlaps the range, is empty at the
2961 start of the range, or is empty at END provided END denotes the
2962 end of the buffer. */
2963 if ((beg < endpos && startpos < end)
2964 || (startpos == endpos
2965 && (beg == endpos || (end_is_Z && endpos == end))))
2967 if (idx == len)
2969 if (extend)
2971 /* Make it work with an initial len == 0. */
2972 len *= 2;
2973 if (len == 0)
2974 len = 4;
2975 *len_ptr = len;
2976 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2977 *vec_ptr = vec;
2979 else
2980 inhibit_storing = 1;
2983 if (!inhibit_storing)
2984 vec[idx] = overlay;
2985 idx++;
2987 else if (endpos < beg && endpos > prev)
2988 prev = endpos;
2991 if (next_ptr)
2992 *next_ptr = next;
2993 if (prev_ptr)
2994 *prev_ptr = prev;
2995 return idx;
2999 /* Return non-zero if there exists an overlay with a non-nil
3000 `mouse-face' property overlapping OVERLAY. */
3003 mouse_face_overlay_overlaps (overlay)
3004 Lisp_Object overlay;
3006 int start = OVERLAY_POSITION (OVERLAY_START (overlay));
3007 int end = OVERLAY_POSITION (OVERLAY_END (overlay));
3008 int n, i, size;
3009 Lisp_Object *v, tem;
3011 size = 10;
3012 v = (Lisp_Object *) alloca (size * sizeof *v);
3013 n = overlays_in (start, end, 0, &v, &size, NULL, NULL);
3014 if (n > size)
3016 v = (Lisp_Object *) alloca (n * sizeof *v);
3017 overlays_in (start, end, 0, &v, &n, NULL, NULL);
3020 for (i = 0; i < n; ++i)
3021 if (!EQ (v[i], overlay)
3022 && (tem = Foverlay_get (overlay, Qmouse_face),
3023 !NILP (tem)))
3024 break;
3026 return i < n;
3031 /* Fast function to just test if we're at an overlay boundary. */
3033 overlay_touches_p (pos)
3034 int pos;
3036 Lisp_Object overlay;
3037 struct Lisp_Overlay *tail;
3039 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
3041 int endpos;
3043 XSETMISC (overlay ,tail);
3044 if (!OVERLAYP (overlay))
3045 abort ();
3047 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3048 if (endpos < pos)
3049 break;
3050 if (endpos == pos || OVERLAY_POSITION (OVERLAY_START (overlay)) == pos)
3051 return 1;
3054 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
3056 int startpos;
3058 XSETMISC (overlay, tail);
3059 if (!OVERLAYP (overlay))
3060 abort ();
3062 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3063 if (pos < startpos)
3064 break;
3065 if (startpos == pos || OVERLAY_POSITION (OVERLAY_END (overlay)) == pos)
3066 return 1;
3068 return 0;
3071 struct sortvec
3073 Lisp_Object overlay;
3074 int beg, end;
3075 int priority;
3078 static int
3079 compare_overlays (v1, v2)
3080 const void *v1, *v2;
3082 const struct sortvec *s1 = (const struct sortvec *) v1;
3083 const struct sortvec *s2 = (const struct sortvec *) v2;
3084 if (s1->priority != s2->priority)
3085 return s1->priority - s2->priority;
3086 if (s1->beg != s2->beg)
3087 return s1->beg - s2->beg;
3088 if (s1->end != s2->end)
3089 return s2->end - s1->end;
3090 return 0;
3093 /* Sort an array of overlays by priority. The array is modified in place.
3094 The return value is the new size; this may be smaller than the original
3095 size if some of the overlays were invalid or were window-specific. */
3097 sort_overlays (overlay_vec, noverlays, w)
3098 Lisp_Object *overlay_vec;
3099 int noverlays;
3100 struct window *w;
3102 int i, j;
3103 struct sortvec *sortvec;
3104 sortvec = (struct sortvec *) alloca (noverlays * sizeof (struct sortvec));
3106 /* Put the valid and relevant overlays into sortvec. */
3108 for (i = 0, j = 0; i < noverlays; i++)
3110 Lisp_Object tem;
3111 Lisp_Object overlay;
3113 overlay = overlay_vec[i];
3114 if (OVERLAY_VALID (overlay)
3115 && OVERLAY_POSITION (OVERLAY_START (overlay)) > 0
3116 && OVERLAY_POSITION (OVERLAY_END (overlay)) > 0)
3118 /* If we're interested in a specific window, then ignore
3119 overlays that are limited to some other window. */
3120 if (w)
3122 Lisp_Object window;
3124 window = Foverlay_get (overlay, Qwindow);
3125 if (WINDOWP (window) && XWINDOW (window) != w)
3126 continue;
3129 /* This overlay is good and counts: put it into sortvec. */
3130 sortvec[j].overlay = overlay;
3131 sortvec[j].beg = OVERLAY_POSITION (OVERLAY_START (overlay));
3132 sortvec[j].end = OVERLAY_POSITION (OVERLAY_END (overlay));
3133 tem = Foverlay_get (overlay, Qpriority);
3134 if (INTEGERP (tem))
3135 sortvec[j].priority = XINT (tem);
3136 else
3137 sortvec[j].priority = 0;
3138 j++;
3141 noverlays = j;
3143 /* Sort the overlays into the proper order: increasing priority. */
3145 if (noverlays > 1)
3146 qsort (sortvec, noverlays, sizeof (struct sortvec), compare_overlays);
3148 for (i = 0; i < noverlays; i++)
3149 overlay_vec[i] = sortvec[i].overlay;
3150 return (noverlays);
3153 struct sortstr
3155 Lisp_Object string, string2;
3156 int size;
3157 int priority;
3160 struct sortstrlist
3162 struct sortstr *buf; /* An array that expands as needed; never freed. */
3163 int size; /* Allocated length of that array. */
3164 int used; /* How much of the array is currently in use. */
3165 int bytes; /* Total length of the strings in buf. */
3168 /* Buffers for storing information about the overlays touching a given
3169 position. These could be automatic variables in overlay_strings, but
3170 it's more efficient to hold onto the memory instead of repeatedly
3171 allocating and freeing it. */
3172 static struct sortstrlist overlay_heads, overlay_tails;
3173 static unsigned char *overlay_str_buf;
3175 /* Allocated length of overlay_str_buf. */
3176 static int overlay_str_len;
3178 /* A comparison function suitable for passing to qsort. */
3179 static int
3180 cmp_for_strings (as1, as2)
3181 char *as1, *as2;
3183 struct sortstr *s1 = (struct sortstr *)as1;
3184 struct sortstr *s2 = (struct sortstr *)as2;
3185 if (s1->size != s2->size)
3186 return s2->size - s1->size;
3187 if (s1->priority != s2->priority)
3188 return s1->priority - s2->priority;
3189 return 0;
3192 static void
3193 record_overlay_string (ssl, str, str2, pri, size)
3194 struct sortstrlist *ssl;
3195 Lisp_Object str, str2, pri;
3196 int size;
3198 int nbytes;
3200 if (ssl->used == ssl->size)
3202 if (ssl->buf)
3203 ssl->size *= 2;
3204 else
3205 ssl->size = 5;
3206 ssl->buf = ((struct sortstr *)
3207 xrealloc (ssl->buf, ssl->size * sizeof (struct sortstr)));
3209 ssl->buf[ssl->used].string = str;
3210 ssl->buf[ssl->used].string2 = str2;
3211 ssl->buf[ssl->used].size = size;
3212 ssl->buf[ssl->used].priority = (INTEGERP (pri) ? XINT (pri) : 0);
3213 ssl->used++;
3215 if (NILP (current_buffer->enable_multibyte_characters))
3216 nbytes = SCHARS (str);
3217 else if (! STRING_MULTIBYTE (str))
3218 nbytes = count_size_as_multibyte (SDATA (str),
3219 SBYTES (str));
3220 else
3221 nbytes = SBYTES (str);
3223 ssl->bytes += nbytes;
3225 if (STRINGP (str2))
3227 if (NILP (current_buffer->enable_multibyte_characters))
3228 nbytes = SCHARS (str2);
3229 else if (! STRING_MULTIBYTE (str2))
3230 nbytes = count_size_as_multibyte (SDATA (str2),
3231 SBYTES (str2));
3232 else
3233 nbytes = SBYTES (str2);
3235 ssl->bytes += nbytes;
3239 /* Return the concatenation of the strings associated with overlays that
3240 begin or end at POS, ignoring overlays that are specific to a window
3241 other than W. The strings are concatenated in the appropriate order:
3242 shorter overlays nest inside longer ones, and higher priority inside
3243 lower. Normally all of the after-strings come first, but zero-sized
3244 overlays have their after-strings ride along with the before-strings
3245 because it would look strange to print them inside-out.
3247 Returns the string length, and stores the contents indirectly through
3248 PSTR, if that variable is non-null. The string may be overwritten by
3249 subsequent calls. */
3252 overlay_strings (pos, w, pstr)
3253 EMACS_INT pos;
3254 struct window *w;
3255 unsigned char **pstr;
3257 Lisp_Object overlay, window, str;
3258 struct Lisp_Overlay *ov;
3259 int startpos, endpos;
3260 int multibyte = ! NILP (current_buffer->enable_multibyte_characters);
3262 overlay_heads.used = overlay_heads.bytes = 0;
3263 overlay_tails.used = overlay_tails.bytes = 0;
3264 for (ov = current_buffer->overlays_before; ov; ov = ov->next)
3266 XSETMISC (overlay, ov);
3267 eassert (OVERLAYP (overlay));
3269 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3270 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3271 if (endpos < pos)
3272 break;
3273 if (endpos != pos && startpos != pos)
3274 continue;
3275 window = Foverlay_get (overlay, Qwindow);
3276 if (WINDOWP (window) && XWINDOW (window) != w)
3277 continue;
3278 if (startpos == pos
3279 && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
3280 record_overlay_string (&overlay_heads, str,
3281 (startpos == endpos
3282 ? Foverlay_get (overlay, Qafter_string)
3283 : Qnil),
3284 Foverlay_get (overlay, Qpriority),
3285 endpos - startpos);
3286 else if (endpos == pos
3287 && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
3288 record_overlay_string (&overlay_tails, str, Qnil,
3289 Foverlay_get (overlay, Qpriority),
3290 endpos - startpos);
3292 for (ov = current_buffer->overlays_after; ov; ov = ov->next)
3294 XSETMISC (overlay, ov);
3295 eassert (OVERLAYP (overlay));
3297 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3298 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3299 if (startpos > pos)
3300 break;
3301 if (endpos != pos && startpos != pos)
3302 continue;
3303 window = Foverlay_get (overlay, Qwindow);
3304 if (WINDOWP (window) && XWINDOW (window) != w)
3305 continue;
3306 if (startpos == pos
3307 && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
3308 record_overlay_string (&overlay_heads, str,
3309 (startpos == endpos
3310 ? Foverlay_get (overlay, Qafter_string)
3311 : Qnil),
3312 Foverlay_get (overlay, Qpriority),
3313 endpos - startpos);
3314 else if (endpos == pos
3315 && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
3316 record_overlay_string (&overlay_tails, str, Qnil,
3317 Foverlay_get (overlay, Qpriority),
3318 endpos - startpos);
3320 if (overlay_tails.used > 1)
3321 qsort (overlay_tails.buf, overlay_tails.used, sizeof (struct sortstr),
3322 cmp_for_strings);
3323 if (overlay_heads.used > 1)
3324 qsort (overlay_heads.buf, overlay_heads.used, sizeof (struct sortstr),
3325 cmp_for_strings);
3326 if (overlay_heads.bytes || overlay_tails.bytes)
3328 Lisp_Object tem;
3329 int i;
3330 unsigned char *p;
3331 int total = overlay_heads.bytes + overlay_tails.bytes;
3333 if (total > overlay_str_len)
3335 overlay_str_len = total;
3336 overlay_str_buf = (unsigned char *)xrealloc (overlay_str_buf,
3337 total);
3339 p = overlay_str_buf;
3340 for (i = overlay_tails.used; --i >= 0;)
3342 int nbytes;
3343 tem = overlay_tails.buf[i].string;
3344 nbytes = copy_text (SDATA (tem), p,
3345 SBYTES (tem),
3346 STRING_MULTIBYTE (tem), multibyte);
3347 p += nbytes;
3349 for (i = 0; i < overlay_heads.used; ++i)
3351 int nbytes;
3352 tem = overlay_heads.buf[i].string;
3353 nbytes = copy_text (SDATA (tem), p,
3354 SBYTES (tem),
3355 STRING_MULTIBYTE (tem), multibyte);
3356 p += nbytes;
3357 tem = overlay_heads.buf[i].string2;
3358 if (STRINGP (tem))
3360 nbytes = copy_text (SDATA (tem), p,
3361 SBYTES (tem),
3362 STRING_MULTIBYTE (tem), multibyte);
3363 p += nbytes;
3366 if (p != overlay_str_buf + total)
3367 abort ();
3368 if (pstr)
3369 *pstr = overlay_str_buf;
3370 return total;
3372 return 0;
3375 /* Shift overlays in BUF's overlay lists, to center the lists at POS. */
3377 void
3378 recenter_overlay_lists (buf, pos)
3379 struct buffer *buf;
3380 EMACS_INT pos;
3382 Lisp_Object overlay, beg, end;
3383 struct Lisp_Overlay *prev, *tail, *next;
3385 /* See if anything in overlays_before should move to overlays_after. */
3387 /* We don't strictly need prev in this loop; it should always be nil.
3388 But we use it for symmetry and in case that should cease to be true
3389 with some future change. */
3390 prev = NULL;
3391 for (tail = buf->overlays_before; tail; prev = tail, tail = next)
3393 next = tail->next;
3394 XSETMISC (overlay, tail);
3396 /* If the overlay is not valid, get rid of it. */
3397 if (!OVERLAY_VALID (overlay))
3398 #if 1
3399 abort ();
3400 #else
3402 /* Splice the cons cell TAIL out of overlays_before. */
3403 if (!NILP (prev))
3404 XCDR (prev) = next;
3405 else
3406 buf->overlays_before = next;
3407 tail = prev;
3408 continue;
3410 #endif
3412 beg = OVERLAY_START (overlay);
3413 end = OVERLAY_END (overlay);
3415 if (OVERLAY_POSITION (end) > pos)
3417 /* OVERLAY needs to be moved. */
3418 int where = OVERLAY_POSITION (beg);
3419 struct Lisp_Overlay *other, *other_prev;
3421 /* Splice the cons cell TAIL out of overlays_before. */
3422 if (prev)
3423 prev->next = next;
3424 else
3425 buf->overlays_before = next;
3427 /* Search thru overlays_after for where to put it. */
3428 other_prev = NULL;
3429 for (other = buf->overlays_after; other;
3430 other_prev = other, other = other->next)
3432 Lisp_Object otherbeg, otheroverlay;
3434 XSETMISC (otheroverlay, other);
3435 eassert (OVERLAY_VALID (otheroverlay));
3437 otherbeg = OVERLAY_START (otheroverlay);
3438 if (OVERLAY_POSITION (otherbeg) >= where)
3439 break;
3442 /* Add TAIL to overlays_after before OTHER. */
3443 tail->next = other;
3444 if (other_prev)
3445 other_prev->next = tail;
3446 else
3447 buf->overlays_after = tail;
3448 tail = prev;
3450 else
3451 /* We've reached the things that should stay in overlays_before.
3452 All the rest of overlays_before must end even earlier,
3453 so stop now. */
3454 break;
3457 /* See if anything in overlays_after should be in overlays_before. */
3458 prev = NULL;
3459 for (tail = buf->overlays_after; tail; prev = tail, tail = next)
3461 next = tail->next;
3462 XSETMISC (overlay, tail);
3464 /* If the overlay is not valid, get rid of it. */
3465 if (!OVERLAY_VALID (overlay))
3466 #if 1
3467 abort ();
3468 #else
3470 /* Splice the cons cell TAIL out of overlays_after. */
3471 if (!NILP (prev))
3472 XCDR (prev) = next;
3473 else
3474 buf->overlays_after = next;
3475 tail = prev;
3476 continue;
3478 #endif
3480 beg = OVERLAY_START (overlay);
3481 end = OVERLAY_END (overlay);
3483 /* Stop looking, when we know that nothing further
3484 can possibly end before POS. */
3485 if (OVERLAY_POSITION (beg) > pos)
3486 break;
3488 if (OVERLAY_POSITION (end) <= pos)
3490 /* OVERLAY needs to be moved. */
3491 int where = OVERLAY_POSITION (end);
3492 struct Lisp_Overlay *other, *other_prev;
3494 /* Splice the cons cell TAIL out of overlays_after. */
3495 if (prev)
3496 prev->next = next;
3497 else
3498 buf->overlays_after = next;
3500 /* Search thru overlays_before for where to put it. */
3501 other_prev = NULL;
3502 for (other = buf->overlays_before; other;
3503 other_prev = other, other = other->next)
3505 Lisp_Object otherend, otheroverlay;
3507 XSETMISC (otheroverlay, other);
3508 eassert (OVERLAY_VALID (otheroverlay));
3510 otherend = OVERLAY_END (otheroverlay);
3511 if (OVERLAY_POSITION (otherend) <= where)
3512 break;
3515 /* Add TAIL to overlays_before before OTHER. */
3516 tail->next = other;
3517 if (other_prev)
3518 other_prev->next = tail;
3519 else
3520 buf->overlays_before = tail;
3521 tail = prev;
3525 buf->overlay_center = pos;
3528 void
3529 adjust_overlays_for_insert (pos, length)
3530 EMACS_INT pos;
3531 EMACS_INT length;
3533 /* After an insertion, the lists are still sorted properly,
3534 but we may need to update the value of the overlay center. */
3535 if (current_buffer->overlay_center >= pos)
3536 current_buffer->overlay_center += length;
3539 void
3540 adjust_overlays_for_delete (pos, length)
3541 EMACS_INT pos;
3542 EMACS_INT length;
3544 if (current_buffer->overlay_center < pos)
3545 /* The deletion was to our right. No change needed; the before- and
3546 after-lists are still consistent. */
3548 else if (current_buffer->overlay_center > pos + length)
3549 /* The deletion was to our left. We need to adjust the center value
3550 to account for the change in position, but the lists are consistent
3551 given the new value. */
3552 current_buffer->overlay_center -= length;
3553 else
3554 /* We're right in the middle. There might be things on the after-list
3555 that now belong on the before-list. Recentering will move them,
3556 and also update the center point. */
3557 recenter_overlay_lists (current_buffer, pos);
3560 /* Fix up overlays that were garbled as a result of permuting markers
3561 in the range START through END. Any overlay with at least one
3562 endpoint in this range will need to be unlinked from the overlay
3563 list and reinserted in its proper place.
3564 Such an overlay might even have negative size at this point.
3565 If so, we'll make the overlay empty. */
3566 void
3567 fix_start_end_in_overlays (start, end)
3568 register int start, end;
3570 Lisp_Object overlay;
3571 struct Lisp_Overlay *before_list, *after_list;
3572 /* These are either nil, indicating that before_list or after_list
3573 should be assigned, or the cons cell the cdr of which should be
3574 assigned. */
3575 struct Lisp_Overlay *beforep = NULL, *afterp = NULL;
3576 /* 'Parent', likewise, indicates a cons cell or
3577 current_buffer->overlays_before or overlays_after, depending
3578 which loop we're in. */
3579 struct Lisp_Overlay *tail, *parent;
3580 int startpos, endpos;
3582 /* This algorithm shifts links around instead of consing and GCing.
3583 The loop invariant is that before_list (resp. after_list) is a
3584 well-formed list except that its last element, the CDR of beforep
3585 (resp. afterp) if beforep (afterp) isn't nil or before_list
3586 (after_list) if it is, is still uninitialized. So it's not a bug
3587 that before_list isn't initialized, although it may look
3588 strange. */
3589 for (parent = NULL, tail = current_buffer->overlays_before; tail;)
3591 XSETMISC (overlay, tail);
3593 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3594 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3596 /* If the overlay is backwards, make it empty. */
3597 if (endpos < startpos)
3599 startpos = endpos;
3600 Fset_marker (OVERLAY_START (overlay), make_number (startpos),
3601 Qnil);
3604 if (endpos < start)
3605 break;
3607 if (endpos < end
3608 || (startpos >= start && startpos < end))
3610 /* Add it to the end of the wrong list. Later on,
3611 recenter_overlay_lists will move it to the right place. */
3612 if (endpos < current_buffer->overlay_center)
3614 if (!afterp)
3615 after_list = tail;
3616 else
3617 afterp->next = tail;
3618 afterp = tail;
3620 else
3622 if (!beforep)
3623 before_list = tail;
3624 else
3625 beforep->next = tail;
3626 beforep = tail;
3628 if (!parent)
3629 current_buffer->overlays_before = tail->next;
3630 else
3631 parent->next = tail->next;
3632 tail = tail->next;
3634 else
3635 parent = tail, tail = parent->next;
3637 for (parent = NULL, tail = current_buffer->overlays_after; tail;)
3639 XSETMISC (overlay, tail);
3641 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3642 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3644 /* If the overlay is backwards, make it empty. */
3645 if (endpos < startpos)
3647 startpos = endpos;
3648 Fset_marker (OVERLAY_START (overlay), make_number (startpos),
3649 Qnil);
3652 if (startpos >= end)
3653 break;
3655 if (startpos >= start
3656 || (endpos >= start && endpos < end))
3658 if (endpos < current_buffer->overlay_center)
3660 if (!afterp)
3661 after_list = tail;
3662 else
3663 afterp->next = tail;
3664 afterp = tail;
3666 else
3668 if (!beforep)
3669 before_list = tail;
3670 else
3671 beforep->next = tail;
3672 beforep = tail;
3674 if (!parent)
3675 current_buffer->overlays_after = tail->next;
3676 else
3677 parent->next = tail->next;
3678 tail = tail->next;
3680 else
3681 parent = tail, tail = parent->next;
3684 /* Splice the constructed (wrong) lists into the buffer's lists,
3685 and let the recenter function make it sane again. */
3686 if (beforep)
3688 beforep->next = current_buffer->overlays_before;
3689 current_buffer->overlays_before = before_list;
3691 recenter_overlay_lists (current_buffer, current_buffer->overlay_center);
3693 if (afterp)
3695 afterp->next = current_buffer->overlays_after;
3696 current_buffer->overlays_after = after_list;
3698 recenter_overlay_lists (current_buffer, current_buffer->overlay_center);
3701 /* We have two types of overlay: the one whose ending marker is
3702 after-insertion-marker (this is the usual case) and the one whose
3703 ending marker is before-insertion-marker. When `overlays_before'
3704 contains overlays of the latter type and the former type in this
3705 order and both overlays end at inserting position, inserting a text
3706 increases only the ending marker of the latter type, which results
3707 in incorrect ordering of `overlays_before'.
3709 This function fixes ordering of overlays in the slot
3710 `overlays_before' of the buffer *BP. Before the insertion, `point'
3711 was at PREV, and now is at POS. */
3713 void
3714 fix_overlays_before (bp, prev, pos)
3715 struct buffer *bp;
3716 EMACS_INT prev, pos;
3718 /* If parent is nil, replace overlays_before; otherwise, parent->next. */
3719 struct Lisp_Overlay *tail = bp->overlays_before, *parent = NULL, *right_pair;
3720 Lisp_Object tem;
3721 EMACS_INT end;
3723 /* After the insertion, the several overlays may be in incorrect
3724 order. The possibility is that, in the list `overlays_before',
3725 an overlay which ends at POS appears after an overlay which ends
3726 at PREV. Since POS is greater than PREV, we must fix the
3727 ordering of these overlays, by moving overlays ends at POS before
3728 the overlays ends at PREV. */
3730 /* At first, find a place where disordered overlays should be linked
3731 in. It is where an overlay which end before POS exists. (i.e. an
3732 overlay whose ending marker is after-insertion-marker if disorder
3733 exists). */
3734 while (tail
3735 && (XSETMISC (tem, tail),
3736 (end = OVERLAY_POSITION (OVERLAY_END (tem))) >= pos))
3738 parent = tail;
3739 tail = tail->next;
3742 /* If we don't find such an overlay,
3743 or the found one ends before PREV,
3744 or the found one is the last one in the list,
3745 we don't have to fix anything. */
3746 if (!tail || end < prev || !tail->next)
3747 return;
3749 right_pair = parent;
3750 parent = tail;
3751 tail = tail->next;
3753 /* Now, end position of overlays in the list TAIL should be before
3754 or equal to PREV. In the loop, an overlay which ends at POS is
3755 moved ahead to the place indicated by the CDR of RIGHT_PAIR. If
3756 we found an overlay which ends before PREV, the remaining
3757 overlays are in correct order. */
3758 while (tail)
3760 XSETMISC (tem, tail);
3761 end = OVERLAY_POSITION (OVERLAY_END (tem));
3763 if (end == pos)
3764 { /* This overlay is disordered. */
3765 struct Lisp_Overlay *found = tail;
3767 /* Unlink the found overlay. */
3768 tail = found->next;
3769 parent->next = tail;
3770 /* Move an overlay at RIGHT_PLACE to the next of the found one,
3771 and link it into the right place. */
3772 if (!right_pair)
3774 found->next = bp->overlays_before;
3775 bp->overlays_before = found;
3777 else
3779 found->next = right_pair->next;
3780 right_pair->next = found;
3783 else if (end == prev)
3785 parent = tail;
3786 tail = tail->next;
3788 else /* No more disordered overlay. */
3789 break;
3793 DEFUN ("overlayp", Foverlayp, Soverlayp, 1, 1, 0,
3794 doc: /* Return t if OBJECT is an overlay. */)
3795 (object)
3796 Lisp_Object object;
3798 return (OVERLAYP (object) ? Qt : Qnil);
3801 DEFUN ("make-overlay", Fmake_overlay, Smake_overlay, 2, 5, 0,
3802 doc: /* Create a new overlay with range BEG to END in BUFFER.
3803 If omitted, BUFFER defaults to the current buffer.
3804 BEG and END may be integers or markers.
3805 The fourth arg FRONT-ADVANCE, if non-nil, makes the marker
3806 for the front of the overlay advance when text is inserted there
3807 \(which means the text *is not* included in the overlay).
3808 The fifth arg REAR-ADVANCE, if non-nil, makes the marker
3809 for the rear of the overlay advance when text is inserted there
3810 \(which means the text *is* included in the overlay). */)
3811 (beg, end, buffer, front_advance, rear_advance)
3812 Lisp_Object beg, end, buffer;
3813 Lisp_Object front_advance, rear_advance;
3815 Lisp_Object overlay;
3816 struct buffer *b;
3818 if (NILP (buffer))
3819 XSETBUFFER (buffer, current_buffer);
3820 else
3821 CHECK_BUFFER (buffer);
3822 if (MARKERP (beg)
3823 && ! EQ (Fmarker_buffer (beg), buffer))
3824 error ("Marker points into wrong buffer");
3825 if (MARKERP (end)
3826 && ! EQ (Fmarker_buffer (end), buffer))
3827 error ("Marker points into wrong buffer");
3829 CHECK_NUMBER_COERCE_MARKER (beg);
3830 CHECK_NUMBER_COERCE_MARKER (end);
3832 if (XINT (beg) > XINT (end))
3834 Lisp_Object temp;
3835 temp = beg; beg = end; end = temp;
3838 b = XBUFFER (buffer);
3840 beg = Fset_marker (Fmake_marker (), beg, buffer);
3841 end = Fset_marker (Fmake_marker (), end, buffer);
3843 if (!NILP (front_advance))
3844 XMARKER (beg)->insertion_type = 1;
3845 if (!NILP (rear_advance))
3846 XMARKER (end)->insertion_type = 1;
3848 overlay = allocate_misc ();
3849 XMISCTYPE (overlay) = Lisp_Misc_Overlay;
3850 XOVERLAY (overlay)->start = beg;
3851 XOVERLAY (overlay)->end = end;
3852 XOVERLAY (overlay)->plist = Qnil;
3853 XOVERLAY (overlay)->next = NULL;
3855 /* Put the new overlay on the wrong list. */
3856 end = OVERLAY_END (overlay);
3857 if (OVERLAY_POSITION (end) < b->overlay_center)
3859 if (b->overlays_after)
3860 XOVERLAY (overlay)->next = b->overlays_after;
3861 b->overlays_after = XOVERLAY (overlay);
3863 else
3865 if (b->overlays_before)
3866 XOVERLAY (overlay)->next = b->overlays_before;
3867 b->overlays_before = XOVERLAY (overlay);
3870 /* This puts it in the right list, and in the right order. */
3871 recenter_overlay_lists (b, b->overlay_center);
3873 /* We don't need to redisplay the region covered by the overlay, because
3874 the overlay has no properties at the moment. */
3876 return overlay;
3879 /* Mark a section of BUF as needing redisplay because of overlays changes. */
3881 static void
3882 modify_overlay (buf, start, end)
3883 struct buffer *buf;
3884 EMACS_INT start, end;
3886 if (start > end)
3888 int temp = start;
3889 start = end;
3890 end = temp;
3893 BUF_COMPUTE_UNCHANGED (buf, start, end);
3895 /* If this is a buffer not in the selected window,
3896 we must do other windows. */
3897 if (buf != XBUFFER (XWINDOW (selected_window)->buffer))
3898 windows_or_buffers_changed = 1;
3899 /* If multiple windows show this buffer, we must do other windows. */
3900 else if (buffer_shared > 1)
3901 windows_or_buffers_changed = 1;
3902 /* If we modify an overlay at the end of the buffer, we cannot
3903 be sure that window end is still valid. */
3904 else if (end >= ZV && start <= ZV)
3905 windows_or_buffers_changed = 1;
3907 ++BUF_OVERLAY_MODIFF (buf);
3911 Lisp_Object Fdelete_overlay ();
3913 static struct Lisp_Overlay *
3914 unchain_overlay (list, overlay)
3915 struct Lisp_Overlay *list, *overlay;
3917 struct Lisp_Overlay *tmp, *prev;
3918 for (tmp = list, prev = NULL; tmp; prev = tmp, tmp = tmp->next)
3919 if (tmp == overlay)
3921 if (prev)
3922 prev->next = tmp->next;
3923 else
3924 list = tmp->next;
3925 overlay->next = NULL;
3926 break;
3928 return list;
3931 DEFUN ("move-overlay", Fmove_overlay, Smove_overlay, 3, 4, 0,
3932 doc: /* Set the endpoints of OVERLAY to BEG and END in BUFFER.
3933 If BUFFER is omitted, leave OVERLAY in the same buffer it inhabits now.
3934 If BUFFER is omitted, and OVERLAY is in no buffer, put it in the current
3935 buffer. */)
3936 (overlay, beg, end, buffer)
3937 Lisp_Object overlay, beg, end, buffer;
3939 struct buffer *b, *ob;
3940 Lisp_Object obuffer;
3941 int count = SPECPDL_INDEX ();
3943 CHECK_OVERLAY (overlay);
3944 if (NILP (buffer))
3945 buffer = Fmarker_buffer (OVERLAY_START (overlay));
3946 if (NILP (buffer))
3947 XSETBUFFER (buffer, current_buffer);
3948 CHECK_BUFFER (buffer);
3950 if (MARKERP (beg)
3951 && ! EQ (Fmarker_buffer (beg), buffer))
3952 error ("Marker points into wrong buffer");
3953 if (MARKERP (end)
3954 && ! EQ (Fmarker_buffer (end), buffer))
3955 error ("Marker points into wrong buffer");
3957 CHECK_NUMBER_COERCE_MARKER (beg);
3958 CHECK_NUMBER_COERCE_MARKER (end);
3960 if (XINT (beg) == XINT (end) && ! NILP (Foverlay_get (overlay, Qevaporate)))
3961 return Fdelete_overlay (overlay);
3963 if (XINT (beg) > XINT (end))
3965 Lisp_Object temp;
3966 temp = beg; beg = end; end = temp;
3969 specbind (Qinhibit_quit, Qt);
3971 obuffer = Fmarker_buffer (OVERLAY_START (overlay));
3972 b = XBUFFER (buffer);
3973 ob = BUFFERP (obuffer) ? XBUFFER (obuffer) : (struct buffer *) 0;
3975 /* If the overlay has changed buffers, do a thorough redisplay. */
3976 if (!EQ (buffer, obuffer))
3978 /* Redisplay where the overlay was. */
3979 if (!NILP (obuffer))
3981 int o_beg;
3982 int o_end;
3984 o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
3985 o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
3987 modify_overlay (ob, o_beg, o_end);
3990 /* Redisplay where the overlay is going to be. */
3991 modify_overlay (b, XINT (beg), XINT (end));
3993 else
3994 /* Redisplay the area the overlay has just left, or just enclosed. */
3996 int o_beg, o_end;
3998 o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
3999 o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
4001 if (o_beg == XINT (beg))
4002 modify_overlay (b, o_end, XINT (end));
4003 else if (o_end == XINT (end))
4004 modify_overlay (b, o_beg, XINT (beg));
4005 else
4007 if (XINT (beg) < o_beg) o_beg = XINT (beg);
4008 if (XINT (end) > o_end) o_end = XINT (end);
4009 modify_overlay (b, o_beg, o_end);
4013 if (!NILP (obuffer))
4015 ob->overlays_before
4016 = unchain_overlay (ob->overlays_before, XOVERLAY (overlay));
4017 ob->overlays_after
4018 = unchain_overlay (ob->overlays_after, XOVERLAY (overlay));
4019 eassert (XOVERLAY (overlay)->next == NULL);
4022 Fset_marker (OVERLAY_START (overlay), beg, buffer);
4023 Fset_marker (OVERLAY_END (overlay), end, buffer);
4025 /* Put the overlay on the wrong list. */
4026 end = OVERLAY_END (overlay);
4027 if (OVERLAY_POSITION (end) < b->overlay_center)
4029 XOVERLAY (overlay)->next = b->overlays_after;
4030 b->overlays_after = XOVERLAY (overlay);
4032 else
4034 XOVERLAY (overlay)->next = b->overlays_before;
4035 b->overlays_before = XOVERLAY (overlay);
4038 /* This puts it in the right list, and in the right order. */
4039 recenter_overlay_lists (b, b->overlay_center);
4041 return unbind_to (count, overlay);
4044 DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0,
4045 doc: /* Delete the overlay OVERLAY from its buffer. */)
4046 (overlay)
4047 Lisp_Object overlay;
4049 Lisp_Object buffer;
4050 struct buffer *b;
4051 int count = SPECPDL_INDEX ();
4053 CHECK_OVERLAY (overlay);
4055 buffer = Fmarker_buffer (OVERLAY_START (overlay));
4056 if (NILP (buffer))
4057 return Qnil;
4059 b = XBUFFER (buffer);
4060 specbind (Qinhibit_quit, Qt);
4062 b->overlays_before = unchain_overlay (b->overlays_before,XOVERLAY (overlay));
4063 b->overlays_after = unchain_overlay (b->overlays_after, XOVERLAY (overlay));
4064 eassert (XOVERLAY (overlay)->next == NULL);
4065 modify_overlay (b,
4066 marker_position (OVERLAY_START (overlay)),
4067 marker_position (OVERLAY_END (overlay)));
4068 Fset_marker (OVERLAY_START (overlay), Qnil, Qnil);
4069 Fset_marker (OVERLAY_END (overlay), Qnil, Qnil);
4071 /* When deleting an overlay with before or after strings, turn off
4072 display optimizations for the affected buffer, on the basis that
4073 these strings may contain newlines. This is easier to do than to
4074 check for that situation during redisplay. */
4075 if (!windows_or_buffers_changed
4076 && (!NILP (Foverlay_get (overlay, Qbefore_string))
4077 || !NILP (Foverlay_get (overlay, Qafter_string))))
4078 b->prevent_redisplay_optimizations_p = 1;
4080 return unbind_to (count, Qnil);
4083 /* Overlay dissection functions. */
4085 DEFUN ("overlay-start", Foverlay_start, Soverlay_start, 1, 1, 0,
4086 doc: /* Return the position at which OVERLAY starts. */)
4087 (overlay)
4088 Lisp_Object overlay;
4090 CHECK_OVERLAY (overlay);
4092 return (Fmarker_position (OVERLAY_START (overlay)));
4095 DEFUN ("overlay-end", Foverlay_end, Soverlay_end, 1, 1, 0,
4096 doc: /* Return the position at which OVERLAY ends. */)
4097 (overlay)
4098 Lisp_Object overlay;
4100 CHECK_OVERLAY (overlay);
4102 return (Fmarker_position (OVERLAY_END (overlay)));
4105 DEFUN ("overlay-buffer", Foverlay_buffer, Soverlay_buffer, 1, 1, 0,
4106 doc: /* Return the buffer OVERLAY belongs to.
4107 Return nil if OVERLAY has been deleted. */)
4108 (overlay)
4109 Lisp_Object overlay;
4111 CHECK_OVERLAY (overlay);
4113 return Fmarker_buffer (OVERLAY_START (overlay));
4116 DEFUN ("overlay-properties", Foverlay_properties, Soverlay_properties, 1, 1, 0,
4117 doc: /* Return a list of the properties on OVERLAY.
4118 This is a copy of OVERLAY's plist; modifying its conses has no effect on
4119 OVERLAY. */)
4120 (overlay)
4121 Lisp_Object overlay;
4123 CHECK_OVERLAY (overlay);
4125 return Fcopy_sequence (XOVERLAY (overlay)->plist);
4129 DEFUN ("overlays-at", Foverlays_at, Soverlays_at, 1, 1, 0,
4130 doc: /* Return a list of the overlays that contain the character at POS. */)
4131 (pos)
4132 Lisp_Object pos;
4134 int noverlays;
4135 Lisp_Object *overlay_vec;
4136 int len;
4137 Lisp_Object result;
4139 CHECK_NUMBER_COERCE_MARKER (pos);
4141 len = 10;
4142 /* We can't use alloca here because overlays_at can call xrealloc. */
4143 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
4145 /* Put all the overlays we want in a vector in overlay_vec.
4146 Store the length in len. */
4147 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
4148 (EMACS_INT *) 0, (EMACS_INT *) 0, 0);
4150 /* Make a list of them all. */
4151 result = Flist (noverlays, overlay_vec);
4153 xfree (overlay_vec);
4154 return result;
4157 DEFUN ("overlays-in", Foverlays_in, Soverlays_in, 2, 2, 0,
4158 doc: /* Return a list of the overlays that overlap the region BEG ... END.
4159 Overlap means that at least one character is contained within the overlay
4160 and also contained within the specified region.
4161 Empty overlays are included in the result if they are located at BEG,
4162 between BEG and END, or at END provided END denotes the position at the
4163 end of the buffer. */)
4164 (beg, end)
4165 Lisp_Object beg, end;
4167 int noverlays;
4168 Lisp_Object *overlay_vec;
4169 int len;
4170 Lisp_Object result;
4172 CHECK_NUMBER_COERCE_MARKER (beg);
4173 CHECK_NUMBER_COERCE_MARKER (end);
4175 len = 10;
4176 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
4178 /* Put all the overlays we want in a vector in overlay_vec.
4179 Store the length in len. */
4180 noverlays = overlays_in (XINT (beg), XINT (end), 1, &overlay_vec, &len,
4181 (int *) 0, (int *) 0);
4183 /* Make a list of them all. */
4184 result = Flist (noverlays, overlay_vec);
4186 xfree (overlay_vec);
4187 return result;
4190 DEFUN ("next-overlay-change", Fnext_overlay_change, Snext_overlay_change,
4191 1, 1, 0,
4192 doc: /* Return the next position after POS where an overlay starts or ends.
4193 If there are no overlay boundaries from POS to (point-max),
4194 the value is (point-max). */)
4195 (pos)
4196 Lisp_Object pos;
4198 int noverlays;
4199 EMACS_INT endpos;
4200 Lisp_Object *overlay_vec;
4201 int len;
4202 int i;
4204 CHECK_NUMBER_COERCE_MARKER (pos);
4206 len = 10;
4207 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
4209 /* Put all the overlays we want in a vector in overlay_vec.
4210 Store the length in len.
4211 endpos gets the position where the next overlay starts. */
4212 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
4213 &endpos, (EMACS_INT *) 0, 1);
4215 /* If any of these overlays ends before endpos,
4216 use its ending point instead. */
4217 for (i = 0; i < noverlays; i++)
4219 Lisp_Object oend;
4220 EMACS_INT oendpos;
4222 oend = OVERLAY_END (overlay_vec[i]);
4223 oendpos = OVERLAY_POSITION (oend);
4224 if (oendpos < endpos)
4225 endpos = oendpos;
4228 xfree (overlay_vec);
4229 return make_number (endpos);
4232 DEFUN ("previous-overlay-change", Fprevious_overlay_change,
4233 Sprevious_overlay_change, 1, 1, 0,
4234 doc: /* Return the previous position before POS where an overlay starts or ends.
4235 If there are no overlay boundaries from (point-min) to POS,
4236 the value is (point-min). */)
4237 (pos)
4238 Lisp_Object pos;
4240 int noverlays;
4241 EMACS_INT prevpos;
4242 Lisp_Object *overlay_vec;
4243 int len;
4245 CHECK_NUMBER_COERCE_MARKER (pos);
4247 /* At beginning of buffer, we know the answer;
4248 avoid bug subtracting 1 below. */
4249 if (XINT (pos) == BEGV)
4250 return pos;
4252 len = 10;
4253 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
4255 /* Put all the overlays we want in a vector in overlay_vec.
4256 Store the length in len.
4257 prevpos gets the position of the previous change. */
4258 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
4259 (EMACS_INT *) 0, &prevpos, 1);
4261 xfree (overlay_vec);
4262 return make_number (prevpos);
4265 /* These functions are for debugging overlays. */
4267 DEFUN ("overlay-lists", Foverlay_lists, Soverlay_lists, 0, 0, 0,
4268 doc: /* Return a pair of lists giving all the overlays of the current buffer.
4269 The car has all the overlays before the overlay center;
4270 the cdr has all the overlays after the overlay center.
4271 Recentering overlays moves overlays between these lists.
4272 The lists you get are copies, so that changing them has no effect.
4273 However, the overlays you get are the real objects that the buffer uses. */)
4276 struct Lisp_Overlay *ol;
4277 Lisp_Object before = Qnil, after = Qnil, tmp;
4278 for (ol = current_buffer->overlays_before; ol; ol = ol->next)
4280 XSETMISC (tmp, ol);
4281 before = Fcons (tmp, before);
4283 for (ol = current_buffer->overlays_after; ol; ol = ol->next)
4285 XSETMISC (tmp, ol);
4286 after = Fcons (tmp, after);
4288 return Fcons (Fnreverse (before), Fnreverse (after));
4291 DEFUN ("overlay-recenter", Foverlay_recenter, Soverlay_recenter, 1, 1, 0,
4292 doc: /* Recenter the overlays of the current buffer around position POS.
4293 That makes overlay lookup faster for positions near POS (but perhaps slower
4294 for positions far away from POS). */)
4295 (pos)
4296 Lisp_Object pos;
4298 CHECK_NUMBER_COERCE_MARKER (pos);
4300 recenter_overlay_lists (current_buffer, XINT (pos));
4301 return Qnil;
4304 DEFUN ("overlay-get", Foverlay_get, Soverlay_get, 2, 2, 0,
4305 doc: /* Get the property of overlay OVERLAY with property name PROP. */)
4306 (overlay, prop)
4307 Lisp_Object overlay, prop;
4309 CHECK_OVERLAY (overlay);
4310 return lookup_char_property (XOVERLAY (overlay)->plist, prop, 0);
4313 DEFUN ("overlay-put", Foverlay_put, Soverlay_put, 3, 3, 0,
4314 doc: /* Set one property of overlay OVERLAY: give property PROP value VALUE. */)
4315 (overlay, prop, value)
4316 Lisp_Object overlay, prop, value;
4318 Lisp_Object tail, buffer;
4319 int changed;
4321 CHECK_OVERLAY (overlay);
4323 buffer = Fmarker_buffer (OVERLAY_START (overlay));
4325 for (tail = XOVERLAY (overlay)->plist;
4326 CONSP (tail) && CONSP (XCDR (tail));
4327 tail = XCDR (XCDR (tail)))
4328 if (EQ (XCAR (tail), prop))
4330 changed = !EQ (XCAR (XCDR (tail)), value);
4331 XSETCAR (XCDR (tail), value);
4332 goto found;
4334 /* It wasn't in the list, so add it to the front. */
4335 changed = !NILP (value);
4336 XOVERLAY (overlay)->plist
4337 = Fcons (prop, Fcons (value, XOVERLAY (overlay)->plist));
4338 found:
4339 if (! NILP (buffer))
4341 if (changed)
4342 modify_overlay (XBUFFER (buffer),
4343 marker_position (OVERLAY_START (overlay)),
4344 marker_position (OVERLAY_END (overlay)));
4345 if (EQ (prop, Qevaporate) && ! NILP (value)
4346 && (OVERLAY_POSITION (OVERLAY_START (overlay))
4347 == OVERLAY_POSITION (OVERLAY_END (overlay))))
4348 Fdelete_overlay (overlay);
4351 return value;
4354 /* Subroutine of report_overlay_modification. */
4356 /* Lisp vector holding overlay hook functions to call.
4357 Vector elements come in pairs.
4358 Each even-index element is a list of hook functions.
4359 The following odd-index element is the overlay they came from.
4361 Before the buffer change, we fill in this vector
4362 as we call overlay hook functions.
4363 After the buffer change, we get the functions to call from this vector.
4364 This way we always call the same functions before and after the change. */
4365 static Lisp_Object last_overlay_modification_hooks;
4367 /* Number of elements actually used in last_overlay_modification_hooks. */
4368 static int last_overlay_modification_hooks_used;
4370 /* Add one functionlist/overlay pair
4371 to the end of last_overlay_modification_hooks. */
4373 static void
4374 add_overlay_mod_hooklist (functionlist, overlay)
4375 Lisp_Object functionlist, overlay;
4377 int oldsize = XVECTOR (last_overlay_modification_hooks)->size;
4379 if (last_overlay_modification_hooks_used == oldsize)
4380 last_overlay_modification_hooks = larger_vector
4381 (last_overlay_modification_hooks, oldsize * 2, Qnil);
4382 ASET (last_overlay_modification_hooks, last_overlay_modification_hooks_used,
4383 functionlist); last_overlay_modification_hooks_used++;
4384 ASET (last_overlay_modification_hooks, last_overlay_modification_hooks_used,
4385 overlay); last_overlay_modification_hooks_used++;
4388 /* Run the modification-hooks of overlays that include
4389 any part of the text in START to END.
4390 If this change is an insertion, also
4391 run the insert-before-hooks of overlay starting at END,
4392 and the insert-after-hooks of overlay ending at START.
4394 This is called both before and after the modification.
4395 AFTER is nonzero when we call after the modification.
4397 ARG1, ARG2, ARG3 are arguments to pass to the hook functions.
4398 When AFTER is nonzero, they are the start position,
4399 the position after the inserted new text,
4400 and the length of deleted or replaced old text. */
4402 void
4403 report_overlay_modification (start, end, after, arg1, arg2, arg3)
4404 Lisp_Object start, end;
4405 int after;
4406 Lisp_Object arg1, arg2, arg3;
4408 Lisp_Object prop, overlay;
4409 struct Lisp_Overlay *tail;
4410 /* 1 if this change is an insertion. */
4411 int insertion = (after ? XFASTINT (arg3) == 0 : EQ (start, end));
4412 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4414 overlay = Qnil;
4415 tail = NULL;
4417 /* We used to run the functions as soon as we found them and only register
4418 them in last_overlay_modification_hooks for the purpose of the `after'
4419 case. But running elisp code as we traverse the list of overlays is
4420 painful because the list can be modified by the elisp code so we had to
4421 copy at several places. We now simply do a read-only traversal that
4422 only collects the functions to run and we run them afterwards. It's
4423 simpler, especially since all the code was already there. -stef */
4425 if (!after)
4427 /* We are being called before a change.
4428 Scan the overlays to find the functions to call. */
4429 last_overlay_modification_hooks_used = 0;
4430 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
4432 int startpos, endpos;
4433 Lisp_Object ostart, oend;
4435 XSETMISC (overlay, tail);
4437 ostart = OVERLAY_START (overlay);
4438 oend = OVERLAY_END (overlay);
4439 endpos = OVERLAY_POSITION (oend);
4440 if (XFASTINT (start) > endpos)
4441 break;
4442 startpos = OVERLAY_POSITION (ostart);
4443 if (insertion && (XFASTINT (start) == startpos
4444 || XFASTINT (end) == startpos))
4446 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
4447 if (!NILP (prop))
4448 add_overlay_mod_hooklist (prop, overlay);
4450 if (insertion && (XFASTINT (start) == endpos
4451 || XFASTINT (end) == endpos))
4453 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
4454 if (!NILP (prop))
4455 add_overlay_mod_hooklist (prop, overlay);
4457 /* Test for intersecting intervals. This does the right thing
4458 for both insertion and deletion. */
4459 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
4461 prop = Foverlay_get (overlay, Qmodification_hooks);
4462 if (!NILP (prop))
4463 add_overlay_mod_hooklist (prop, overlay);
4467 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
4469 int startpos, endpos;
4470 Lisp_Object ostart, oend;
4472 XSETMISC (overlay, tail);
4474 ostart = OVERLAY_START (overlay);
4475 oend = OVERLAY_END (overlay);
4476 startpos = OVERLAY_POSITION (ostart);
4477 endpos = OVERLAY_POSITION (oend);
4478 if (XFASTINT (end) < startpos)
4479 break;
4480 if (insertion && (XFASTINT (start) == startpos
4481 || XFASTINT (end) == startpos))
4483 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
4484 if (!NILP (prop))
4485 add_overlay_mod_hooklist (prop, overlay);
4487 if (insertion && (XFASTINT (start) == endpos
4488 || XFASTINT (end) == endpos))
4490 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
4491 if (!NILP (prop))
4492 add_overlay_mod_hooklist (prop, overlay);
4494 /* Test for intersecting intervals. This does the right thing
4495 for both insertion and deletion. */
4496 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
4498 prop = Foverlay_get (overlay, Qmodification_hooks);
4499 if (!NILP (prop))
4500 add_overlay_mod_hooklist (prop, overlay);
4505 GCPRO4 (overlay, arg1, arg2, arg3);
4507 /* Call the functions recorded in last_overlay_modification_hooks.
4508 First copy the vector contents, in case some of these hooks
4509 do subsequent modification of the buffer. */
4510 int size = last_overlay_modification_hooks_used;
4511 Lisp_Object *copy = (Lisp_Object *) alloca (size * sizeof (Lisp_Object));
4512 int i;
4514 bcopy (XVECTOR (last_overlay_modification_hooks)->contents,
4515 copy, size * sizeof (Lisp_Object));
4516 gcpro1.var = copy;
4517 gcpro1.nvars = size;
4519 for (i = 0; i < size;)
4521 Lisp_Object prop, overlay;
4522 prop = copy[i++];
4523 overlay = copy[i++];
4524 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
4527 UNGCPRO;
4530 static void
4531 call_overlay_mod_hooks (list, overlay, after, arg1, arg2, arg3)
4532 Lisp_Object list, overlay;
4533 int after;
4534 Lisp_Object arg1, arg2, arg3;
4536 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4538 GCPRO4 (list, arg1, arg2, arg3);
4540 while (CONSP (list))
4542 if (NILP (arg3))
4543 call4 (XCAR (list), overlay, after ? Qt : Qnil, arg1, arg2);
4544 else
4545 call5 (XCAR (list), overlay, after ? Qt : Qnil, arg1, arg2, arg3);
4546 list = XCDR (list);
4548 UNGCPRO;
4551 /* Delete any zero-sized overlays at position POS, if the `evaporate'
4552 property is set. */
4553 void
4554 evaporate_overlays (pos)
4555 EMACS_INT pos;
4557 Lisp_Object overlay, hit_list;
4558 struct Lisp_Overlay *tail;
4560 hit_list = Qnil;
4561 if (pos <= current_buffer->overlay_center)
4562 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
4564 int endpos;
4565 XSETMISC (overlay, tail);
4566 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
4567 if (endpos < pos)
4568 break;
4569 if (endpos == pos && OVERLAY_POSITION (OVERLAY_START (overlay)) == pos
4570 && ! NILP (Foverlay_get (overlay, Qevaporate)))
4571 hit_list = Fcons (overlay, hit_list);
4573 else
4574 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
4576 int startpos;
4577 XSETMISC (overlay, tail);
4578 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
4579 if (startpos > pos)
4580 break;
4581 if (startpos == pos && OVERLAY_POSITION (OVERLAY_END (overlay)) == pos
4582 && ! NILP (Foverlay_get (overlay, Qevaporate)))
4583 hit_list = Fcons (overlay, hit_list);
4585 for (; CONSP (hit_list); hit_list = XCDR (hit_list))
4586 Fdelete_overlay (XCAR (hit_list));
4589 /* Somebody has tried to store a value with an unacceptable type
4590 in the slot with offset OFFSET. */
4592 void
4593 buffer_slot_type_mismatch (newval, type)
4594 Lisp_Object newval;
4595 int type;
4597 Lisp_Object predicate;
4599 switch (type)
4601 case_Lisp_Int: predicate = Qintegerp; break;
4602 case Lisp_String: predicate = Qstringp; break;
4603 case Lisp_Symbol: predicate = Qsymbolp; break;
4604 default: abort ();
4607 wrong_type_argument (predicate, newval);
4611 /***********************************************************************
4612 Allocation with mmap
4613 ***********************************************************************/
4615 #ifdef USE_MMAP_FOR_BUFFERS
4617 #include <sys/types.h>
4618 #include <sys/mman.h>
4620 #ifndef MAP_ANON
4621 #ifdef MAP_ANONYMOUS
4622 #define MAP_ANON MAP_ANONYMOUS
4623 #else
4624 #define MAP_ANON 0
4625 #endif
4626 #endif
4628 #ifndef MAP_FAILED
4629 #define MAP_FAILED ((void *) -1)
4630 #endif
4632 #include <stdio.h>
4633 #include <errno.h>
4635 #if MAP_ANON == 0
4636 #include <fcntl.h>
4637 #endif
4639 #include "coding.h"
4642 /* Memory is allocated in regions which are mapped using mmap(2).
4643 The current implementation lets the system select mapped
4644 addresses; we're not using MAP_FIXED in general, except when
4645 trying to enlarge regions.
4647 Each mapped region starts with a mmap_region structure, the user
4648 area starts after that structure, aligned to MEM_ALIGN.
4650 +-----------------------+
4651 | struct mmap_info + |
4652 | padding |
4653 +-----------------------+
4654 | user data |
4657 +-----------------------+ */
4659 struct mmap_region
4661 /* User-specified size. */
4662 size_t nbytes_specified;
4664 /* Number of bytes mapped */
4665 size_t nbytes_mapped;
4667 /* Pointer to the location holding the address of the memory
4668 allocated with the mmap'd block. The variable actually points
4669 after this structure. */
4670 POINTER_TYPE **var;
4672 /* Next and previous in list of all mmap'd regions. */
4673 struct mmap_region *next, *prev;
4676 /* Doubly-linked list of mmap'd regions. */
4678 static struct mmap_region *mmap_regions;
4680 /* File descriptor for mmap. If we don't have anonymous mapping,
4681 /dev/zero will be opened on it. */
4683 static int mmap_fd;
4685 /* Temporary storage for mmap_set_vars, see there. */
4687 static struct mmap_region *mmap_regions_1;
4688 static int mmap_fd_1;
4690 /* Page size on this system. */
4692 static int mmap_page_size;
4694 /* 1 means mmap has been intialized. */
4696 static int mmap_initialized_p;
4698 /* Value is X rounded up to the next multiple of N. */
4700 #define ROUND(X, N) (((X) + (N) - 1) / (N) * (N))
4702 /* Size of mmap_region structure plus padding. */
4704 #define MMAP_REGION_STRUCT_SIZE \
4705 ROUND (sizeof (struct mmap_region), MEM_ALIGN)
4707 /* Given a pointer P to the start of the user-visible part of a mapped
4708 region, return a pointer to the start of the region. */
4710 #define MMAP_REGION(P) \
4711 ((struct mmap_region *) ((char *) (P) - MMAP_REGION_STRUCT_SIZE))
4713 /* Given a pointer P to the start of a mapped region, return a pointer
4714 to the start of the user-visible part of the region. */
4716 #define MMAP_USER_AREA(P) \
4717 ((POINTER_TYPE *) ((char *) (P) + MMAP_REGION_STRUCT_SIZE))
4719 #define MEM_ALIGN sizeof (double)
4721 /* Predicate returning true if part of the address range [START .. END]
4722 is currently mapped. Used to prevent overwriting an existing
4723 memory mapping.
4725 Default is to conservativly assume the address range is occupied by
4726 something else. This can be overridden by system configuration
4727 files if system-specific means to determine this exists. */
4729 #ifndef MMAP_ALLOCATED_P
4730 #define MMAP_ALLOCATED_P(start, end) 1
4731 #endif
4733 /* Function prototypes. */
4735 static int mmap_free_1 P_ ((struct mmap_region *));
4736 static int mmap_enlarge P_ ((struct mmap_region *, int));
4737 static struct mmap_region *mmap_find P_ ((POINTER_TYPE *, POINTER_TYPE *));
4738 static POINTER_TYPE *mmap_alloc P_ ((POINTER_TYPE **, size_t));
4739 static POINTER_TYPE *mmap_realloc P_ ((POINTER_TYPE **, size_t));
4740 static void mmap_free P_ ((POINTER_TYPE **ptr));
4741 static void mmap_init P_ ((void));
4744 /* Return a region overlapping address range START...END, or null if
4745 none. END is not including, i.e. the last byte in the range
4746 is at END - 1. */
4748 static struct mmap_region *
4749 mmap_find (start, end)
4750 POINTER_TYPE *start, *end;
4752 struct mmap_region *r;
4753 char *s = (char *) start, *e = (char *) end;
4755 for (r = mmap_regions; r; r = r->next)
4757 char *rstart = (char *) r;
4758 char *rend = rstart + r->nbytes_mapped;
4760 if (/* First byte of range, i.e. START, in this region? */
4761 (s >= rstart && s < rend)
4762 /* Last byte of range, i.e. END - 1, in this region? */
4763 || (e > rstart && e <= rend)
4764 /* First byte of this region in the range? */
4765 || (rstart >= s && rstart < e)
4766 /* Last byte of this region in the range? */
4767 || (rend > s && rend <= e))
4768 break;
4771 return r;
4775 /* Unmap a region. P is a pointer to the start of the user-araa of
4776 the region. Value is non-zero if successful. */
4778 static int
4779 mmap_free_1 (r)
4780 struct mmap_region *r;
4782 if (r->next)
4783 r->next->prev = r->prev;
4784 if (r->prev)
4785 r->prev->next = r->next;
4786 else
4787 mmap_regions = r->next;
4789 if (munmap ((POINTER_TYPE *) r, r->nbytes_mapped) == -1)
4791 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4792 return 0;
4795 return 1;
4799 /* Enlarge region R by NPAGES pages. NPAGES < 0 means shrink R.
4800 Value is non-zero if successful. */
4802 static int
4803 mmap_enlarge (r, npages)
4804 struct mmap_region *r;
4805 int npages;
4807 char *region_end = (char *) r + r->nbytes_mapped;
4808 size_t nbytes;
4809 int success = 0;
4811 if (npages < 0)
4813 /* Unmap pages at the end of the region. */
4814 nbytes = - npages * mmap_page_size;
4815 if (munmap (region_end - nbytes, nbytes) == -1)
4816 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4817 else
4819 r->nbytes_mapped -= nbytes;
4820 success = 1;
4823 else if (npages > 0)
4825 nbytes = npages * mmap_page_size;
4827 /* Try to map additional pages at the end of the region. We
4828 cannot do this if the address range is already occupied by
4829 something else because mmap deletes any previous mapping.
4830 I'm not sure this is worth doing, let's see. */
4831 if (!MMAP_ALLOCATED_P (region_end, region_end + nbytes))
4833 POINTER_TYPE *p;
4835 p = mmap (region_end, nbytes, PROT_READ | PROT_WRITE,
4836 MAP_ANON | MAP_PRIVATE | MAP_FIXED, mmap_fd, 0);
4837 if (p == MAP_FAILED)
4838 ; /* fprintf (stderr, "mmap: %s\n", emacs_strerror (errno)); */
4839 else if (p != (POINTER_TYPE *) region_end)
4841 /* Kernels are free to choose a different address. In
4842 that case, unmap what we've mapped above; we have
4843 no use for it. */
4844 if (munmap (p, nbytes) == -1)
4845 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4847 else
4849 r->nbytes_mapped += nbytes;
4850 success = 1;
4855 return success;
4859 /* Set or reset variables holding references to mapped regions. If
4860 RESTORE_P is zero, set all variables to null. If RESTORE_P is
4861 non-zero, set all variables to the start of the user-areas
4862 of mapped regions.
4864 This function is called from Fdump_emacs to ensure that the dumped
4865 Emacs doesn't contain references to memory that won't be mapped
4866 when Emacs starts. */
4868 void
4869 mmap_set_vars (restore_p)
4870 int restore_p;
4872 struct mmap_region *r;
4874 if (restore_p)
4876 mmap_regions = mmap_regions_1;
4877 mmap_fd = mmap_fd_1;
4878 for (r = mmap_regions; r; r = r->next)
4879 *r->var = MMAP_USER_AREA (r);
4881 else
4883 for (r = mmap_regions; r; r = r->next)
4884 *r->var = NULL;
4885 mmap_regions_1 = mmap_regions;
4886 mmap_regions = NULL;
4887 mmap_fd_1 = mmap_fd;
4888 mmap_fd = -1;
4893 /* Allocate a block of storage large enough to hold NBYTES bytes of
4894 data. A pointer to the data is returned in *VAR. VAR is thus the
4895 address of some variable which will use the data area.
4897 The allocation of 0 bytes is valid.
4899 If we can't allocate the necessary memory, set *VAR to null, and
4900 return null. */
4902 static POINTER_TYPE *
4903 mmap_alloc (var, nbytes)
4904 POINTER_TYPE **var;
4905 size_t nbytes;
4907 void *p;
4908 size_t map;
4910 mmap_init ();
4912 map = ROUND (nbytes + MMAP_REGION_STRUCT_SIZE, mmap_page_size);
4913 p = mmap (NULL, map, PROT_READ | PROT_WRITE, MAP_ANON | MAP_PRIVATE,
4914 mmap_fd, 0);
4916 if (p == MAP_FAILED)
4918 if (errno != ENOMEM)
4919 fprintf (stderr, "mmap: %s\n", emacs_strerror (errno));
4920 p = NULL;
4922 else
4924 struct mmap_region *r = (struct mmap_region *) p;
4926 r->nbytes_specified = nbytes;
4927 r->nbytes_mapped = map;
4928 r->var = var;
4929 r->prev = NULL;
4930 r->next = mmap_regions;
4931 if (r->next)
4932 r->next->prev = r;
4933 mmap_regions = r;
4935 p = MMAP_USER_AREA (p);
4938 return *var = p;
4942 /* Given a pointer at address VAR to data allocated with mmap_alloc,
4943 resize it to size NBYTES. Change *VAR to reflect the new block,
4944 and return this value. If more memory cannot be allocated, then
4945 leave *VAR unchanged, and return null. */
4947 static POINTER_TYPE *
4948 mmap_realloc (var, nbytes)
4949 POINTER_TYPE **var;
4950 size_t nbytes;
4952 POINTER_TYPE *result;
4954 mmap_init ();
4956 if (*var == NULL)
4957 result = mmap_alloc (var, nbytes);
4958 else if (nbytes == 0)
4960 mmap_free (var);
4961 result = mmap_alloc (var, nbytes);
4963 else
4965 struct mmap_region *r = MMAP_REGION (*var);
4966 size_t room = r->nbytes_mapped - MMAP_REGION_STRUCT_SIZE;
4968 if (room < nbytes)
4970 /* Must enlarge. */
4971 POINTER_TYPE *old_ptr = *var;
4973 /* Try to map additional pages at the end of the region.
4974 If that fails, allocate a new region, copy data
4975 from the old region, then free it. */
4976 if (mmap_enlarge (r, (ROUND (nbytes - room, mmap_page_size)
4977 / mmap_page_size)))
4979 r->nbytes_specified = nbytes;
4980 *var = result = old_ptr;
4982 else if (mmap_alloc (var, nbytes))
4984 bcopy (old_ptr, *var, r->nbytes_specified);
4985 mmap_free_1 (MMAP_REGION (old_ptr));
4986 result = *var;
4987 r = MMAP_REGION (result);
4988 r->nbytes_specified = nbytes;
4990 else
4992 *var = old_ptr;
4993 result = NULL;
4996 else if (room - nbytes >= mmap_page_size)
4998 /* Shrinking by at least a page. Let's give some
4999 memory back to the system.
5001 The extra parens are to make the division happens first,
5002 on positive values, so we know it will round towards
5003 zero. */
5004 mmap_enlarge (r, - ((room - nbytes) / mmap_page_size));
5005 result = *var;
5006 r->nbytes_specified = nbytes;
5008 else
5010 /* Leave it alone. */
5011 result = *var;
5012 r->nbytes_specified = nbytes;
5016 return result;
5020 /* Free a block of relocatable storage whose data is pointed to by
5021 PTR. Store 0 in *PTR to show there's no block allocated. */
5023 static void
5024 mmap_free (var)
5025 POINTER_TYPE **var;
5027 mmap_init ();
5029 if (*var)
5031 mmap_free_1 (MMAP_REGION (*var));
5032 *var = NULL;
5037 /* Perform necessary intializations for the use of mmap. */
5039 static void
5040 mmap_init ()
5042 #if MAP_ANON == 0
5043 /* The value of mmap_fd is initially 0 in temacs, and -1
5044 in a dumped Emacs. */
5045 if (mmap_fd <= 0)
5047 /* No anonymous mmap -- we need the file descriptor. */
5048 mmap_fd = open ("/dev/zero", O_RDONLY);
5049 if (mmap_fd == -1)
5050 fatal ("Cannot open /dev/zero: %s", emacs_strerror (errno));
5052 #endif /* MAP_ANON == 0 */
5054 if (mmap_initialized_p)
5055 return;
5056 mmap_initialized_p = 1;
5058 #if MAP_ANON != 0
5059 mmap_fd = -1;
5060 #endif
5062 mmap_page_size = getpagesize ();
5065 #endif /* USE_MMAP_FOR_BUFFERS */
5069 /***********************************************************************
5070 Buffer-text Allocation
5071 ***********************************************************************/
5073 #ifdef REL_ALLOC
5074 extern POINTER_TYPE *r_alloc P_ ((POINTER_TYPE **, size_t));
5075 extern POINTER_TYPE *r_re_alloc P_ ((POINTER_TYPE **, size_t));
5076 extern void r_alloc_free P_ ((POINTER_TYPE **ptr));
5077 #endif /* REL_ALLOC */
5080 /* Allocate NBYTES bytes for buffer B's text buffer. */
5082 static void
5083 alloc_buffer_text (b, nbytes)
5084 struct buffer *b;
5085 size_t nbytes;
5087 POINTER_TYPE *p;
5089 BLOCK_INPUT;
5090 #if defined USE_MMAP_FOR_BUFFERS
5091 p = mmap_alloc ((POINTER_TYPE **) &b->text->beg, nbytes);
5092 #elif defined REL_ALLOC
5093 p = r_alloc ((POINTER_TYPE **) &b->text->beg, nbytes);
5094 #else
5095 p = xmalloc (nbytes);
5096 #endif
5098 if (p == NULL)
5100 UNBLOCK_INPUT;
5101 memory_full ();
5104 b->text->beg = (unsigned char *) p;
5105 UNBLOCK_INPUT;
5108 /* Enlarge buffer B's text buffer by DELTA bytes. DELTA < 0 means
5109 shrink it. */
5111 void
5112 enlarge_buffer_text (struct buffer *b, EMACS_INT delta)
5114 POINTER_TYPE *p;
5115 size_t nbytes = (BUF_Z_BYTE (b) - BUF_BEG_BYTE (b) + BUF_GAP_SIZE (b) + 1
5116 + delta);
5117 BLOCK_INPUT;
5118 #if defined USE_MMAP_FOR_BUFFERS
5119 p = mmap_realloc ((POINTER_TYPE **) &b->text->beg, nbytes);
5120 #elif defined REL_ALLOC
5121 p = r_re_alloc ((POINTER_TYPE **) &b->text->beg, nbytes);
5122 #else
5123 p = xrealloc (b->text->beg, nbytes);
5124 #endif
5126 if (p == NULL)
5128 UNBLOCK_INPUT;
5129 memory_full ();
5132 BUF_BEG_ADDR (b) = (unsigned char *) p;
5133 UNBLOCK_INPUT;
5137 /* Free buffer B's text buffer. */
5139 static void
5140 free_buffer_text (b)
5141 struct buffer *b;
5143 BLOCK_INPUT;
5145 #if defined USE_MMAP_FOR_BUFFERS
5146 mmap_free ((POINTER_TYPE **) &b->text->beg);
5147 #elif defined REL_ALLOC
5148 r_alloc_free ((POINTER_TYPE **) &b->text->beg);
5149 #else
5150 xfree (b->text->beg);
5151 #endif
5153 BUF_BEG_ADDR (b) = NULL;
5154 UNBLOCK_INPUT;
5159 /***********************************************************************
5160 Initialization
5161 ***********************************************************************/
5163 void
5164 init_buffer_once ()
5166 int idx;
5168 bzero (buffer_permanent_local_flags, sizeof buffer_permanent_local_flags);
5170 /* Make sure all markable slots in buffer_defaults
5171 are initialized reasonably, so mark_buffer won't choke. */
5172 reset_buffer (&buffer_defaults);
5173 reset_buffer_local_variables (&buffer_defaults, 1);
5174 reset_buffer (&buffer_local_symbols);
5175 reset_buffer_local_variables (&buffer_local_symbols, 1);
5176 /* Prevent GC from getting confused. */
5177 buffer_defaults.text = &buffer_defaults.own_text;
5178 buffer_local_symbols.text = &buffer_local_symbols.own_text;
5179 BUF_INTERVALS (&buffer_defaults) = 0;
5180 BUF_INTERVALS (&buffer_local_symbols) = 0;
5181 XSETPVECTYPE (&buffer_defaults, PVEC_BUFFER);
5182 XSETBUFFER (Vbuffer_defaults, &buffer_defaults);
5183 XSETPVECTYPE (&buffer_local_symbols, PVEC_BUFFER);
5184 XSETBUFFER (Vbuffer_local_symbols, &buffer_local_symbols);
5186 /* Set up the default values of various buffer slots. */
5187 /* Must do these before making the first buffer! */
5189 /* real setup is done in bindings.el */
5190 buffer_defaults.mode_line_format = make_pure_c_string ("%-");
5191 buffer_defaults.header_line_format = Qnil;
5192 buffer_defaults.abbrev_mode = Qnil;
5193 buffer_defaults.overwrite_mode = Qnil;
5194 buffer_defaults.case_fold_search = Qt;
5195 buffer_defaults.auto_fill_function = Qnil;
5196 buffer_defaults.selective_display = Qnil;
5197 #ifndef old
5198 buffer_defaults.selective_display_ellipses = Qt;
5199 #endif
5200 buffer_defaults.abbrev_table = Qnil;
5201 buffer_defaults.display_table = Qnil;
5202 buffer_defaults.undo_list = Qnil;
5203 buffer_defaults.mark_active = Qnil;
5204 buffer_defaults.file_format = Qnil;
5205 buffer_defaults.auto_save_file_format = Qt;
5206 buffer_defaults.overlays_before = NULL;
5207 buffer_defaults.overlays_after = NULL;
5208 buffer_defaults.overlay_center = BEG;
5210 XSETFASTINT (buffer_defaults.tab_width, 8);
5211 buffer_defaults.truncate_lines = Qnil;
5212 buffer_defaults.word_wrap = Qnil;
5213 buffer_defaults.ctl_arrow = Qt;
5214 buffer_defaults.direction_reversed = Qnil;
5215 buffer_defaults.cursor_type = Qt;
5216 buffer_defaults.extra_line_spacing = Qnil;
5217 buffer_defaults.cursor_in_non_selected_windows = Qt;
5218 buffer_defaults.owner = Qnil;
5219 buffer_defaults.prev_owner = Qnil;
5221 #ifdef DOS_NT
5222 buffer_defaults.buffer_file_type = Qnil; /* TEXT */
5223 #endif
5224 buffer_defaults.enable_multibyte_characters = Qt;
5225 buffer_defaults.buffer_file_coding_system = Qnil;
5226 XSETFASTINT (buffer_defaults.fill_column, 70);
5227 XSETFASTINT (buffer_defaults.left_margin, 0);
5228 buffer_defaults.cache_long_line_scans = Qnil;
5229 buffer_defaults.file_truename = Qnil;
5230 XSETFASTINT (buffer_defaults.display_count, 0);
5231 XSETFASTINT (buffer_defaults.left_margin_cols, 0);
5232 XSETFASTINT (buffer_defaults.right_margin_cols, 0);
5233 buffer_defaults.left_fringe_width = Qnil;
5234 buffer_defaults.right_fringe_width = Qnil;
5235 buffer_defaults.fringes_outside_margins = Qnil;
5236 buffer_defaults.scroll_bar_width = Qnil;
5237 buffer_defaults.vertical_scroll_bar_type = Qt;
5238 buffer_defaults.indicate_empty_lines = Qnil;
5239 buffer_defaults.indicate_buffer_boundaries = Qnil;
5240 buffer_defaults.fringe_indicator_alist = Qnil;
5241 buffer_defaults.fringe_cursor_alist = Qnil;
5242 buffer_defaults.scroll_up_aggressively = Qnil;
5243 buffer_defaults.scroll_down_aggressively = Qnil;
5244 buffer_defaults.display_time = Qnil;
5246 /* Assign the local-flags to the slots that have default values.
5247 The local flag is a bit that is used in the buffer
5248 to say that it has its own local value for the slot.
5249 The local flag bits are in the local_var_flags slot of the buffer. */
5251 /* Nothing can work if this isn't true */
5252 if (sizeof (EMACS_INT) != sizeof (Lisp_Object)) abort ();
5254 /* 0 means not a lisp var, -1 means always local, else mask */
5255 bzero (&buffer_local_flags, sizeof buffer_local_flags);
5256 XSETINT (buffer_local_flags.filename, -1);
5257 XSETINT (buffer_local_flags.directory, -1);
5258 XSETINT (buffer_local_flags.backed_up, -1);
5259 XSETINT (buffer_local_flags.save_length, -1);
5260 XSETINT (buffer_local_flags.auto_save_file_name, -1);
5261 XSETINT (buffer_local_flags.read_only, -1);
5262 XSETINT (buffer_local_flags.major_mode, -1);
5263 XSETINT (buffer_local_flags.mode_name, -1);
5264 XSETINT (buffer_local_flags.undo_list, -1);
5265 XSETINT (buffer_local_flags.mark_active, -1);
5266 XSETINT (buffer_local_flags.point_before_scroll, -1);
5267 XSETINT (buffer_local_flags.file_truename, -1);
5268 XSETINT (buffer_local_flags.invisibility_spec, -1);
5269 XSETINT (buffer_local_flags.file_format, -1);
5270 XSETINT (buffer_local_flags.auto_save_file_format, -1);
5271 XSETINT (buffer_local_flags.display_count, -1);
5272 XSETINT (buffer_local_flags.display_time, -1);
5273 XSETINT (buffer_local_flags.enable_multibyte_characters, -1);
5275 idx = 1;
5276 XSETFASTINT (buffer_local_flags.mode_line_format, idx); ++idx;
5277 XSETFASTINT (buffer_local_flags.abbrev_mode, idx); ++idx;
5278 XSETFASTINT (buffer_local_flags.overwrite_mode, idx); ++idx;
5279 XSETFASTINT (buffer_local_flags.case_fold_search, idx); ++idx;
5280 XSETFASTINT (buffer_local_flags.auto_fill_function, idx); ++idx;
5281 XSETFASTINT (buffer_local_flags.selective_display, idx); ++idx;
5282 #ifndef old
5283 XSETFASTINT (buffer_local_flags.selective_display_ellipses, idx); ++idx;
5284 #endif
5285 XSETFASTINT (buffer_local_flags.tab_width, idx); ++idx;
5286 XSETFASTINT (buffer_local_flags.truncate_lines, idx); ++idx;
5287 XSETFASTINT (buffer_local_flags.word_wrap, idx); ++idx;
5288 XSETFASTINT (buffer_local_flags.ctl_arrow, idx); ++idx;
5289 XSETFASTINT (buffer_local_flags.fill_column, idx); ++idx;
5290 XSETFASTINT (buffer_local_flags.left_margin, idx); ++idx;
5291 XSETFASTINT (buffer_local_flags.abbrev_table, idx); ++idx;
5292 XSETFASTINT (buffer_local_flags.display_table, idx); ++idx;
5293 #ifdef DOS_NT
5294 XSETFASTINT (buffer_local_flags.buffer_file_type, idx);
5295 /* Make this one a permanent local. */
5296 buffer_permanent_local_flags[idx++] = 1;
5297 #endif
5298 XSETFASTINT (buffer_local_flags.syntax_table, idx); ++idx;
5299 XSETFASTINT (buffer_local_flags.cache_long_line_scans, idx); ++idx;
5300 XSETFASTINT (buffer_local_flags.category_table, idx); ++idx;
5301 XSETFASTINT (buffer_local_flags.direction_reversed, idx); ++idx;
5302 XSETFASTINT (buffer_local_flags.buffer_file_coding_system, idx);
5303 /* Make this one a permanent local. */
5304 buffer_permanent_local_flags[idx++] = 1;
5305 XSETFASTINT (buffer_local_flags.left_margin_cols, idx); ++idx;
5306 XSETFASTINT (buffer_local_flags.right_margin_cols, idx); ++idx;
5307 XSETFASTINT (buffer_local_flags.left_fringe_width, idx); ++idx;
5308 XSETFASTINT (buffer_local_flags.right_fringe_width, idx); ++idx;
5309 XSETFASTINT (buffer_local_flags.fringes_outside_margins, idx); ++idx;
5310 XSETFASTINT (buffer_local_flags.scroll_bar_width, idx); ++idx;
5311 XSETFASTINT (buffer_local_flags.vertical_scroll_bar_type, idx); ++idx;
5312 XSETFASTINT (buffer_local_flags.indicate_empty_lines, idx); ++idx;
5313 XSETFASTINT (buffer_local_flags.indicate_buffer_boundaries, idx); ++idx;
5314 XSETFASTINT (buffer_local_flags.fringe_indicator_alist, idx); ++idx;
5315 XSETFASTINT (buffer_local_flags.fringe_cursor_alist, idx); ++idx;
5316 XSETFASTINT (buffer_local_flags.scroll_up_aggressively, idx); ++idx;
5317 XSETFASTINT (buffer_local_flags.scroll_down_aggressively, idx); ++idx;
5318 XSETFASTINT (buffer_local_flags.header_line_format, idx); ++idx;
5319 XSETFASTINT (buffer_local_flags.cursor_type, idx); ++idx;
5320 XSETFASTINT (buffer_local_flags.extra_line_spacing, idx); ++idx;
5321 XSETFASTINT (buffer_local_flags.cursor_in_non_selected_windows, idx); ++idx;
5323 /* Need more room? */
5324 if (idx >= MAX_PER_BUFFER_VARS)
5325 abort ();
5326 last_per_buffer_idx = idx;
5328 Vbuffer_alist = Qnil;
5329 current_buffer = 0;
5330 all_buffers = 0;
5332 QSFundamental = make_pure_c_string ("Fundamental");
5334 Qfundamental_mode = intern_c_string ("fundamental-mode");
5335 buffer_defaults.major_mode = Qfundamental_mode;
5337 Qmode_class = intern_c_string ("mode-class");
5339 Qprotected_field = intern_c_string ("protected-field");
5341 Qpermanent_local = intern_c_string ("permanent-local");
5343 Qkill_buffer_hook = intern_c_string ("kill-buffer-hook");
5344 Fput (Qkill_buffer_hook, Qpermanent_local, Qt);
5346 Qucs_set_table_for_input = intern_c_string ("ucs-set-table-for-input");
5348 /* super-magic invisible buffer */
5349 Vprin1_to_string_buffer = Fget_buffer_create (make_pure_c_string (" prin1"));
5350 Vbuffer_alist = Qnil;
5352 Fset_buffer (Fget_buffer_create (make_pure_c_string ("*scratch*")));
5354 inhibit_modification_hooks = 0;
5357 void
5358 init_buffer ()
5360 char *pwd;
5361 Lisp_Object temp;
5362 int len;
5364 #ifdef USE_MMAP_FOR_BUFFERS
5366 /* When using the ralloc implementation based on mmap(2), buffer
5367 text pointers will have been set to null in the dumped Emacs.
5368 Map new memory. */
5369 struct buffer *b;
5371 for (b = all_buffers; b; b = b->next)
5372 if (b->text->beg == NULL)
5373 enlarge_buffer_text (b, 0);
5375 #endif /* USE_MMAP_FOR_BUFFERS */
5377 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
5378 if (NILP (buffer_defaults.enable_multibyte_characters))
5379 Fset_buffer_multibyte (Qnil);
5381 pwd = get_current_dir_name ();
5383 if (!pwd)
5384 fatal ("`get_current_dir_name' failed: %s\n", strerror (errno));
5386 /* Maybe this should really use some standard subroutine
5387 whose definition is filename syntax dependent. */
5388 len = strlen (pwd);
5389 if (!(IS_DIRECTORY_SEP (pwd[len - 1])))
5391 /* Grow buffer to add directory separator and '\0'. */
5392 pwd = (char *) realloc (pwd, len + 2);
5393 if (!pwd)
5394 fatal ("`get_current_dir_name' failed: %s\n", strerror (errno));
5395 pwd[len] = DIRECTORY_SEP;
5396 pwd[len + 1] = '\0';
5399 current_buffer->directory = make_unibyte_string (pwd, strlen (pwd));
5400 if (! NILP (buffer_defaults.enable_multibyte_characters))
5401 /* At this moment, we still don't know how to decode the
5402 directory name. So, we keep the bytes in multibyte form so
5403 that ENCODE_FILE correctly gets the original bytes. */
5404 current_buffer->directory
5405 = string_to_multibyte (current_buffer->directory);
5407 /* Add /: to the front of the name
5408 if it would otherwise be treated as magic. */
5409 temp = Ffind_file_name_handler (current_buffer->directory, Qt);
5410 if (! NILP (temp)
5411 /* If the default dir is just /, TEMP is non-nil
5412 because of the ange-ftp completion handler.
5413 However, it is not necessary to turn / into /:/.
5414 So avoid doing that. */
5415 && strcmp ("/", SDATA (current_buffer->directory)))
5416 current_buffer->directory
5417 = concat2 (build_string ("/:"), current_buffer->directory);
5419 temp = get_minibuffer (0);
5420 XBUFFER (temp)->directory = current_buffer->directory;
5422 free (pwd);
5425 /* Similar to defvar_lisp but define a variable whose value is the Lisp
5426 Object stored in the current buffer. address is the address of the slot
5427 in the buffer that is current now. */
5429 /* TYPE is nil for a general Lisp variable.
5430 An integer specifies a type; then only LIsp values
5431 with that type code are allowed (except that nil is allowed too).
5432 LNAME is the LIsp-level variable name.
5433 VNAME is the name of the buffer slot.
5434 DOC is a dummy where you write the doc string as a comment. */
5435 #define DEFVAR_PER_BUFFER(lname, vname, type, doc) \
5436 defvar_per_buffer (lname, vname, type, 0)
5438 static void
5439 defvar_per_buffer (namestring, address, type, doc)
5440 char *namestring;
5441 Lisp_Object *address;
5442 Lisp_Object type;
5443 char *doc;
5445 Lisp_Object sym, val;
5446 int offset;
5448 sym = intern (namestring);
5449 val = allocate_misc ();
5450 offset = (char *)address - (char *)current_buffer;
5452 XMISCTYPE (val) = Lisp_Misc_Buffer_Objfwd;
5453 XBUFFER_OBJFWD (val)->offset = offset;
5454 XBUFFER_OBJFWD (val)->slottype = type;
5455 SET_SYMBOL_VALUE (sym, val);
5456 PER_BUFFER_SYMBOL (offset) = sym;
5458 if (PER_BUFFER_IDX (offset) == 0)
5459 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
5460 slot of buffer_local_flags */
5461 abort ();
5465 /* initialize the buffer routines */
5466 void
5467 syms_of_buffer ()
5469 staticpro (&last_overlay_modification_hooks);
5470 last_overlay_modification_hooks
5471 = Fmake_vector (make_number (10), Qnil);
5473 staticpro (&Vbuffer_defaults);
5474 staticpro (&Vbuffer_local_symbols);
5475 staticpro (&Qfundamental_mode);
5476 staticpro (&Qmode_class);
5477 staticpro (&QSFundamental);
5478 staticpro (&Vbuffer_alist);
5479 staticpro (&Qprotected_field);
5480 staticpro (&Qpermanent_local);
5481 Qpermanent_local_hook = intern_c_string ("permanent-local-hook");
5482 staticpro (&Qpermanent_local_hook);
5483 staticpro (&Qkill_buffer_hook);
5484 Qoverlayp = intern_c_string ("overlayp");
5485 staticpro (&Qoverlayp);
5486 Qevaporate = intern_c_string ("evaporate");
5487 staticpro (&Qevaporate);
5488 Qmodification_hooks = intern_c_string ("modification-hooks");
5489 staticpro (&Qmodification_hooks);
5490 Qinsert_in_front_hooks = intern_c_string ("insert-in-front-hooks");
5491 staticpro (&Qinsert_in_front_hooks);
5492 Qinsert_behind_hooks = intern_c_string ("insert-behind-hooks");
5493 staticpro (&Qinsert_behind_hooks);
5494 Qget_file_buffer = intern_c_string ("get-file-buffer");
5495 staticpro (&Qget_file_buffer);
5496 Qpriority = intern_c_string ("priority");
5497 staticpro (&Qpriority);
5498 Qwindow = intern_c_string ("window");
5499 staticpro (&Qwindow);
5500 Qbefore_string = intern_c_string ("before-string");
5501 staticpro (&Qbefore_string);
5502 Qafter_string = intern_c_string ("after-string");
5503 staticpro (&Qafter_string);
5504 Qfirst_change_hook = intern_c_string ("first-change-hook");
5505 staticpro (&Qfirst_change_hook);
5506 Qbefore_change_functions = intern_c_string ("before-change-functions");
5507 staticpro (&Qbefore_change_functions);
5508 Qafter_change_functions = intern_c_string ("after-change-functions");
5509 staticpro (&Qafter_change_functions);
5510 /* The next one is initialized in init_buffer_once. */
5511 staticpro (&Qucs_set_table_for_input);
5513 Qkill_buffer_query_functions = intern_c_string ("kill-buffer-query-functions");
5514 staticpro (&Qkill_buffer_query_functions);
5516 Fput (Qprotected_field, Qerror_conditions,
5517 pure_cons (Qprotected_field, pure_cons (Qerror, Qnil)));
5518 Fput (Qprotected_field, Qerror_message,
5519 make_pure_c_string ("Attempt to modify a protected field"));
5521 /* All these use DEFVAR_LISP_NOPRO because the slots in
5522 buffer_defaults will all be marked via Vbuffer_defaults. */
5524 DEFVAR_LISP_NOPRO ("default-mode-line-format",
5525 &buffer_defaults.mode_line_format,
5526 doc: /* Default value of `mode-line-format' for buffers that don't override it.
5527 This is the same as (default-value 'mode-line-format). */);
5529 DEFVAR_LISP_NOPRO ("default-header-line-format",
5530 &buffer_defaults.header_line_format,
5531 doc: /* Default value of `header-line-format' for buffers that don't override it.
5532 This is the same as (default-value 'header-line-format). */);
5534 DEFVAR_LISP_NOPRO ("default-cursor-type", &buffer_defaults.cursor_type,
5535 doc: /* Default value of `cursor-type' for buffers that don't override it.
5536 This is the same as (default-value 'cursor-type). */);
5538 DEFVAR_LISP_NOPRO ("default-line-spacing",
5539 &buffer_defaults.extra_line_spacing,
5540 doc: /* Default value of `line-spacing' for buffers that don't override it.
5541 This is the same as (default-value 'line-spacing). */);
5543 DEFVAR_LISP_NOPRO ("default-cursor-in-non-selected-windows",
5544 &buffer_defaults.cursor_in_non_selected_windows,
5545 doc: /* Default value of `cursor-in-non-selected-windows'.
5546 This is the same as (default-value 'cursor-in-non-selected-windows). */);
5548 DEFVAR_LISP_NOPRO ("default-abbrev-mode",
5549 &buffer_defaults.abbrev_mode,
5550 doc: /* Default value of `abbrev-mode' for buffers that do not override it.
5551 This is the same as (default-value 'abbrev-mode). */);
5553 DEFVAR_LISP_NOPRO ("default-ctl-arrow",
5554 &buffer_defaults.ctl_arrow,
5555 doc: /* Default value of `ctl-arrow' for buffers that do not override it.
5556 This is the same as (default-value 'ctl-arrow). */);
5558 DEFVAR_LISP_NOPRO ("default-direction-reversed",
5559 &buffer_defaults.direction_reversed,
5560 doc: /* Default value of `direction-reversed' for buffers that do not override it.
5561 This is the same as (default-value 'direction-reversed). */);
5563 DEFVAR_LISP_NOPRO ("default-enable-multibyte-characters",
5564 &buffer_defaults.enable_multibyte_characters,
5565 doc: /* *Default value of `enable-multibyte-characters' for buffers not overriding it.
5566 This is the same as (default-value 'enable-multibyte-characters). */);
5568 DEFVAR_LISP_NOPRO ("default-buffer-file-coding-system",
5569 &buffer_defaults.buffer_file_coding_system,
5570 doc: /* Default value of `buffer-file-coding-system' for buffers not overriding it.
5571 This is the same as (default-value 'buffer-file-coding-system). */);
5573 DEFVAR_LISP_NOPRO ("default-truncate-lines",
5574 &buffer_defaults.truncate_lines,
5575 doc: /* Default value of `truncate-lines' for buffers that do not override it.
5576 This is the same as (default-value 'truncate-lines). */);
5578 DEFVAR_LISP_NOPRO ("default-fill-column",
5579 &buffer_defaults.fill_column,
5580 doc: /* Default value of `fill-column' for buffers that do not override it.
5581 This is the same as (default-value 'fill-column). */);
5583 DEFVAR_LISP_NOPRO ("default-left-margin",
5584 &buffer_defaults.left_margin,
5585 doc: /* Default value of `left-margin' for buffers that do not override it.
5586 This is the same as (default-value 'left-margin). */);
5588 DEFVAR_LISP_NOPRO ("default-tab-width",
5589 &buffer_defaults.tab_width,
5590 doc: /* Default value of `tab-width' for buffers that do not override it.
5591 This is the same as (default-value 'tab-width). */);
5593 DEFVAR_LISP_NOPRO ("default-case-fold-search",
5594 &buffer_defaults.case_fold_search,
5595 doc: /* Default value of `case-fold-search' for buffers that don't override it.
5596 This is the same as (default-value 'case-fold-search). */);
5598 #ifdef DOS_NT
5599 DEFVAR_LISP_NOPRO ("default-buffer-file-type",
5600 &buffer_defaults.buffer_file_type,
5601 doc: /* Default file type for buffers that do not override it.
5602 This is the same as (default-value 'buffer-file-type).
5603 The file type is nil for text, t for binary. */);
5604 #endif
5606 DEFVAR_LISP_NOPRO ("default-left-margin-width",
5607 &buffer_defaults.left_margin_cols,
5608 doc: /* Default value of `left-margin-width' for buffers that don't override it.
5609 This is the same as (default-value 'left-margin-width). */);
5611 DEFVAR_LISP_NOPRO ("default-right-margin-width",
5612 &buffer_defaults.right_margin_cols,
5613 doc: /* Default value of `right-margin-width' for buffers that don't override it.
5614 This is the same as (default-value 'right-margin-width). */);
5616 DEFVAR_LISP_NOPRO ("default-left-fringe-width",
5617 &buffer_defaults.left_fringe_width,
5618 doc: /* Default value of `left-fringe-width' for buffers that don't override it.
5619 This is the same as (default-value 'left-fringe-width). */);
5621 DEFVAR_LISP_NOPRO ("default-right-fringe-width",
5622 &buffer_defaults.right_fringe_width,
5623 doc: /* Default value of `right-fringe-width' for buffers that don't override it.
5624 This is the same as (default-value 'right-fringe-width). */);
5626 DEFVAR_LISP_NOPRO ("default-fringes-outside-margins",
5627 &buffer_defaults.fringes_outside_margins,
5628 doc: /* Default value of `fringes-outside-margins' for buffers that don't override it.
5629 This is the same as (default-value 'fringes-outside-margins). */);
5631 DEFVAR_LISP_NOPRO ("default-scroll-bar-width",
5632 &buffer_defaults.scroll_bar_width,
5633 doc: /* Default value of `scroll-bar-width' for buffers that don't override it.
5634 This is the same as (default-value 'scroll-bar-width). */);
5636 DEFVAR_LISP_NOPRO ("default-vertical-scroll-bar",
5637 &buffer_defaults.vertical_scroll_bar_type,
5638 doc: /* Default value of `vertical-scroll-bar' for buffers that don't override it.
5639 This is the same as (default-value 'vertical-scroll-bar). */);
5641 DEFVAR_LISP_NOPRO ("default-indicate-empty-lines",
5642 &buffer_defaults.indicate_empty_lines,
5643 doc: /* Default value of `indicate-empty-lines' for buffers that don't override it.
5644 This is the same as (default-value 'indicate-empty-lines). */);
5646 DEFVAR_LISP_NOPRO ("default-indicate-buffer-boundaries",
5647 &buffer_defaults.indicate_buffer_boundaries,
5648 doc: /* Default value of `indicate-buffer-boundaries' for buffers that don't override it.
5649 This is the same as (default-value 'indicate-buffer-boundaries). */);
5651 DEFVAR_LISP_NOPRO ("default-fringe-indicator-alist",
5652 &buffer_defaults.fringe_indicator_alist,
5653 doc: /* Default value of `fringe-indicator-alist' for buffers that don't override it.
5654 This is the same as (default-value 'fringe-indicator-alist'). */);
5656 DEFVAR_LISP_NOPRO ("default-fringe-cursor-alist",
5657 &buffer_defaults.fringe_cursor_alist,
5658 doc: /* Default value of `fringe-cursor-alist' for buffers that don't override it.
5659 This is the same as (default-value 'fringe-cursor-alist'). */);
5661 DEFVAR_LISP_NOPRO ("default-scroll-up-aggressively",
5662 &buffer_defaults.scroll_up_aggressively,
5663 doc: /* Default value of `scroll-up-aggressively'.
5664 This value applies in buffers that don't have their own local values.
5665 This is the same as (default-value 'scroll-up-aggressively). */);
5667 DEFVAR_LISP_NOPRO ("default-scroll-down-aggressively",
5668 &buffer_defaults.scroll_down_aggressively,
5669 doc: /* Default value of `scroll-down-aggressively'.
5670 This value applies in buffers that don't have their own local values.
5671 This is the same as (default-value 'scroll-down-aggressively). */);
5673 DEFVAR_PER_BUFFER ("header-line-format",
5674 &current_buffer->header_line_format,
5675 Qnil,
5676 doc: /* Analogous to `mode-line-format', but controls the header line.
5677 The header line appears, optionally, at the top of a window;
5678 the mode line appears at the bottom. */);
5680 DEFVAR_PER_BUFFER ("mode-line-format", &current_buffer->mode_line_format,
5681 Qnil,
5682 doc: /* Template for displaying mode line for current buffer.
5683 Each buffer has its own value of this variable.
5684 Value may be nil, a string, a symbol or a list or cons cell.
5685 A value of nil means don't display a mode line.
5686 For a symbol, its value is used (but it is ignored if t or nil).
5687 A string appearing directly as the value of a symbol is processed verbatim
5688 in that the %-constructs below are not recognized.
5689 Note that unless the symbol is marked as a `risky-local-variable', all
5690 properties in any strings, as well as all :eval and :propertize forms
5691 in the value of that symbol will be ignored.
5692 For a list of the form `(:eval FORM)', FORM is evaluated and the result
5693 is used as a mode line element. Be careful--FORM should not load any files,
5694 because that can cause an infinite recursion.
5695 For a list of the form `(:propertize ELT PROPS...)', ELT is displayed
5696 with the specified properties PROPS applied.
5697 For a list whose car is a symbol, the symbol's value is taken,
5698 and if that is non-nil, the cadr of the list is processed recursively.
5699 Otherwise, the caddr of the list (if there is one) is processed.
5700 For a list whose car is a string or list, each element is processed
5701 recursively and the results are effectively concatenated.
5702 For a list whose car is an integer, the cdr of the list is processed
5703 and padded (if the number is positive) or truncated (if negative)
5704 to the width specified by that number.
5705 A string is printed verbatim in the mode line except for %-constructs:
5706 (%-constructs are allowed when the string is the entire mode-line-format
5707 or when it is found in a cons-cell or a list)
5708 %b -- print buffer name. %f -- print visited file name.
5709 %F -- print frame name.
5710 %* -- print %, * or hyphen. %+ -- print *, % or hyphen.
5711 %& is like %*, but ignore read-only-ness.
5712 % means buffer is read-only and * means it is modified.
5713 For a modified read-only buffer, %* gives % and %+ gives *.
5714 %s -- print process status. %l -- print the current line number.
5715 %c -- print the current column number (this makes editing slower).
5716 To make the column number update correctly in all cases,
5717 `column-number-mode' must be non-nil.
5718 %i -- print the size of the buffer.
5719 %I -- like %i, but use k, M, G, etc., to abbreviate.
5720 %p -- print percent of buffer above top of window, or Top, Bot or All.
5721 %P -- print percent of buffer above bottom of window, perhaps plus Top,
5722 or print Bottom or All.
5723 %n -- print Narrow if appropriate.
5724 %t -- visited file is text or binary (if OS supports this distinction).
5725 %z -- print mnemonics of keyboard, terminal, and buffer coding systems.
5726 %Z -- like %z, but including the end-of-line format.
5727 %e -- print error message about full memory.
5728 %@ -- print @ or hyphen. @ means that default-directory is on a
5729 remote machine.
5730 %[ -- print one [ for each recursive editing level. %] similar.
5731 %% -- print %. %- -- print infinitely many dashes.
5732 Decimal digits after the % specify field width to which to pad. */);
5734 DEFVAR_LISP_NOPRO ("default-major-mode", &buffer_defaults.major_mode,
5735 doc: /* *Value of `major-mode' for new buffers. */);
5737 DEFVAR_PER_BUFFER ("major-mode", &current_buffer->major_mode,
5738 make_number (Lisp_Symbol),
5739 doc: /* Symbol for current buffer's major mode.
5740 The default value (normally `fundamental-mode') affects new buffers.
5741 A value of nil means to use the current buffer's major mode, provided
5742 it is not marked as "special".
5744 When a mode is used by default, `find-file' switches to it before it
5745 reads the contents into the buffer and before it finishes setting up
5746 the buffer. Thus, the mode and its hooks should not expect certain
5747 variables such as `buffer-read-only' and `buffer-file-coding-system'
5748 to be set up. */);
5750 DEFVAR_PER_BUFFER ("mode-name", &current_buffer->mode_name,
5751 Qnil,
5752 doc: /* Pretty name of current buffer's major mode.
5753 Usually a string, but can use any of the constructs for `mode-line-format',
5754 which see.
5755 Format with `format-mode-line' to produce a string value. */);
5757 DEFVAR_PER_BUFFER ("local-abbrev-table", &current_buffer->abbrev_table, Qnil,
5758 doc: /* Local (mode-specific) abbrev table of current buffer. */);
5760 DEFVAR_PER_BUFFER ("abbrev-mode", &current_buffer->abbrev_mode, Qnil,
5761 doc: /* Non-nil turns on automatic expansion of abbrevs as they are inserted. */);
5763 DEFVAR_PER_BUFFER ("case-fold-search", &current_buffer->case_fold_search,
5764 Qnil,
5765 doc: /* *Non-nil if searches and matches should ignore case. */);
5767 DEFVAR_PER_BUFFER ("fill-column", &current_buffer->fill_column,
5768 make_number (LISP_INT_TAG),
5769 doc: /* *Column beyond which automatic line-wrapping should happen.
5770 Interactively, you can set the buffer local value using \\[set-fill-column]. */);
5772 DEFVAR_PER_BUFFER ("left-margin", &current_buffer->left_margin,
5773 make_number (LISP_INT_TAG),
5774 doc: /* *Column for the default `indent-line-function' to indent to.
5775 Linefeed indents to this column in Fundamental mode. */);
5777 DEFVAR_PER_BUFFER ("tab-width", &current_buffer->tab_width,
5778 make_number (LISP_INT_TAG),
5779 doc: /* *Distance between tab stops (for display of tab characters), in columns. */);
5781 DEFVAR_PER_BUFFER ("ctl-arrow", &current_buffer->ctl_arrow, Qnil,
5782 doc: /* *Non-nil means display control chars with uparrow.
5783 A value of nil means use backslash and octal digits.
5784 This variable does not apply to characters whose display is specified
5785 in the current display table (if there is one). */);
5787 DEFVAR_PER_BUFFER ("enable-multibyte-characters",
5788 &current_buffer->enable_multibyte_characters,
5789 Qnil,
5790 doc: /* Non-nil means the buffer contents are regarded as multi-byte characters.
5791 Otherwise they are regarded as unibyte. This affects the display,
5792 file I/O and the behavior of various editing commands.
5794 This variable is buffer-local but you cannot set it directly;
5795 use the function `set-buffer-multibyte' to change a buffer's representation.
5796 Changing its default value with `setq-default' is supported.
5797 See also variable `default-enable-multibyte-characters' and Info node
5798 `(elisp)Text Representations'. */);
5799 XSYMBOL (intern_c_string ("enable-multibyte-characters"))->constant = 1;
5801 DEFVAR_PER_BUFFER ("buffer-file-coding-system",
5802 &current_buffer->buffer_file_coding_system, Qnil,
5803 doc: /* Coding system to be used for encoding the buffer contents on saving.
5804 This variable applies to saving the buffer, and also to `write-region'
5805 and other functions that use `write-region'.
5806 It does not apply to sending output to subprocesses, however.
5808 If this is nil, the buffer is saved without any code conversion
5809 unless some coding system is specified in `file-coding-system-alist'
5810 for the buffer file.
5812 If the text to be saved cannot be encoded as specified by this variable,
5813 an alternative encoding is selected by `select-safe-coding-system', which see.
5815 The variable `coding-system-for-write', if non-nil, overrides this variable.
5817 This variable is never applied to a way of decoding a file while reading it. */);
5819 DEFVAR_PER_BUFFER ("direction-reversed", &current_buffer->direction_reversed,
5820 Qnil,
5821 doc: /* *Non-nil means lines in the buffer are displayed right to left. */);
5823 DEFVAR_PER_BUFFER ("truncate-lines", &current_buffer->truncate_lines, Qnil,
5824 doc: /* *Non-nil means do not display continuation lines.
5825 Instead, give each line of text just one screen line.
5827 Note that this is overridden by the variable
5828 `truncate-partial-width-windows' if that variable is non-nil
5829 and this buffer is not full-frame width. */);
5831 DEFVAR_PER_BUFFER ("word-wrap", &current_buffer->word_wrap, Qnil,
5832 doc: /* *Non-nil means to use word-wrapping for continuation lines.
5833 When word-wrapping is on, continuation lines are wrapped at the space
5834 or tab character nearest to the right window edge.
5835 If nil, continuation lines are wrapped at the right screen edge.
5837 This variable has no effect if long lines are truncated (see
5838 `truncate-lines' and `truncate-partial-width-windows'). If you use
5839 word-wrapping, you might want to reduce the value of
5840 `truncate-partial-width-windows', since wrapping can make text readable
5841 in narrower windows. */);
5843 #ifdef DOS_NT
5844 DEFVAR_PER_BUFFER ("buffer-file-type", &current_buffer->buffer_file_type,
5845 Qnil,
5846 doc: /* Non-nil if the visited file is a binary file.
5847 This variable is meaningful on MS-DOG and Windows NT.
5848 On those systems, it is automatically local in every buffer.
5849 On other systems, this variable is normally always nil. */);
5850 #endif
5852 DEFVAR_PER_BUFFER ("default-directory", &current_buffer->directory,
5853 make_number (Lisp_String),
5854 doc: /* Name of default directory of current buffer. Should end with slash.
5855 To interactively change the default directory, use command `cd'. */);
5857 DEFVAR_PER_BUFFER ("auto-fill-function", &current_buffer->auto_fill_function,
5858 Qnil,
5859 doc: /* Function called (if non-nil) to perform auto-fill.
5860 It is called after self-inserting any character specified in
5861 the `auto-fill-chars' table.
5862 NOTE: This variable is not a hook;
5863 its value may not be a list of functions. */);
5865 DEFVAR_PER_BUFFER ("buffer-file-name", &current_buffer->filename,
5866 make_number (Lisp_String),
5867 doc: /* Name of file visited in current buffer, or nil if not visiting a file. */);
5869 DEFVAR_PER_BUFFER ("buffer-file-truename", &current_buffer->file_truename,
5870 make_number (Lisp_String),
5871 doc: /* Abbreviated truename of file visited in current buffer, or nil if none.
5872 The truename of a file is calculated by `file-truename'
5873 and then abbreviated with `abbreviate-file-name'. */);
5875 DEFVAR_PER_BUFFER ("buffer-auto-save-file-name",
5876 &current_buffer->auto_save_file_name,
5877 make_number (Lisp_String),
5878 doc: /* Name of file for auto-saving current buffer.
5879 If it is nil, that means don't auto-save this buffer. */);
5881 DEFVAR_PER_BUFFER ("buffer-read-only", &current_buffer->read_only, Qnil,
5882 doc: /* Non-nil if this buffer is read-only. */);
5884 DEFVAR_PER_BUFFER ("buffer-backed-up", &current_buffer->backed_up, Qnil,
5885 doc: /* Non-nil if this buffer's file has been backed up.
5886 Backing up is done before the first time the file is saved. */);
5888 DEFVAR_PER_BUFFER ("buffer-saved-size", &current_buffer->save_length,
5889 make_number (LISP_INT_TAG),
5890 doc: /* Length of current buffer when last read in, saved or auto-saved.
5891 0 initially.
5892 -1 means auto-saving turned off until next real save.
5894 If you set this to -2, that means don't turn off auto-saving in this buffer
5895 if its text size shrinks. If you use `buffer-swap-text' on a buffer,
5896 you probably should set this to -2 in that buffer. */);
5898 DEFVAR_PER_BUFFER ("selective-display", &current_buffer->selective_display,
5899 Qnil,
5900 doc: /* Non-nil enables selective display.
5901 An integer N as value means display only lines
5902 that start with less than N columns of space.
5903 A value of t means that the character ^M makes itself and
5904 all the rest of the line invisible; also, when saving the buffer
5905 in a file, save the ^M as a newline. */);
5907 #ifndef old
5908 DEFVAR_PER_BUFFER ("selective-display-ellipses",
5909 &current_buffer->selective_display_ellipses,
5910 Qnil,
5911 doc: /* Non-nil means display ... on previous line when a line is invisible. */);
5912 #endif
5914 DEFVAR_PER_BUFFER ("overwrite-mode", &current_buffer->overwrite_mode, Qnil,
5915 doc: /* Non-nil if self-insertion should replace existing text.
5916 The value should be one of `overwrite-mode-textual',
5917 `overwrite-mode-binary', or nil.
5918 If it is `overwrite-mode-textual', self-insertion still
5919 inserts at the end of a line, and inserts when point is before a tab,
5920 until the tab is filled in.
5921 If `overwrite-mode-binary', self-insertion replaces newlines and tabs too. */);
5923 DEFVAR_PER_BUFFER ("buffer-display-table", &current_buffer->display_table,
5924 Qnil,
5925 doc: /* Display table that controls display of the contents of current buffer.
5927 If this variable is nil, the value of `standard-display-table' is used.
5928 Each window can have its own, overriding display table, see
5929 `set-window-display-table' and `window-display-table'.
5931 The display table is a char-table created with `make-display-table'.
5932 A char-table is an array indexed by character codes. Normal array
5933 primitives `aref' and `aset' can be used to access elements of a char-table.
5935 Each of the char-table elements control how to display the corresponding
5936 text character: the element at index C in the table says how to display
5937 the character whose code is C. Each element should be a vector of
5938 characters or nil. The value nil means display the character in the
5939 default fashion; otherwise, the characters from the vector are delivered
5940 to the screen instead of the original character.
5942 For example, (aset buffer-display-table ?X [?Y]) tells Emacs
5943 to display a capital Y instead of each X character.
5945 In addition, a char-table has six extra slots to control the display of:
5947 the end of a truncated screen line (extra-slot 0, a single character);
5948 the end of a continued line (extra-slot 1, a single character);
5949 the escape character used to display character codes in octal
5950 (extra-slot 2, a single character);
5951 the character used as an arrow for control characters (extra-slot 3,
5952 a single character);
5953 the decoration indicating the presence of invisible lines (extra-slot 4,
5954 a vector of characters);
5955 the character used to draw the border between side-by-side windows
5956 (extra-slot 5, a single character).
5958 See also the functions `display-table-slot' and `set-display-table-slot'. */);
5960 DEFVAR_PER_BUFFER ("left-margin-width", &current_buffer->left_margin_cols,
5961 Qnil,
5962 doc: /* *Width of left marginal area for display of a buffer.
5963 A value of nil means no marginal area. */);
5965 DEFVAR_PER_BUFFER ("right-margin-width", &current_buffer->right_margin_cols,
5966 Qnil,
5967 doc: /* *Width of right marginal area for display of a buffer.
5968 A value of nil means no marginal area. */);
5970 DEFVAR_PER_BUFFER ("left-fringe-width", &current_buffer->left_fringe_width,
5971 Qnil,
5972 doc: /* *Width of this buffer's left fringe (in pixels).
5973 A value of 0 means no left fringe is shown in this buffer's window.
5974 A value of nil means to use the left fringe width from the window's frame. */);
5976 DEFVAR_PER_BUFFER ("right-fringe-width", &current_buffer->right_fringe_width,
5977 Qnil,
5978 doc: /* *Width of this buffer's right fringe (in pixels).
5979 A value of 0 means no right fringe is shown in this buffer's window.
5980 A value of nil means to use the right fringe width from the window's frame. */);
5982 DEFVAR_PER_BUFFER ("fringes-outside-margins", &current_buffer->fringes_outside_margins,
5983 Qnil,
5984 doc: /* *Non-nil means to display fringes outside display margins.
5985 A value of nil means to display fringes between margins and buffer text. */);
5987 DEFVAR_PER_BUFFER ("scroll-bar-width", &current_buffer->scroll_bar_width,
5988 Qnil,
5989 doc: /* *Width of this buffer's scroll bars in pixels.
5990 A value of nil means to use the scroll bar width from the window's frame. */);
5992 DEFVAR_PER_BUFFER ("vertical-scroll-bar", &current_buffer->vertical_scroll_bar_type,
5993 Qnil,
5994 doc: /* *Position of this buffer's vertical scroll bar.
5995 The value takes effect whenever you tell a window to display this buffer;
5996 for instance, with `set-window-buffer' or when `display-buffer' displays it.
5998 A value of `left' or `right' means put the vertical scroll bar at that side
5999 of the window; a value of nil means don't show any vertical scroll bars.
6000 A value of t (the default) means do whatever the window's frame specifies. */);
6002 DEFVAR_PER_BUFFER ("indicate-empty-lines",
6003 &current_buffer->indicate_empty_lines, Qnil,
6004 doc: /* *Visually indicate empty lines after the buffer end.
6005 If non-nil, a bitmap is displayed in the left fringe of a window on
6006 window-systems. */);
6008 DEFVAR_PER_BUFFER ("indicate-buffer-boundaries",
6009 &current_buffer->indicate_buffer_boundaries, Qnil,
6010 doc: /* *Visually indicate buffer boundaries and scrolling.
6011 If non-nil, the first and last line of the buffer are marked in the fringe
6012 of a window on window-systems with angle bitmaps, or if the window can be
6013 scrolled, the top and bottom line of the window are marked with up and down
6014 arrow bitmaps.
6016 If value is a symbol `left' or `right', both angle and arrow bitmaps
6017 are displayed in the left or right fringe, resp. Any other value
6018 that doesn't look like an alist means display the angle bitmaps in
6019 the left fringe but no arrows.
6021 You can exercise more precise control by using an alist as the
6022 value. Each alist element (INDICATOR . POSITION) specifies
6023 where to show one of the indicators. INDICATOR is one of `top',
6024 `bottom', `up', `down', or t, which specifies the default position,
6025 and POSITION is one of `left', `right', or nil, meaning do not show
6026 this indicator.
6028 For example, ((top . left) (t . right)) places the top angle bitmap in
6029 left fringe, the bottom angle bitmap in right fringe, and both arrow
6030 bitmaps in right fringe. To show just the angle bitmaps in the left
6031 fringe, but no arrow bitmaps, use ((top . left) (bottom . left)). */);
6033 DEFVAR_PER_BUFFER ("fringe-indicator-alist",
6034 &current_buffer->fringe_indicator_alist, Qnil,
6035 doc: /* *Mapping from logical to physical fringe indicator bitmaps.
6036 The value is an alist where each element (INDICATOR . BITMAPS)
6037 specifies the fringe bitmaps used to display a specific logical
6038 fringe indicator.
6040 INDICATOR specifies the logical indicator type which is one of the
6041 following symbols: `truncation' , `continuation', `overlay-arrow',
6042 `top', `bottom', `up', `down', `one-line', `empty-line', or `unknown'.
6044 BITMAPS is list of symbols (LEFT RIGHT [LEFT1 RIGHT1]) which specifies
6045 the actual bitmap shown in the left or right fringe for the logical
6046 indicator. LEFT and RIGHT are the bitmaps shown in the left and/or
6047 right fringe for the specific indicator. The LEFT1 or RIGHT1 bitmaps
6048 are used only for the `bottom' and `one-line' indicators when the last
6049 \(only) line in has no final newline. BITMAPS may also be a single
6050 symbol which is used in both left and right fringes. */);
6052 DEFVAR_PER_BUFFER ("fringe-cursor-alist",
6053 &current_buffer->fringe_cursor_alist, Qnil,
6054 doc: /* *Mapping from logical to physical fringe cursor bitmaps.
6055 The value is an alist where each element (CURSOR . BITMAP)
6056 specifies the fringe bitmaps used to display a specific logical
6057 cursor type in the fringe.
6059 CURSOR specifies the logical cursor type which is one of the following
6060 symbols: `box' , `hollow', `bar', `hbar', or `hollow-small'. The last
6061 one is used to show a hollow cursor on narrow lines display lines
6062 where the normal hollow cursor will not fit.
6064 BITMAP is the corresponding fringe bitmap shown for the logical
6065 cursor type. */);
6067 DEFVAR_PER_BUFFER ("scroll-up-aggressively",
6068 &current_buffer->scroll_up_aggressively, Qnil,
6069 doc: /* How far to scroll windows upward.
6070 If you move point off the bottom, the window scrolls automatically.
6071 This variable controls how far it scrolls. The value nil, the default,
6072 means scroll to center point. A fraction means scroll to put point
6073 that fraction of the window's height from the bottom of the window.
6074 When the value is 0.0, point goes at the bottom line, which in the
6075 simple case that you moved off with C-f means scrolling just one line.
6076 1.0 means point goes at the top, so that in that simple case, the
6077 window scrolls by a full window height. Meaningful values are
6078 between 0.0 and 1.0, inclusive. */);
6080 DEFVAR_PER_BUFFER ("scroll-down-aggressively",
6081 &current_buffer->scroll_down_aggressively, Qnil,
6082 doc: /* How far to scroll windows downward.
6083 If you move point off the top, the window scrolls automatically.
6084 This variable controls how far it scrolls. The value nil, the default,
6085 means scroll to center point. A fraction means scroll to put point
6086 that fraction of the window's height from the top of the window.
6087 When the value is 0.0, point goes at the top line, which in the
6088 simple case that you moved off with C-b means scrolling just one line.
6089 1.0 means point goes at the bottom, so that in that simple case, the
6090 window scrolls by a full window height. Meaningful values are
6091 between 0.0 and 1.0, inclusive. */);
6093 /*DEFVAR_LISP ("debug-check-symbol", &Vcheck_symbol,
6094 "Don't ask.");
6097 DEFVAR_LISP ("before-change-functions", &Vbefore_change_functions,
6098 doc: /* List of functions to call before each text change.
6099 Two arguments are passed to each function: the positions of
6100 the beginning and end of the range of old text to be changed.
6101 \(For an insertion, the beginning and end are at the same place.)
6102 No information is given about the length of the text after the change.
6104 Buffer changes made while executing the `before-change-functions'
6105 don't call any before-change or after-change functions.
6106 That's because these variables are temporarily set to nil.
6107 As a result, a hook function cannot straightforwardly alter the
6108 value of these variables. See the Emacs Lisp manual for a way of
6109 accomplishing an equivalent result by using other variables.
6111 If an unhandled error happens in running these functions,
6112 the variable's value remains nil. That prevents the error
6113 from happening repeatedly and making Emacs nonfunctional. */);
6114 Vbefore_change_functions = Qnil;
6116 DEFVAR_LISP ("after-change-functions", &Vafter_change_functions,
6117 doc: /* List of functions to call after each text change.
6118 Three arguments are passed to each function: the positions of
6119 the beginning and end of the range of changed text,
6120 and the length in bytes of the pre-change text replaced by that range.
6121 \(For an insertion, the pre-change length is zero;
6122 for a deletion, that length is the number of bytes deleted,
6123 and the post-change beginning and end are at the same place.)
6125 Buffer changes made while executing the `after-change-functions'
6126 don't call any before-change or after-change functions.
6127 That's because these variables are temporarily set to nil.
6128 As a result, a hook function cannot straightforwardly alter the
6129 value of these variables. See the Emacs Lisp manual for a way of
6130 accomplishing an equivalent result by using other variables.
6132 If an unhandled error happens in running these functions,
6133 the variable's value remains nil. That prevents the error
6134 from happening repeatedly and making Emacs nonfunctional. */);
6135 Vafter_change_functions = Qnil;
6137 DEFVAR_LISP ("first-change-hook", &Vfirst_change_hook,
6138 doc: /* A list of functions to call before changing a buffer which is unmodified.
6139 The functions are run using the `run-hooks' function. */);
6140 Vfirst_change_hook = Qnil;
6142 DEFVAR_PER_BUFFER ("buffer-undo-list", &current_buffer->undo_list, Qnil,
6143 doc: /* List of undo entries in current buffer.
6144 Recent changes come first; older changes follow newer.
6146 An entry (BEG . END) represents an insertion which begins at
6147 position BEG and ends at position END.
6149 An entry (TEXT . POSITION) represents the deletion of the string TEXT
6150 from (abs POSITION). If POSITION is positive, point was at the front
6151 of the text being deleted; if negative, point was at the end.
6153 An entry (t HIGH . LOW) indicates that the buffer previously had
6154 \"unmodified\" status. HIGH and LOW are the high and low 16-bit portions
6155 of the visited file's modification time, as of that time. If the
6156 modification time of the most recent save is different, this entry is
6157 obsolete.
6159 An entry (nil PROPERTY VALUE BEG . END) indicates that a text property
6160 was modified between BEG and END. PROPERTY is the property name,
6161 and VALUE is the old value.
6163 An entry (apply FUN-NAME . ARGS) means undo the change with
6164 \(apply FUN-NAME ARGS).
6166 An entry (apply DELTA BEG END FUN-NAME . ARGS) supports selective undo
6167 in the active region. BEG and END is the range affected by this entry
6168 and DELTA is the number of bytes added or deleted in that range by
6169 this change.
6171 An entry (MARKER . DISTANCE) indicates that the marker MARKER
6172 was adjusted in position by the offset DISTANCE (an integer).
6174 An entry of the form POSITION indicates that point was at the buffer
6175 location given by the integer. Undoing an entry of this form places
6176 point at POSITION.
6178 Entries with value `nil' mark undo boundaries. The undo command treats
6179 the changes between two undo boundaries as a single step to be undone.
6181 If the value of the variable is t, undo information is not recorded. */);
6183 DEFVAR_PER_BUFFER ("mark-active", &current_buffer->mark_active, Qnil,
6184 doc: /* Non-nil means the mark and region are currently active in this buffer. */);
6186 DEFVAR_PER_BUFFER ("cache-long-line-scans", &current_buffer->cache_long_line_scans, Qnil,
6187 doc: /* Non-nil means that Emacs should use caches to handle long lines more quickly.
6189 Normally, the line-motion functions work by scanning the buffer for
6190 newlines. Columnar operations (like `move-to-column' and
6191 `compute-motion') also work by scanning the buffer, summing character
6192 widths as they go. This works well for ordinary text, but if the
6193 buffer's lines are very long (say, more than 500 characters), these
6194 motion functions will take longer to execute. Emacs may also take
6195 longer to update the display.
6197 If `cache-long-line-scans' is non-nil, these motion functions cache the
6198 results of their scans, and consult the cache to avoid rescanning
6199 regions of the buffer until the text is modified. The caches are most
6200 beneficial when they prevent the most searching---that is, when the
6201 buffer contains long lines and large regions of characters with the
6202 same, fixed screen width.
6204 When `cache-long-line-scans' is non-nil, processing short lines will
6205 become slightly slower (because of the overhead of consulting the
6206 cache), and the caches will use memory roughly proportional to the
6207 number of newlines and characters whose screen width varies.
6209 The caches require no explicit maintenance; their accuracy is
6210 maintained internally by the Emacs primitives. Enabling or disabling
6211 the cache should not affect the behavior of any of the motion
6212 functions; it should only affect their performance. */);
6214 DEFVAR_PER_BUFFER ("point-before-scroll", &current_buffer->point_before_scroll, Qnil,
6215 doc: /* Value of point before the last series of scroll operations, or nil. */);
6217 DEFVAR_PER_BUFFER ("buffer-file-format", &current_buffer->file_format, Qnil,
6218 doc: /* List of formats to use when saving this buffer.
6219 Formats are defined by `format-alist'. This variable is
6220 set when a file is visited. */);
6222 DEFVAR_PER_BUFFER ("buffer-auto-save-file-format",
6223 &current_buffer->auto_save_file_format, Qnil,
6224 doc: /* *Format in which to write auto-save files.
6225 Should be a list of symbols naming formats that are defined in `format-alist'.
6226 If it is t, which is the default, auto-save files are written in the
6227 same format as a regular save would use. */);
6229 DEFVAR_PER_BUFFER ("buffer-invisibility-spec",
6230 &current_buffer->invisibility_spec, Qnil,
6231 doc: /* Invisibility spec of this buffer.
6232 The default is t, which means that text is invisible
6233 if it has a non-nil `invisible' property.
6234 If the value is a list, a text character is invisible if its `invisible'
6235 property is an element in that list (or is a list with members in common).
6236 If an element is a cons cell of the form (PROP . ELLIPSIS),
6237 then characters with property value PROP are invisible,
6238 and they have an ellipsis as well if ELLIPSIS is non-nil. */);
6240 DEFVAR_PER_BUFFER ("buffer-display-count",
6241 &current_buffer->display_count, Qnil,
6242 doc: /* A number incremented each time this buffer is displayed in a window.
6243 The function `set-window-buffer' increments it. */);
6245 DEFVAR_PER_BUFFER ("buffer-display-time",
6246 &current_buffer->display_time, Qnil,
6247 doc: /* Time stamp updated each time this buffer is displayed in a window.
6248 The function `set-window-buffer' updates this variable
6249 to the value obtained by calling `current-time'.
6250 If the buffer has never been shown in a window, the value is nil. */);
6252 DEFVAR_LISP ("transient-mark-mode", &Vtransient_mark_mode,
6253 doc: /* */);
6254 Vtransient_mark_mode = Qnil;
6255 /* The docstring is in simple.el. If we put it here, it would be
6256 overwritten when transient-mark-mode is defined using
6257 define-minor-mode. */
6259 DEFVAR_LISP ("inhibit-read-only", &Vinhibit_read_only,
6260 doc: /* *Non-nil means disregard read-only status of buffers or characters.
6261 If the value is t, disregard `buffer-read-only' and all `read-only'
6262 text properties. If the value is a list, disregard `buffer-read-only'
6263 and disregard a `read-only' text property if the property value
6264 is a member of the list. */);
6265 Vinhibit_read_only = Qnil;
6267 DEFVAR_PER_BUFFER ("cursor-type", &current_buffer->cursor_type, Qnil,
6268 doc: /* Cursor to use when this buffer is in the selected window.
6269 Values are interpreted as follows:
6271 t use the cursor specified for the frame
6272 nil don't display a cursor
6273 box display a filled box cursor
6274 hollow display a hollow box cursor
6275 bar display a vertical bar cursor with default width
6276 (bar . WIDTH) display a vertical bar cursor with width WIDTH
6277 hbar display a horizontal bar cursor with default height
6278 (hbar . HEIGHT) display a horizontal bar cursor with height HEIGHT
6279 ANYTHING ELSE display a hollow box cursor
6281 When the buffer is displayed in a non-selected window, the
6282 cursor's appearance is instead controlled by the variable
6283 `cursor-in-non-selected-windows'. */);
6285 DEFVAR_PER_BUFFER ("line-spacing",
6286 &current_buffer->extra_line_spacing, Qnil,
6287 doc: /* Additional space to put between lines when displaying a buffer.
6288 The space is measured in pixels, and put below lines on graphic displays,
6289 see `display-graphic-p'.
6290 If value is a floating point number, it specifies the spacing relative
6291 to the default frame line height. A value of nil means add no extra space. */);
6293 DEFVAR_PER_BUFFER ("cursor-in-non-selected-windows",
6294 &current_buffer->cursor_in_non_selected_windows, Qnil,
6295 doc: /* *Cursor type to display in non-selected windows.
6296 The value t means to use hollow box cursor. See `cursor-type' for other values. */);
6298 DEFVAR_LISP ("kill-buffer-query-functions", &Vkill_buffer_query_functions,
6299 doc: /* List of functions called with no args to query before killing a buffer.
6300 The buffer being killed will be current while the functions are running.
6301 If any of them returns nil, the buffer is not killed. */);
6302 Vkill_buffer_query_functions = Qnil;
6304 DEFVAR_LISP ("change-major-mode-hook", &Vchange_major_mode_hook,
6305 doc: /* Normal hook run before changing the major mode of a buffer.
6306 The function `kill-all-local-variables' runs this before doing anything else. */);
6307 Vchange_major_mode_hook = Qnil;
6308 Qchange_major_mode_hook = intern_c_string ("change-major-mode-hook");
6309 staticpro (&Qchange_major_mode_hook);
6311 defsubr (&Sbuffer_live_p);
6312 defsubr (&Sbuffer_list);
6313 defsubr (&Sget_buffer);
6314 defsubr (&Sget_file_buffer);
6315 defsubr (&Sget_buffer_create);
6316 defsubr (&Smake_indirect_buffer);
6317 defsubr (&Sgenerate_new_buffer_name);
6318 defsubr (&Sbuffer_name);
6319 /*defsubr (&Sbuffer_number);*/
6320 defsubr (&Sbuffer_file_name);
6321 defsubr (&Sbuffer_base_buffer);
6322 defsubr (&Sbuffer_local_value);
6323 defsubr (&Sbuffer_local_variables);
6324 defsubr (&Sbuffer_modified_p);
6325 defsubr (&Sset_buffer_modified_p);
6326 defsubr (&Sbuffer_modified_tick);
6327 defsubr (&Sbuffer_chars_modified_tick);
6328 defsubr (&Srename_buffer);
6329 defsubr (&Sother_buffer);
6330 defsubr (&Sbuffer_enable_undo);
6331 defsubr (&Skill_buffer);
6332 defsubr (&Sset_buffer_major_mode);
6333 defsubr (&Sswitch_to_buffer);
6334 defsubr (&Scurrent_buffer);
6335 defsubr (&Sset_buffer);
6336 defsubr (&Sbarf_if_buffer_read_only);
6337 defsubr (&Sbury_buffer);
6338 defsubr (&Serase_buffer);
6339 defsubr (&Sbuffer_swap_text);
6340 defsubr (&Sset_buffer_multibyte);
6341 defsubr (&Skill_all_local_variables);
6343 defsubr (&Soverlayp);
6344 defsubr (&Smake_overlay);
6345 defsubr (&Sdelete_overlay);
6346 defsubr (&Smove_overlay);
6347 defsubr (&Soverlay_start);
6348 defsubr (&Soverlay_end);
6349 defsubr (&Soverlay_buffer);
6350 defsubr (&Soverlay_properties);
6351 defsubr (&Soverlays_at);
6352 defsubr (&Soverlays_in);
6353 defsubr (&Snext_overlay_change);
6354 defsubr (&Sprevious_overlay_change);
6355 defsubr (&Soverlay_recenter);
6356 defsubr (&Soverlay_lists);
6357 defsubr (&Soverlay_get);
6358 defsubr (&Soverlay_put);
6359 defsubr (&Srestore_buffer_modified_p);
6362 void
6363 keys_of_buffer ()
6365 initial_define_key (control_x_map, 'b', "switch-to-buffer");
6366 initial_define_key (control_x_map, 'k', "kill-buffer");
6368 /* This must not be in syms_of_buffer, because Qdisabled is not
6369 initialized when that function gets called. */
6370 Fput (intern_c_string ("erase-buffer"), Qdisabled, Qt);
6373 /* arch-tag: e48569bf-69a9-4b65-a23b-8e68769436e1
6374 (do not change this comment) */