Merge from mainline.
[emacs.git] / src / buffer.c
blob4d590248e246495bd44902cdbf1939254b292651
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 "lisp.h"
41 #include "intervals.h"
42 #include "window.h"
43 #include "commands.h"
44 #include "buffer.h"
45 #include "character.h"
46 #include "region-cache.h"
47 #include "indent.h"
48 #include "blockinput.h"
49 #include "keyboard.h"
50 #include "keymap.h"
51 #include "frame.h"
53 struct buffer *current_buffer; /* the current buffer */
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 Vbefore_change_functions;
126 Lisp_Object Vafter_change_functions;
128 Lisp_Object 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 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 Vkill_buffer_query_functions;
138 Lisp_Object Qkill_buffer_query_functions;
140 /* Hook run before changing a major mode. */
141 Lisp_Object Vchange_major_mode_hook, Qchange_major_mode_hook;
143 /* List of functions to call before changing an unmodified buffer. */
144 Lisp_Object 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 /* Incremented for each buffer created, to assign the buffer number. */
335 int buffer_count;
337 DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 1, 0,
338 doc: /* Return the buffer specified by BUFFER-OR-NAME, creating a new one if needed.
339 If BUFFER-OR-NAME is a string and a live buffer with that name exists,
340 return that buffer. If no such buffer exists, create a new buffer with
341 that name and return it. If BUFFER-OR-NAME starts with a space, the new
342 buffer does not keep undo information.
344 If BUFFER-OR-NAME is a buffer instead of a string, return it as given,
345 even if it is dead. The return value is never nil. */)
346 (buffer_or_name)
347 register Lisp_Object buffer_or_name;
349 register Lisp_Object buffer, name;
350 register struct buffer *b;
352 buffer = Fget_buffer (buffer_or_name);
353 if (!NILP (buffer))
354 return buffer;
356 if (SCHARS (buffer_or_name) == 0)
357 error ("Empty string for buffer name is not allowed");
359 b = allocate_buffer ();
361 /* An ordinary buffer uses its own struct buffer_text. */
362 b->text = &b->own_text;
363 b->base_buffer = 0;
365 BUF_GAP_SIZE (b) = 20;
366 BLOCK_INPUT;
367 /* We allocate extra 1-byte at the tail and keep it always '\0' for
368 anchoring a search. */
369 alloc_buffer_text (b, BUF_GAP_SIZE (b) + 1);
370 UNBLOCK_INPUT;
371 if (! BUF_BEG_ADDR (b))
372 buffer_memory_full ();
374 BUF_PT (b) = BEG;
375 BUF_GPT (b) = BEG;
376 BUF_BEGV (b) = BEG;
377 BUF_ZV (b) = BEG;
378 BUF_Z (b) = BEG;
379 BUF_PT_BYTE (b) = BEG_BYTE;
380 BUF_GPT_BYTE (b) = BEG_BYTE;
381 BUF_BEGV_BYTE (b) = BEG_BYTE;
382 BUF_ZV_BYTE (b) = BEG_BYTE;
383 BUF_Z_BYTE (b) = BEG_BYTE;
384 BUF_MODIFF (b) = 1;
385 BUF_CHARS_MODIFF (b) = 1;
386 BUF_OVERLAY_MODIFF (b) = 1;
387 BUF_SAVE_MODIFF (b) = 1;
388 BUF_INTERVALS (b) = 0;
389 BUF_UNCHANGED_MODIFIED (b) = 1;
390 BUF_OVERLAY_UNCHANGED_MODIFIED (b) = 1;
391 BUF_END_UNCHANGED (b) = 0;
392 BUF_BEG_UNCHANGED (b) = 0;
393 *(BUF_GPT_ADDR (b)) = *(BUF_Z_ADDR (b)) = 0; /* Put an anchor '\0'. */
395 b->newline_cache = 0;
396 b->width_run_cache = 0;
397 b->width_table = Qnil;
398 b->prevent_redisplay_optimizations_p = 1;
400 /* Put this on the chain of all buffers including killed ones. */
401 b->next = all_buffers;
402 all_buffers = b;
404 /* An ordinary buffer normally doesn't need markers
405 to handle BEGV and ZV. */
406 b->pt_marker = Qnil;
407 b->begv_marker = Qnil;
408 b->zv_marker = Qnil;
410 name = Fcopy_sequence (buffer_or_name);
411 STRING_SET_INTERVALS (name, NULL_INTERVAL);
412 b->name = name;
414 b->undo_list = (SREF (name, 0) != ' ') ? Qnil : Qt;
416 reset_buffer (b);
417 reset_buffer_local_variables (b, 1);
419 b->mark = Fmake_marker ();
420 BUF_MARKERS (b) = NULL;
421 b->name = name;
423 /* Put this in the alist of all live buffers. */
424 XSETBUFFER (buffer, b);
425 Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buffer), Qnil));
427 /* An error in calling the function here (should someone redefine it)
428 can lead to infinite regress until you run out of stack. rms
429 says that's not worth protecting against. */
430 if (!NILP (Ffboundp (Qucs_set_table_for_input)))
431 /* buffer is on buffer-alist, so no gcpro. */
432 call1 (Qucs_set_table_for_input, buffer);
434 return buffer;
438 /* Return a list of overlays which is a copy of the overlay list
439 LIST, but for buffer B. */
441 static struct Lisp_Overlay *
442 copy_overlays (b, list)
443 struct buffer *b;
444 struct Lisp_Overlay *list;
446 Lisp_Object buffer;
447 struct Lisp_Overlay *result = NULL, *tail = NULL;
449 XSETBUFFER (buffer, b);
451 for (; list; list = list->next)
453 Lisp_Object overlay, start, end, old_overlay;
454 EMACS_INT charpos;
456 XSETMISC (old_overlay, list);
457 charpos = marker_position (OVERLAY_START (old_overlay));
458 start = Fmake_marker ();
459 Fset_marker (start, make_number (charpos), buffer);
460 XMARKER (start)->insertion_type
461 = XMARKER (OVERLAY_START (old_overlay))->insertion_type;
463 charpos = marker_position (OVERLAY_END (old_overlay));
464 end = Fmake_marker ();
465 Fset_marker (end, make_number (charpos), buffer);
466 XMARKER (end)->insertion_type
467 = XMARKER (OVERLAY_END (old_overlay))->insertion_type;
469 overlay = allocate_misc ();
470 XMISCTYPE (overlay) = Lisp_Misc_Overlay;
471 OVERLAY_START (overlay) = start;
472 OVERLAY_END (overlay) = end;
473 OVERLAY_PLIST (overlay) = Fcopy_sequence (OVERLAY_PLIST (old_overlay));
474 XOVERLAY (overlay)->next = NULL;
476 if (tail)
477 tail = tail->next = XOVERLAY (overlay);
478 else
479 result = tail = XOVERLAY (overlay);
482 return result;
486 /* Clone per-buffer values of buffer FROM.
488 Buffer TO gets the same per-buffer values as FROM, with the
489 following exceptions: (1) TO's name is left untouched, (2) markers
490 are copied and made to refer to TO, and (3) overlay lists are
491 copied. */
493 static void
494 clone_per_buffer_values (from, to)
495 struct buffer *from, *to;
497 Lisp_Object to_buffer;
498 int offset;
500 XSETBUFFER (to_buffer, to);
502 /* buffer-local Lisp variables start at `undo_list',
503 tho only the ones from `name' on are GC'd normally. */
504 for (offset = PER_BUFFER_VAR_OFFSET (undo_list);
505 offset < sizeof *to;
506 offset += sizeof (Lisp_Object))
508 Lisp_Object obj;
510 /* Don't touch the `name' which should be unique for every buffer. */
511 if (offset == PER_BUFFER_VAR_OFFSET (name))
512 continue;
514 obj = PER_BUFFER_VALUE (from, offset);
515 if (MARKERP (obj))
517 struct Lisp_Marker *m = XMARKER (obj);
518 obj = Fmake_marker ();
519 XMARKER (obj)->insertion_type = m->insertion_type;
520 set_marker_both (obj, to_buffer, m->charpos, m->bytepos);
523 PER_BUFFER_VALUE (to, offset) = obj;
526 bcopy (from->local_flags, to->local_flags, sizeof to->local_flags);
528 to->overlays_before = copy_overlays (to, from->overlays_before);
529 to->overlays_after = copy_overlays (to, from->overlays_after);
531 /* Get (a copy of) the alist of Lisp-level local variables of FROM
532 and install that in TO. */
533 to->local_var_alist = buffer_lisp_local_variables (from);
536 DEFUN ("make-indirect-buffer", Fmake_indirect_buffer, Smake_indirect_buffer,
537 2, 3,
538 "bMake indirect buffer (to buffer): \nBName of indirect buffer: ",
539 doc: /* Create and return an indirect buffer for buffer BASE-BUFFER, named NAME.
540 BASE-BUFFER should be a live buffer, or the name of an existing buffer.
541 NAME should be a string which is not the name of an existing buffer.
542 Optional argument CLONE non-nil means preserve BASE-BUFFER's state,
543 such as major and minor modes, in the indirect buffer.
544 CLONE nil means the indirect buffer's state is reset to default values. */)
545 (base_buffer, name, clone)
546 Lisp_Object base_buffer, name, clone;
548 Lisp_Object buf, tem;
549 struct buffer *b;
551 CHECK_STRING (name);
552 buf = Fget_buffer (name);
553 if (!NILP (buf))
554 error ("Buffer name `%s' is in use", SDATA (name));
556 tem = base_buffer;
557 base_buffer = Fget_buffer (base_buffer);
558 if (NILP (base_buffer))
559 error ("No such buffer: `%s'", SDATA (tem));
560 if (NILP (XBUFFER (base_buffer)->name))
561 error ("Base buffer has been killed");
563 if (SCHARS (name) == 0)
564 error ("Empty string for buffer name is not allowed");
566 b = allocate_buffer ();
568 b->base_buffer = (XBUFFER (base_buffer)->base_buffer
569 ? XBUFFER (base_buffer)->base_buffer
570 : XBUFFER (base_buffer));
572 /* Use the base buffer's text object. */
573 b->text = b->base_buffer->text;
575 BUF_BEGV (b) = BUF_BEGV (b->base_buffer);
576 BUF_ZV (b) = BUF_ZV (b->base_buffer);
577 BUF_PT (b) = BUF_PT (b->base_buffer);
578 BUF_BEGV_BYTE (b) = BUF_BEGV_BYTE (b->base_buffer);
579 BUF_ZV_BYTE (b) = BUF_ZV_BYTE (b->base_buffer);
580 BUF_PT_BYTE (b) = BUF_PT_BYTE (b->base_buffer);
582 b->newline_cache = 0;
583 b->width_run_cache = 0;
584 b->width_table = Qnil;
586 /* Put this on the chain of all buffers including killed ones. */
587 b->next = all_buffers;
588 all_buffers = b;
590 name = Fcopy_sequence (name);
591 STRING_SET_INTERVALS (name, NULL_INTERVAL);
592 b->name = name;
594 reset_buffer (b);
595 reset_buffer_local_variables (b, 1);
597 /* Put this in the alist of all live buffers. */
598 XSETBUFFER (buf, b);
599 Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));
601 b->mark = Fmake_marker ();
602 b->name = name;
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 /* Query if the buffer is still modified. */
1448 if (INTERACTIVE && !NILP (b->filename)
1449 && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b))
1451 GCPRO1 (buffer);
1452 tem = do_yes_or_no_p (format2 ("Buffer %s modified; kill anyway? ",
1453 b->name, make_number (0)));
1454 UNGCPRO;
1455 if (NILP (tem))
1456 return Qnil;
1459 /* Run hooks with the buffer to be killed the current buffer. */
1461 int count = SPECPDL_INDEX ();
1462 Lisp_Object arglist[1];
1464 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1465 set_buffer_internal (b);
1467 /* First run the query functions; if any query is answered no,
1468 don't kill the buffer. */
1469 arglist[0] = Qkill_buffer_query_functions;
1470 tem = Frun_hook_with_args_until_failure (1, arglist);
1471 if (NILP (tem))
1472 return unbind_to (count, Qnil);
1474 /* Then run the hooks. */
1475 Frun_hooks (1, &Qkill_buffer_hook);
1476 unbind_to (count, Qnil);
1479 /* We have no more questions to ask. Verify that it is valid
1480 to kill the buffer. This must be done after the questions
1481 since anything can happen within do_yes_or_no_p. */
1483 /* Don't kill the minibuffer now current. */
1484 if (EQ (buffer, XWINDOW (minibuf_window)->buffer))
1485 return Qnil;
1487 if (NILP (b->name))
1488 return Qnil;
1490 /* When we kill a base buffer, kill all its indirect buffers.
1491 We do it at this stage so nothing terrible happens if they
1492 ask questions or their hooks get errors. */
1493 if (! b->base_buffer)
1495 struct buffer *other;
1497 GCPRO1 (buffer);
1499 for (other = all_buffers; other; other = other->next)
1500 /* all_buffers contains dead buffers too;
1501 don't re-kill them. */
1502 if (other->base_buffer == b && !NILP (other->name))
1504 Lisp_Object buffer;
1505 XSETBUFFER (buffer, other);
1506 Fkill_buffer (buffer);
1509 UNGCPRO;
1512 /* Make this buffer not be current.
1513 In the process, notice if this is the sole visible buffer
1514 and give up if so. */
1515 if (b == current_buffer)
1517 tem = Fother_buffer (buffer, Qnil, Qnil);
1518 Fset_buffer (tem);
1519 if (b == current_buffer)
1520 return Qnil;
1523 /* Notice if the buffer to kill is the sole visible buffer
1524 when we're currently in the mini-buffer, and give up if so. */
1525 XSETBUFFER (tem, current_buffer);
1526 if (EQ (tem, XWINDOW (minibuf_window)->buffer))
1528 tem = Fother_buffer (buffer, Qnil, Qnil);
1529 if (EQ (buffer, tem))
1530 return Qnil;
1533 /* Now there is no question: we can kill the buffer. */
1535 #ifdef CLASH_DETECTION
1536 /* Unlock this buffer's file, if it is locked. */
1537 unlock_buffer (b);
1538 #endif /* CLASH_DETECTION */
1540 GCPRO1 (buffer);
1541 kill_buffer_processes (buffer);
1542 UNGCPRO;
1544 /* Killing buffer processes may run sentinels which may
1545 have called kill-buffer. */
1547 if (NILP (b->name))
1548 return Qnil;
1550 clear_charpos_cache (b);
1552 tem = Vinhibit_quit;
1553 Vinhibit_quit = Qt;
1554 replace_buffer_in_all_windows (buffer);
1555 Vbuffer_alist = Fdelq (Frassq (buffer, Vbuffer_alist), Vbuffer_alist);
1556 frames_discard_buffer (buffer);
1557 Vinhibit_quit = tem;
1559 /* Delete any auto-save file, if we saved it in this session.
1560 But not if the buffer is modified. */
1561 if (STRINGP (b->auto_save_file_name)
1562 && BUF_AUTOSAVE_MODIFF (b) != 0
1563 && BUF_SAVE_MODIFF (b) < BUF_AUTOSAVE_MODIFF (b)
1564 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
1565 && NILP (Fsymbol_value (intern ("auto-save-visited-file-name"))))
1567 Lisp_Object tem;
1568 tem = Fsymbol_value (intern ("delete-auto-save-files"));
1569 if (! NILP (tem))
1570 internal_delete_file (b->auto_save_file_name);
1573 if (b->base_buffer)
1575 /* Unchain all markers that belong to this indirect buffer.
1576 Don't unchain the markers that belong to the base buffer
1577 or its other indirect buffers. */
1578 for (m = BUF_MARKERS (b); m; )
1580 struct Lisp_Marker *next = m->next;
1581 if (m->buffer == b)
1582 unchain_marker (m);
1583 m = next;
1586 else
1588 /* Unchain all markers of this buffer and its indirect buffers.
1589 and leave them pointing nowhere. */
1590 for (m = BUF_MARKERS (b); m; )
1592 struct Lisp_Marker *next = m->next;
1593 m->buffer = 0;
1594 m->next = NULL;
1595 m = next;
1597 BUF_MARKERS (b) = NULL;
1598 BUF_INTERVALS (b) = NULL_INTERVAL;
1600 /* Perhaps we should explicitly free the interval tree here... */
1603 /* Reset the local variables, so that this buffer's local values
1604 won't be protected from GC. They would be protected
1605 if they happened to remain encached in their symbols.
1606 This gets rid of them for certain. */
1607 swap_out_buffer_local_variables (b);
1608 reset_buffer_local_variables (b, 1);
1610 b->name = Qnil;
1612 BLOCK_INPUT;
1613 if (! b->base_buffer)
1614 free_buffer_text (b);
1616 if (b->newline_cache)
1618 free_region_cache (b->newline_cache);
1619 b->newline_cache = 0;
1621 if (b->width_run_cache)
1623 free_region_cache (b->width_run_cache);
1624 b->width_run_cache = 0;
1626 b->width_table = Qnil;
1627 UNBLOCK_INPUT;
1628 b->undo_list = Qnil;
1630 return Qt;
1633 /* Move the assoc for buffer BUF to the front of buffer-alist. Since
1634 we do this each time BUF is selected visibly, the more recently
1635 selected buffers are always closer to the front of the list. This
1636 means that other_buffer is more likely to choose a relevant buffer. */
1638 void
1639 record_buffer (buf)
1640 Lisp_Object buf;
1642 register Lisp_Object link, prev;
1643 Lisp_Object frame;
1644 frame = selected_frame;
1646 prev = Qnil;
1647 for (link = Vbuffer_alist; CONSP (link); link = XCDR (link))
1649 if (EQ (XCDR (XCAR (link)), buf))
1650 break;
1651 prev = link;
1654 /* Effectively do Vbuffer_alist = Fdelq (link, Vbuffer_alist);
1655 we cannot use Fdelq itself here because it allows quitting. */
1657 if (NILP (prev))
1658 Vbuffer_alist = XCDR (Vbuffer_alist);
1659 else
1660 XSETCDR (prev, XCDR (XCDR (prev)));
1662 XSETCDR (link, Vbuffer_alist);
1663 Vbuffer_alist = link;
1665 /* Effectively do a delq on buried_buffer_list. */
1667 prev = Qnil;
1668 for (link = XFRAME (frame)->buried_buffer_list; CONSP (link);
1669 link = XCDR (link))
1671 if (EQ (XCAR (link), buf))
1673 if (NILP (prev))
1674 XFRAME (frame)->buried_buffer_list = XCDR (link);
1675 else
1676 XSETCDR (prev, XCDR (XCDR (prev)));
1677 break;
1679 prev = link;
1682 /* Now move this buffer to the front of frame_buffer_list also. */
1684 prev = Qnil;
1685 for (link = frame_buffer_list (frame); CONSP (link);
1686 link = XCDR (link))
1688 if (EQ (XCAR (link), buf))
1689 break;
1690 prev = link;
1693 /* Effectively do delq. */
1695 if (CONSP (link))
1697 if (NILP (prev))
1698 set_frame_buffer_list (frame,
1699 XCDR (frame_buffer_list (frame)));
1700 else
1701 XSETCDR (prev, XCDR (XCDR (prev)));
1703 XSETCDR (link, frame_buffer_list (frame));
1704 set_frame_buffer_list (frame, link);
1706 else
1707 set_frame_buffer_list (frame, Fcons (buf, frame_buffer_list (frame)));
1710 DEFUN ("set-buffer-major-mode", Fset_buffer_major_mode, Sset_buffer_major_mode, 1, 1, 0,
1711 doc: /* Set an appropriate major mode for BUFFER.
1712 For the *scratch* buffer, use `initial-major-mode', otherwise choose a mode
1713 according to `default-major-mode'.
1714 Use this function before selecting the buffer, since it may need to inspect
1715 the current buffer's major mode. */)
1716 (buffer)
1717 Lisp_Object buffer;
1719 int count;
1720 Lisp_Object function;
1722 CHECK_BUFFER (buffer);
1724 if (STRINGP (XBUFFER (buffer)->name)
1725 && strcmp (SDATA (XBUFFER (buffer)->name), "*scratch*") == 0)
1726 function = find_symbol_value (intern ("initial-major-mode"));
1727 else
1729 function = buffer_defaults.major_mode;
1730 if (NILP (function)
1731 && NILP (Fget (current_buffer->major_mode, Qmode_class)))
1732 function = current_buffer->major_mode;
1735 if (NILP (function) || EQ (function, Qfundamental_mode))
1736 return Qnil;
1738 count = SPECPDL_INDEX ();
1740 /* To select a nonfundamental mode,
1741 select the buffer temporarily and then call the mode function. */
1743 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1745 Fset_buffer (buffer);
1746 call0 (function);
1748 return unbind_to (count, Qnil);
1751 /* Switch to buffer BUFFER in the selected window.
1752 If NORECORD is non-nil, don't call record_buffer. */
1754 Lisp_Object
1755 switch_to_buffer_1 (buffer_or_name, norecord)
1756 Lisp_Object buffer_or_name, norecord;
1758 register Lisp_Object buffer;
1760 if (NILP (buffer_or_name))
1761 buffer = Fother_buffer (Fcurrent_buffer (), Qnil, Qnil);
1762 else
1764 buffer = Fget_buffer (buffer_or_name);
1765 if (NILP (buffer))
1767 buffer = Fget_buffer_create (buffer_or_name);
1768 Fset_buffer_major_mode (buffer);
1771 Fset_buffer (buffer);
1772 if (NILP (norecord))
1773 record_buffer (buffer);
1775 Fset_window_buffer (EQ (selected_window, minibuf_window)
1776 ? Fnext_window (minibuf_window, Qnil, Qnil)
1777 : selected_window,
1778 buffer, Qnil);
1780 return buffer;
1783 DEFUN ("switch-to-buffer", Fswitch_to_buffer, Sswitch_to_buffer, 1, 2,
1784 "(list (read-buffer-to-switch \"Switch to buffer: \"))",
1785 doc: /* Make BUFFER-OR-NAME current and display it in selected window.
1786 BUFFER-OR-NAME may be a buffer, a string \(a buffer name), or
1787 nil. Return the buffer switched to.
1789 If BUFFER-OR-NAME is a string and does not identify an existing
1790 buffer, create a new buffer with that name. Interactively, if
1791 `confirm-nonexistent-file-or-buffer' is non-nil, request
1792 confirmation before creating a new buffer. If BUFFER-OR-NAME is
1793 nil, switch to buffer returned by `other-buffer'.
1795 Optional second arg NORECORD non-nil means do not put this buffer
1796 at the front of the list of recently selected ones. This
1797 function returns the buffer it switched to as a Lisp object.
1799 If the selected window is the minibuffer window or dedicated to
1800 its buffer, use `pop-to-buffer' for displaying the buffer.
1802 WARNING: This is NOT the way to work on another buffer temporarily
1803 within a Lisp program! Use `set-buffer' instead. That avoids
1804 messing with the window-buffer correspondences. */)
1805 (buffer_or_name, norecord)
1806 Lisp_Object buffer_or_name, norecord;
1808 char *err;
1810 if (EQ (buffer_or_name, Fwindow_buffer (selected_window)))
1812 /* Basically a NOP. Avoid signalling an error in the case where
1813 the selected window is dedicated, or a minibuffer. */
1815 /* But do put this buffer at the front of the buffer list, unless
1816 that has been inhibited. Note that even if BUFFER-OR-NAME is
1817 at the front of the main buffer-list already, we still want to
1818 move it to the front of the frame's buffer list. */
1819 if (NILP (norecord))
1820 record_buffer (buffer_or_name);
1821 return Fset_buffer (buffer_or_name);
1823 else if (EQ (minibuf_window, selected_window)
1824 /* If `dedicated' is neither nil nor t, it means it's
1825 dedicatedness can be overridden by an explicit request
1826 such as a call to switch-to-buffer. */
1827 || EQ (Fwindow_dedicated_p (selected_window), Qt))
1828 /* We can't use the selected window so let `pop-to-buffer' try some
1829 other window. */
1830 return call3 (intern ("pop-to-buffer"), buffer_or_name, Qnil, norecord);
1831 else
1832 return switch_to_buffer_1 (buffer_or_name, norecord);
1835 DEFUN ("current-buffer", Fcurrent_buffer, Scurrent_buffer, 0, 0, 0,
1836 doc: /* Return the current buffer as a Lisp object. */)
1839 register Lisp_Object buf;
1840 XSETBUFFER (buf, current_buffer);
1841 return buf;
1844 /* Set the current buffer to B.
1846 We previously set windows_or_buffers_changed here to invalidate
1847 global unchanged information in beg_unchanged and end_unchanged.
1848 This is no longer necessary because we now compute unchanged
1849 information on a buffer-basis. Every action affecting other
1850 windows than the selected one requires a select_window at some
1851 time, and that increments windows_or_buffers_changed. */
1853 void
1854 set_buffer_internal (b)
1855 register struct buffer *b;
1857 if (current_buffer != b)
1858 set_buffer_internal_1 (b);
1861 /* Set the current buffer to B, and do not set windows_or_buffers_changed.
1862 This is used by redisplay. */
1864 void
1865 set_buffer_internal_1 (b)
1866 register struct buffer *b;
1868 register struct buffer *old_buf;
1869 register Lisp_Object tail, valcontents;
1870 Lisp_Object tem;
1872 #ifdef USE_MMAP_FOR_BUFFERS
1873 if (b->text->beg == NULL)
1874 enlarge_buffer_text (b, 0);
1875 #endif /* USE_MMAP_FOR_BUFFERS */
1877 if (current_buffer == b)
1878 return;
1880 old_buf = current_buffer;
1881 current_buffer = b;
1882 last_known_column_point = -1; /* invalidate indentation cache */
1884 if (old_buf)
1886 /* Put the undo list back in the base buffer, so that it appears
1887 that an indirect buffer shares the undo list of its base. */
1888 if (old_buf->base_buffer)
1889 old_buf->base_buffer->undo_list = old_buf->undo_list;
1891 /* If the old current buffer has markers to record PT, BEGV and ZV
1892 when it is not current, update them now. */
1893 if (! NILP (old_buf->pt_marker))
1895 Lisp_Object obuf;
1896 XSETBUFFER (obuf, old_buf);
1897 set_marker_both (old_buf->pt_marker, obuf,
1898 BUF_PT (old_buf), BUF_PT_BYTE (old_buf));
1900 if (! NILP (old_buf->begv_marker))
1902 Lisp_Object obuf;
1903 XSETBUFFER (obuf, old_buf);
1904 set_marker_both (old_buf->begv_marker, obuf,
1905 BUF_BEGV (old_buf), BUF_BEGV_BYTE (old_buf));
1907 if (! NILP (old_buf->zv_marker))
1909 Lisp_Object obuf;
1910 XSETBUFFER (obuf, old_buf);
1911 set_marker_both (old_buf->zv_marker, obuf,
1912 BUF_ZV (old_buf), BUF_ZV_BYTE (old_buf));
1916 /* Get the undo list from the base buffer, so that it appears
1917 that an indirect buffer shares the undo list of its base. */
1918 if (b->base_buffer)
1919 b->undo_list = b->base_buffer->undo_list;
1921 /* If the new current buffer has markers to record PT, BEGV and ZV
1922 when it is not current, fetch them now. */
1923 if (! NILP (b->pt_marker))
1925 BUF_PT (b) = marker_position (b->pt_marker);
1926 BUF_PT_BYTE (b) = marker_byte_position (b->pt_marker);
1928 if (! NILP (b->begv_marker))
1930 BUF_BEGV (b) = marker_position (b->begv_marker);
1931 BUF_BEGV_BYTE (b) = marker_byte_position (b->begv_marker);
1933 if (! NILP (b->zv_marker))
1935 BUF_ZV (b) = marker_position (b->zv_marker);
1936 BUF_ZV_BYTE (b) = marker_byte_position (b->zv_marker);
1939 /* Look down buffer's list of local Lisp variables
1940 to find and update any that forward into C variables. */
1942 for (tail = b->local_var_alist; CONSP (tail); tail = XCDR (tail))
1944 if (CONSP (XCAR (tail))
1945 && SYMBOLP (XCAR (XCAR (tail)))
1946 && (valcontents = SYMBOL_VALUE (XCAR (XCAR (tail))),
1947 (BUFFER_LOCAL_VALUEP (valcontents)))
1948 && (tem = XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
1949 (BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem))))
1950 /* Just reference the variable to cause it to become set for
1951 this buffer. */
1952 Fsymbol_value (XCAR (XCAR (tail)));
1955 /* Do the same with any others that were local to the previous buffer */
1957 if (old_buf)
1958 for (tail = old_buf->local_var_alist; CONSP (tail); tail = XCDR (tail))
1960 if (CONSP (tail)
1961 && SYMBOLP (XCAR (XCAR (tail)))
1962 && (valcontents = SYMBOL_VALUE (XCAR (XCAR (tail))),
1963 (BUFFER_LOCAL_VALUEP (valcontents)))
1964 && (tem = XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
1965 (BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem))))
1966 /* Just reference the variable to cause it to become set for
1967 this buffer. */
1968 Fsymbol_value (XCAR (XCAR (tail)));
1972 /* Switch to buffer B temporarily for redisplay purposes.
1973 This avoids certain things that don't need to be done within redisplay. */
1975 void
1976 set_buffer_temp (b)
1977 struct buffer *b;
1979 register struct buffer *old_buf;
1981 if (current_buffer == b)
1982 return;
1984 old_buf = current_buffer;
1985 current_buffer = b;
1987 if (old_buf)
1989 /* If the old current buffer has markers to record PT, BEGV and ZV
1990 when it is not current, update them now. */
1991 if (! NILP (old_buf->pt_marker))
1993 Lisp_Object obuf;
1994 XSETBUFFER (obuf, old_buf);
1995 set_marker_both (old_buf->pt_marker, obuf,
1996 BUF_PT (old_buf), BUF_PT_BYTE (old_buf));
1998 if (! NILP (old_buf->begv_marker))
2000 Lisp_Object obuf;
2001 XSETBUFFER (obuf, old_buf);
2002 set_marker_both (old_buf->begv_marker, obuf,
2003 BUF_BEGV (old_buf), BUF_BEGV_BYTE (old_buf));
2005 if (! NILP (old_buf->zv_marker))
2007 Lisp_Object obuf;
2008 XSETBUFFER (obuf, old_buf);
2009 set_marker_both (old_buf->zv_marker, obuf,
2010 BUF_ZV (old_buf), BUF_ZV_BYTE (old_buf));
2014 /* If the new current buffer has markers to record PT, BEGV and ZV
2015 when it is not current, fetch them now. */
2016 if (! NILP (b->pt_marker))
2018 BUF_PT (b) = marker_position (b->pt_marker);
2019 BUF_PT_BYTE (b) = marker_byte_position (b->pt_marker);
2021 if (! NILP (b->begv_marker))
2023 BUF_BEGV (b) = marker_position (b->begv_marker);
2024 BUF_BEGV_BYTE (b) = marker_byte_position (b->begv_marker);
2026 if (! NILP (b->zv_marker))
2028 BUF_ZV (b) = marker_position (b->zv_marker);
2029 BUF_ZV_BYTE (b) = marker_byte_position (b->zv_marker);
2033 DEFUN ("set-buffer", Fset_buffer, Sset_buffer, 1, 1, 0,
2034 doc: /* Make buffer BUFFER-OR-NAME current for editing operations.
2035 BUFFER-OR-NAME may be a buffer or the name of an existing buffer. See
2036 also `save-excursion' when you want to make a buffer current
2037 temporarily. This function does not display the buffer, so its effect
2038 ends when the current command terminates. Use `switch-to-buffer' or
2039 `pop-to-buffer' to switch buffers permanently. */)
2040 (buffer_or_name)
2041 register Lisp_Object buffer_or_name;
2043 register Lisp_Object buffer;
2044 buffer = Fget_buffer (buffer_or_name);
2045 if (NILP (buffer))
2046 nsberror (buffer_or_name);
2047 if (NILP (XBUFFER (buffer)->name))
2048 error ("Selecting deleted buffer");
2049 set_buffer_internal (XBUFFER (buffer));
2050 return buffer;
2053 /* Set the current buffer to BUFFER provided it is alive. */
2055 Lisp_Object
2056 set_buffer_if_live (buffer)
2057 Lisp_Object buffer;
2059 if (! NILP (XBUFFER (buffer)->name))
2060 Fset_buffer (buffer);
2061 return Qnil;
2064 DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only,
2065 Sbarf_if_buffer_read_only, 0, 0, 0,
2066 doc: /* Signal a `buffer-read-only' error if the current buffer is read-only. */)
2069 if (!NILP (current_buffer->read_only)
2070 && NILP (Vinhibit_read_only))
2071 xsignal1 (Qbuffer_read_only, Fcurrent_buffer ());
2072 return Qnil;
2075 DEFUN ("bury-buffer", Fbury_buffer, Sbury_buffer, 0, 1, "",
2076 doc: /* Put BUFFER-OR-NAME at the end of the list of all buffers.
2077 There it is the least likely candidate for `other-buffer' to return;
2078 thus, the least likely buffer for \\[switch-to-buffer] to select by
2079 default.
2081 The argument may be a buffer name or an actual buffer object. If
2082 BUFFER-OR-NAME is nil or omitted, bury the current buffer and remove it
2083 from the selected window if it is displayed there. If the selected
2084 window is dedicated to its buffer, delete that window if there are other
2085 windows on the same frame. If the selected window is the only window on
2086 its frame, iconify that frame. */)
2087 (buffer_or_name)
2088 register Lisp_Object buffer_or_name;
2090 Lisp_Object buffer;
2092 /* Figure out what buffer we're going to bury. */
2093 if (NILP (buffer_or_name))
2095 Lisp_Object tem;
2096 XSETBUFFER (buffer, current_buffer);
2098 tem = Fwindow_buffer (selected_window);
2099 /* If we're burying the current buffer, unshow it. */
2100 if (EQ (buffer, tem))
2102 if (NILP (Fwindow_dedicated_p (selected_window)))
2103 Fswitch_to_buffer (Fother_buffer (buffer, Qnil, Qnil), Qnil);
2104 else if (NILP (XWINDOW (selected_window)->parent))
2105 Ficonify_frame (Fwindow_frame (selected_window));
2106 else
2107 Fdelete_window (selected_window);
2110 else
2112 buffer = Fget_buffer (buffer_or_name);
2113 if (NILP (buffer))
2114 nsberror (buffer_or_name);
2117 /* Move buffer to the end of the buffer list. Do nothing if the
2118 buffer is killed. */
2119 if (!NILP (XBUFFER (buffer)->name))
2121 Lisp_Object aelt, link;
2123 aelt = Frassq (buffer, Vbuffer_alist);
2124 link = Fmemq (aelt, Vbuffer_alist);
2125 Vbuffer_alist = Fdelq (aelt, Vbuffer_alist);
2126 XSETCDR (link, Qnil);
2127 Vbuffer_alist = nconc2 (Vbuffer_alist, link);
2129 XFRAME (selected_frame)->buffer_list
2130 = Fdelq (buffer, XFRAME (selected_frame)->buffer_list);
2131 XFRAME (selected_frame)->buried_buffer_list
2132 = Fcons (buffer, Fdelq (buffer, XFRAME (selected_frame)->buried_buffer_list));
2135 return Qnil;
2138 DEFUN ("erase-buffer", Ferase_buffer, Serase_buffer, 0, 0, "*",
2139 doc: /* Delete the entire contents of the current buffer.
2140 Any narrowing restriction in effect (see `narrow-to-region') is removed,
2141 so the buffer is truly empty after this. */)
2144 Fwiden ();
2146 del_range (BEG, Z);
2148 current_buffer->last_window_start = 1;
2149 /* Prevent warnings, or suspension of auto saving, that would happen
2150 if future size is less than past size. Use of erase-buffer
2151 implies that the future text is not really related to the past text. */
2152 XSETFASTINT (current_buffer->save_length, 0);
2153 return Qnil;
2156 void
2157 validate_region (b, e)
2158 register Lisp_Object *b, *e;
2160 CHECK_NUMBER_COERCE_MARKER (*b);
2161 CHECK_NUMBER_COERCE_MARKER (*e);
2163 if (XINT (*b) > XINT (*e))
2165 Lisp_Object tem;
2166 tem = *b; *b = *e; *e = tem;
2169 if (!(BEGV <= XINT (*b) && XINT (*b) <= XINT (*e)
2170 && XINT (*e) <= ZV))
2171 args_out_of_range (*b, *e);
2174 /* Advance BYTE_POS up to a character boundary
2175 and return the adjusted position. */
2177 static int
2178 advance_to_char_boundary (byte_pos)
2179 int byte_pos;
2181 int c;
2183 if (byte_pos == BEG)
2184 /* Beginning of buffer is always a character boundary. */
2185 return BEG;
2187 c = FETCH_BYTE (byte_pos);
2188 if (! CHAR_HEAD_P (c))
2190 /* We should advance BYTE_POS only when C is a constituent of a
2191 multibyte sequence. */
2192 int orig_byte_pos = byte_pos;
2196 byte_pos--;
2197 c = FETCH_BYTE (byte_pos);
2199 while (! CHAR_HEAD_P (c) && byte_pos > BEG);
2200 INC_POS (byte_pos);
2201 if (byte_pos < orig_byte_pos)
2202 byte_pos = orig_byte_pos;
2203 /* If C is a constituent of a multibyte sequence, BYTE_POS was
2204 surely advance to the correct character boundary. If C is
2205 not, BYTE_POS was unchanged. */
2208 return byte_pos;
2211 #ifdef REL_ALLOC
2212 extern void r_alloc_reset_variable P_ ((POINTER_TYPE *, POINTER_TYPE *));
2213 #endif /* REL_ALLOC */
2215 DEFUN ("buffer-swap-text", Fbuffer_swap_text, Sbuffer_swap_text,
2216 1, 1, 0,
2217 doc: /* Swap the text between current buffer and BUFFER. */)
2218 (buffer)
2219 Lisp_Object buffer;
2221 struct buffer *other_buffer;
2222 CHECK_BUFFER (buffer);
2223 other_buffer = XBUFFER (buffer);
2225 if (NILP (other_buffer->name))
2226 error ("Cannot swap a dead buffer's text");
2228 /* Actually, it probably works just fine.
2229 * if (other_buffer == current_buffer)
2230 * error ("Cannot swap a buffer's text with itself"); */
2232 /* Actually, this may be workable as well, tho probably only if they're
2233 *both* indirect. */
2234 if (other_buffer->base_buffer
2235 || current_buffer->base_buffer)
2236 error ("Cannot swap indirect buffers's text");
2238 { /* This is probably harder to make work. */
2239 struct buffer *other;
2240 for (other = all_buffers; other; other = other->next)
2241 if (other->base_buffer == other_buffer
2242 || other->base_buffer == current_buffer)
2243 error ("One of the buffers to swap has indirect buffers");
2246 #define swapfield(field, type) \
2247 do { \
2248 type tmp##field = other_buffer->field; \
2249 other_buffer->field = current_buffer->field; \
2250 current_buffer->field = tmp##field; \
2251 } while (0)
2253 swapfield (own_text, struct buffer_text);
2254 eassert (current_buffer->text == &current_buffer->own_text);
2255 eassert (other_buffer->text == &other_buffer->own_text);
2256 #ifdef REL_ALLOC
2257 r_alloc_reset_variable ((POINTER_TYPE **) &current_buffer->own_text.beg,
2258 (POINTER_TYPE **) &other_buffer->own_text.beg);
2259 r_alloc_reset_variable ((POINTER_TYPE **) &other_buffer->own_text.beg,
2260 (POINTER_TYPE **) &current_buffer->own_text.beg);
2261 #endif /* REL_ALLOC */
2263 swapfield (pt, EMACS_INT);
2264 swapfield (pt_byte, EMACS_INT);
2265 swapfield (begv, EMACS_INT);
2266 swapfield (begv_byte, EMACS_INT);
2267 swapfield (zv, EMACS_INT);
2268 swapfield (zv_byte, EMACS_INT);
2269 eassert (!current_buffer->base_buffer);
2270 eassert (!other_buffer->base_buffer);
2271 current_buffer->clip_changed = 1; other_buffer->clip_changed = 1;
2272 swapfield (newline_cache, struct region_cache *);
2273 swapfield (width_run_cache, struct region_cache *);
2274 current_buffer->prevent_redisplay_optimizations_p = 1;
2275 other_buffer->prevent_redisplay_optimizations_p = 1;
2276 swapfield (overlays_before, struct Lisp_Overlay *);
2277 swapfield (overlays_after, struct Lisp_Overlay *);
2278 swapfield (overlay_center, EMACS_INT);
2279 swapfield (undo_list, Lisp_Object);
2280 swapfield (mark, Lisp_Object);
2281 swapfield (enable_multibyte_characters, Lisp_Object);
2282 swapfield (bidi_display_reordering, Lisp_Object);
2283 swapfield (bidi_paragraph_direction, Lisp_Object);
2284 /* FIXME: Not sure what we should do with these *_marker fields.
2285 Hopefully they're just nil anyway. */
2286 swapfield (pt_marker, Lisp_Object);
2287 swapfield (begv_marker, Lisp_Object);
2288 swapfield (zv_marker, Lisp_Object);
2289 current_buffer->point_before_scroll = Qnil;
2290 other_buffer->point_before_scroll = Qnil;
2292 current_buffer->text->modiff++; other_buffer->text->modiff++;
2293 current_buffer->text->chars_modiff++; other_buffer->text->chars_modiff++;
2294 current_buffer->text->overlay_modiff++; other_buffer->text->overlay_modiff++;
2295 current_buffer->text->beg_unchanged = current_buffer->text->gpt;
2296 current_buffer->text->end_unchanged = current_buffer->text->gpt;
2297 other_buffer->text->beg_unchanged = other_buffer->text->gpt;
2298 other_buffer->text->end_unchanged = other_buffer->text->gpt;
2300 struct Lisp_Marker *m;
2301 for (m = BUF_MARKERS (current_buffer); m; m = m->next)
2302 if (m->buffer == other_buffer)
2303 m->buffer = current_buffer;
2304 else
2305 /* Since there's no indirect buffer in sight, markers on
2306 BUF_MARKERS(buf) should either be for `buf' or dead. */
2307 eassert (!m->buffer);
2308 for (m = BUF_MARKERS (other_buffer); m; m = m->next)
2309 if (m->buffer == current_buffer)
2310 m->buffer = other_buffer;
2311 else
2312 /* Since there's no indirect buffer in sight, markers on
2313 BUF_MARKERS(buf) should either be for `buf' or dead. */
2314 eassert (!m->buffer);
2316 { /* Some of the C code expects that w->buffer == w->pointm->buffer.
2317 So since we just swapped the markers between the two buffers, we need
2318 to undo the effect of this swap for window markers. */
2319 Lisp_Object w = Fselected_window (), ws = Qnil;
2320 Lisp_Object buf1, buf2;
2321 XSETBUFFER (buf1, current_buffer); XSETBUFFER (buf2, other_buffer);
2323 while (NILP (Fmemq (w, ws)))
2325 ws = Fcons (w, ws);
2326 if (MARKERP (XWINDOW (w)->pointm)
2327 && (EQ (XWINDOW (w)->buffer, buf1)
2328 || EQ (XWINDOW (w)->buffer, buf2)))
2329 Fset_marker (XWINDOW (w)->pointm,
2330 make_number (BUF_BEGV (XBUFFER (XWINDOW (w)->buffer))),
2331 XWINDOW (w)->buffer);
2332 w = Fnext_window (w, Qt, Qt);
2336 if (current_buffer->text->intervals)
2337 (eassert (EQ (current_buffer->text->intervals->up.obj, buffer)),
2338 XSETBUFFER (current_buffer->text->intervals->up.obj, current_buffer));
2339 if (other_buffer->text->intervals)
2340 (eassert (EQ (other_buffer->text->intervals->up.obj, Fcurrent_buffer ())),
2341 XSETBUFFER (other_buffer->text->intervals->up.obj, other_buffer));
2343 return Qnil;
2346 DEFUN ("set-buffer-multibyte", Fset_buffer_multibyte, Sset_buffer_multibyte,
2347 1, 1, 0,
2348 doc: /* Set the multibyte flag of the current buffer to FLAG.
2349 If FLAG is t, this makes the buffer a multibyte buffer.
2350 If FLAG is nil, this makes the buffer a single-byte buffer.
2351 In these cases, the buffer contents remain unchanged as a sequence of
2352 bytes but the contents viewed as characters do change.
2353 If FLAG is `to', this makes the buffer a multibyte buffer by changing
2354 all eight-bit bytes to eight-bit characters.
2355 If the multibyte flag was really changed, undo information of the
2356 current buffer is cleared. */)
2357 (flag)
2358 Lisp_Object flag;
2360 struct Lisp_Marker *tail, *markers;
2361 struct buffer *other;
2362 int begv, zv;
2363 int narrowed = (BEG != BEGV || Z != ZV);
2364 int modified_p = !NILP (Fbuffer_modified_p (Qnil));
2365 Lisp_Object old_undo = current_buffer->undo_list;
2366 struct gcpro gcpro1;
2368 if (current_buffer->base_buffer)
2369 error ("Cannot do `set-buffer-multibyte' on an indirect buffer");
2371 /* Do nothing if nothing actually changes. */
2372 if (NILP (flag) == NILP (current_buffer->enable_multibyte_characters))
2373 return flag;
2375 GCPRO1 (old_undo);
2377 /* Don't record these buffer changes. We will put a special undo entry
2378 instead. */
2379 current_buffer->undo_list = Qt;
2381 /* If the cached position is for this buffer, clear it out. */
2382 clear_charpos_cache (current_buffer);
2384 if (NILP (flag))
2385 begv = BEGV_BYTE, zv = ZV_BYTE;
2386 else
2387 begv = BEGV, zv = ZV;
2389 if (narrowed)
2390 Fwiden ();
2392 if (NILP (flag))
2394 int pos, stop;
2395 unsigned char *p;
2397 /* Do this first, so it can use CHAR_TO_BYTE
2398 to calculate the old correspondences. */
2399 set_intervals_multibyte (0);
2401 current_buffer->enable_multibyte_characters = Qnil;
2403 Z = Z_BYTE;
2404 BEGV = BEGV_BYTE;
2405 ZV = ZV_BYTE;
2406 GPT = GPT_BYTE;
2407 TEMP_SET_PT_BOTH (PT_BYTE, PT_BYTE);
2410 for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
2411 tail->charpos = tail->bytepos;
2413 /* Convert multibyte form of 8-bit characters to unibyte. */
2414 pos = BEG;
2415 stop = GPT;
2416 p = BEG_ADDR;
2417 while (1)
2419 int c, bytes;
2421 if (pos == stop)
2423 if (pos == Z)
2424 break;
2425 p = GAP_END_ADDR;
2426 stop = Z;
2428 if (ASCII_BYTE_P (*p))
2429 p++, pos++;
2430 else if (CHAR_BYTE8_HEAD_P (*p))
2432 c = STRING_CHAR_AND_LENGTH (p, bytes);
2433 /* Delete all bytes for this 8-bit character but the
2434 last one, and change the last one to the charcter
2435 code. */
2436 bytes--;
2437 del_range_2 (pos, pos, pos + bytes, pos + bytes, 0);
2438 p = GAP_END_ADDR;
2439 *p++ = c;
2440 pos++;
2441 if (begv > pos)
2442 begv -= bytes;
2443 if (zv > pos)
2444 zv -= bytes;
2445 stop = Z;
2447 else
2449 bytes = BYTES_BY_CHAR_HEAD (*p);
2450 p += bytes, pos += bytes;
2453 if (narrowed)
2454 Fnarrow_to_region (make_number (begv), make_number (zv));
2456 else
2458 int pt = PT;
2459 int pos, stop;
2460 unsigned char *p, *pend;
2462 /* Be sure not to have a multibyte sequence striding over the GAP.
2463 Ex: We change this: "...abc\302 _GAP_ \241def..."
2464 to: "...abc _GAP_ \302\241def..." */
2466 if (EQ (flag, Qt)
2467 && GPT_BYTE > 1 && GPT_BYTE < Z_BYTE
2468 && ! CHAR_HEAD_P (*(GAP_END_ADDR)))
2470 unsigned char *p = GPT_ADDR - 1;
2472 while (! CHAR_HEAD_P (*p) && p > BEG_ADDR) p--;
2473 if (BASE_LEADING_CODE_P (*p))
2475 int new_gpt = GPT_BYTE - (GPT_ADDR - p);
2477 move_gap_both (new_gpt, new_gpt);
2481 /* Make the buffer contents valid as multibyte by converting
2482 8-bit characters to multibyte form. */
2483 pos = BEG;
2484 stop = GPT;
2485 p = BEG_ADDR;
2486 pend = GPT_ADDR;
2487 while (1)
2489 int bytes;
2491 if (pos == stop)
2493 if (pos == Z)
2494 break;
2495 p = GAP_END_ADDR;
2496 pend = Z_ADDR;
2497 stop = Z;
2500 if (ASCII_BYTE_P (*p))
2501 p++, pos++;
2502 else if (EQ (flag, Qt) && (bytes = MULTIBYTE_LENGTH (p, pend)) > 0)
2503 p += bytes, pos += bytes;
2504 else
2506 unsigned char tmp[MAX_MULTIBYTE_LENGTH];
2507 int c;
2509 c = BYTE8_TO_CHAR (*p);
2510 bytes = CHAR_STRING (c, tmp);
2511 *p = tmp[0];
2512 TEMP_SET_PT_BOTH (pos + 1, pos + 1);
2513 bytes--;
2514 insert_1_both (tmp + 1, bytes, bytes, 1, 0, 0);
2515 /* Now the gap is after the just inserted data. */
2516 pos = GPT;
2517 p = GAP_END_ADDR;
2518 if (pos <= begv)
2519 begv += bytes;
2520 if (pos <= zv)
2521 zv += bytes;
2522 if (pos <= pt)
2523 pt += bytes;
2524 pend = Z_ADDR;
2525 stop = Z;
2529 if (pt != PT)
2530 TEMP_SET_PT (pt);
2532 if (narrowed)
2533 Fnarrow_to_region (make_number (begv), make_number (zv));
2535 /* Do this first, so that chars_in_text asks the right question.
2536 set_intervals_multibyte needs it too. */
2537 current_buffer->enable_multibyte_characters = Qt;
2539 GPT_BYTE = advance_to_char_boundary (GPT_BYTE);
2540 GPT = chars_in_text (BEG_ADDR, GPT_BYTE - BEG_BYTE) + BEG;
2542 Z = chars_in_text (GAP_END_ADDR, Z_BYTE - GPT_BYTE) + GPT;
2544 BEGV_BYTE = advance_to_char_boundary (BEGV_BYTE);
2545 if (BEGV_BYTE > GPT_BYTE)
2546 BEGV = chars_in_text (GAP_END_ADDR, BEGV_BYTE - GPT_BYTE) + GPT;
2547 else
2548 BEGV = chars_in_text (BEG_ADDR, BEGV_BYTE - BEG_BYTE) + BEG;
2550 ZV_BYTE = advance_to_char_boundary (ZV_BYTE);
2551 if (ZV_BYTE > GPT_BYTE)
2552 ZV = chars_in_text (GAP_END_ADDR, ZV_BYTE - GPT_BYTE) + GPT;
2553 else
2554 ZV = chars_in_text (BEG_ADDR, ZV_BYTE - BEG_BYTE) + BEG;
2557 int pt_byte = advance_to_char_boundary (PT_BYTE);
2558 int pt;
2560 if (pt_byte > GPT_BYTE)
2561 pt = chars_in_text (GAP_END_ADDR, pt_byte - GPT_BYTE) + GPT;
2562 else
2563 pt = chars_in_text (BEG_ADDR, pt_byte - BEG_BYTE) + BEG;
2564 TEMP_SET_PT_BOTH (pt, pt_byte);
2567 tail = markers = BUF_MARKERS (current_buffer);
2569 /* This prevents BYTE_TO_CHAR (that is, buf_bytepos_to_charpos) from
2570 getting confused by the markers that have not yet been updated.
2571 It is also a signal that it should never create a marker. */
2572 BUF_MARKERS (current_buffer) = NULL;
2574 for (; tail; tail = tail->next)
2576 tail->bytepos = advance_to_char_boundary (tail->bytepos);
2577 tail->charpos = BYTE_TO_CHAR (tail->bytepos);
2580 /* Make sure no markers were put on the chain
2581 while the chain value was incorrect. */
2582 if (BUF_MARKERS (current_buffer))
2583 abort ();
2585 BUF_MARKERS (current_buffer) = markers;
2587 /* Do this last, so it can calculate the new correspondences
2588 between chars and bytes. */
2589 set_intervals_multibyte (1);
2592 if (!EQ (old_undo, Qt))
2594 /* Represent all the above changes by a special undo entry. */
2595 extern Lisp_Object Qapply;
2596 current_buffer->undo_list = Fcons (list3 (Qapply,
2597 intern ("set-buffer-multibyte"),
2598 NILP (flag) ? Qt : Qnil),
2599 old_undo);
2602 UNGCPRO;
2604 /* Changing the multibyteness of a buffer means that all windows
2605 showing that buffer must be updated thoroughly. */
2606 current_buffer->prevent_redisplay_optimizations_p = 1;
2607 ++windows_or_buffers_changed;
2609 /* Copy this buffer's new multibyte status
2610 into all of its indirect buffers. */
2611 for (other = all_buffers; other; other = other->next)
2612 if (other->base_buffer == current_buffer && !NILP (other->name))
2614 other->enable_multibyte_characters
2615 = current_buffer->enable_multibyte_characters;
2616 other->prevent_redisplay_optimizations_p = 1;
2619 /* Restore the modifiedness of the buffer. */
2620 if (!modified_p && !NILP (Fbuffer_modified_p (Qnil)))
2621 Fset_buffer_modified_p (Qnil);
2623 #ifdef subprocesses
2624 /* Update coding systems of this buffer's process (if any). */
2626 Lisp_Object process;
2628 process = Fget_buffer_process (Fcurrent_buffer ());
2629 if (PROCESSP (process))
2630 setup_process_coding_systems (process);
2632 #endif /* subprocesses */
2634 return flag;
2637 DEFUN ("kill-all-local-variables", Fkill_all_local_variables, Skill_all_local_variables,
2638 0, 0, 0,
2639 doc: /* Switch to Fundamental mode by killing current buffer's local variables.
2640 Most local variable bindings are eliminated so that the default values
2641 become effective once more. Also, the syntax table is set from
2642 `standard-syntax-table', the local keymap is set to nil,
2643 and the abbrev table from `fundamental-mode-abbrev-table'.
2644 This function also forces redisplay of the mode line.
2646 Every function to select a new major mode starts by
2647 calling this function.
2649 As a special exception, local variables whose names have
2650 a non-nil `permanent-local' property are not eliminated by this function.
2652 The first thing this function does is run
2653 the normal hook `change-major-mode-hook'. */)
2656 if (!NILP (Vrun_hooks))
2657 call1 (Vrun_hooks, Qchange_major_mode_hook);
2659 /* Make sure none of the bindings in local_var_alist
2660 remain swapped in, in their symbols. */
2662 swap_out_buffer_local_variables (current_buffer);
2664 /* Actually eliminate all local bindings of this buffer. */
2666 reset_buffer_local_variables (current_buffer, 0);
2668 /* Force mode-line redisplay. Useful here because all major mode
2669 commands call this function. */
2670 update_mode_lines++;
2672 return Qnil;
2675 /* Make sure no local variables remain set up with buffer B
2676 for their current values. */
2678 static void
2679 swap_out_buffer_local_variables (b)
2680 struct buffer *b;
2682 Lisp_Object oalist, alist, sym, buffer;
2684 XSETBUFFER (buffer, b);
2685 oalist = b->local_var_alist;
2687 for (alist = oalist; CONSP (alist); alist = XCDR (alist))
2689 if (CONSP (XCAR (alist))
2690 && (sym = XCAR (XCAR (alist)), SYMBOLP (sym))
2691 /* Need not do anything if some other buffer's binding is
2692 now encached. */
2693 && EQ (XBUFFER_LOCAL_VALUE (SYMBOL_VALUE (sym))->buffer,
2694 buffer))
2696 /* Symbol is set up for this buffer's old local value:
2697 swap it out! */
2698 swap_in_global_binding (sym);
2703 /* Find all the overlays in the current buffer that contain position POS.
2704 Return the number found, and store them in a vector in *VEC_PTR.
2705 Store in *LEN_PTR the size allocated for the vector.
2706 Store in *NEXT_PTR the next position after POS where an overlay starts,
2707 or ZV if there are no more overlays between POS and ZV.
2708 Store in *PREV_PTR the previous position before POS where an overlay ends,
2709 or where an overlay starts which ends at or after POS;
2710 or BEGV if there are no such overlays from BEGV to POS.
2711 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
2713 *VEC_PTR and *LEN_PTR should contain a valid vector and size
2714 when this function is called.
2716 If EXTEND is non-zero, we make the vector bigger if necessary.
2717 If EXTEND is zero, we never extend the vector,
2718 and we store only as many overlays as will fit.
2719 But we still return the total number of overlays.
2721 If CHANGE_REQ is true, then any position written into *PREV_PTR or
2722 *NEXT_PTR is guaranteed to be not equal to POS, unless it is the
2723 default (BEGV or ZV). */
2726 overlays_at (pos, extend, vec_ptr, len_ptr, next_ptr, prev_ptr, change_req)
2727 EMACS_INT pos;
2728 int extend;
2729 Lisp_Object **vec_ptr;
2730 int *len_ptr;
2731 EMACS_INT *next_ptr;
2732 EMACS_INT *prev_ptr;
2733 int change_req;
2735 Lisp_Object overlay, start, end;
2736 struct Lisp_Overlay *tail;
2737 int idx = 0;
2738 int len = *len_ptr;
2739 Lisp_Object *vec = *vec_ptr;
2740 int next = ZV;
2741 int prev = BEGV;
2742 int inhibit_storing = 0;
2744 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
2746 int startpos, endpos;
2748 XSETMISC (overlay, tail);
2750 start = OVERLAY_START (overlay);
2751 end = OVERLAY_END (overlay);
2752 endpos = OVERLAY_POSITION (end);
2753 if (endpos < pos)
2755 if (prev < endpos)
2756 prev = endpos;
2757 break;
2759 startpos = OVERLAY_POSITION (start);
2760 /* This one ends at or after POS
2761 so its start counts for PREV_PTR if it's before POS. */
2762 if (prev < startpos && startpos < pos)
2763 prev = startpos;
2764 if (endpos == pos)
2765 continue;
2766 if (startpos <= pos)
2768 if (idx == len)
2770 /* The supplied vector is full.
2771 Either make it bigger, or don't store any more in it. */
2772 if (extend)
2774 /* Make it work with an initial len == 0. */
2775 len *= 2;
2776 if (len == 0)
2777 len = 4;
2778 *len_ptr = len;
2779 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2780 *vec_ptr = vec;
2782 else
2783 inhibit_storing = 1;
2786 if (!inhibit_storing)
2787 vec[idx] = overlay;
2788 /* Keep counting overlays even if we can't return them all. */
2789 idx++;
2791 else if (startpos < next)
2792 next = startpos;
2795 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
2797 int startpos, endpos;
2799 XSETMISC (overlay, tail);
2801 start = OVERLAY_START (overlay);
2802 end = OVERLAY_END (overlay);
2803 startpos = OVERLAY_POSITION (start);
2804 if (pos < startpos)
2806 if (startpos < next)
2807 next = startpos;
2808 break;
2810 endpos = OVERLAY_POSITION (end);
2811 if (pos < endpos)
2813 if (idx == len)
2815 if (extend)
2817 /* Make it work with an initial len == 0. */
2818 len *= 2;
2819 if (len == 0)
2820 len = 4;
2821 *len_ptr = len;
2822 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2823 *vec_ptr = vec;
2825 else
2826 inhibit_storing = 1;
2829 if (!inhibit_storing)
2830 vec[idx] = overlay;
2831 idx++;
2833 if (startpos < pos && startpos > prev)
2834 prev = startpos;
2836 else if (endpos < pos && endpos > prev)
2837 prev = endpos;
2838 else if (endpos == pos && startpos > prev
2839 && (!change_req || startpos < pos))
2840 prev = startpos;
2843 if (next_ptr)
2844 *next_ptr = next;
2845 if (prev_ptr)
2846 *prev_ptr = prev;
2847 return idx;
2850 /* Find all the overlays in the current buffer that overlap the range
2851 BEG-END, or are empty at BEG, or are empty at END provided END
2852 denotes the position at the end of the current buffer.
2854 Return the number found, and store them in a vector in *VEC_PTR.
2855 Store in *LEN_PTR the size allocated for the vector.
2856 Store in *NEXT_PTR the next position after POS where an overlay starts,
2857 or ZV if there are no more overlays.
2858 Store in *PREV_PTR the previous position before POS where an overlay ends,
2859 or BEGV if there are no previous overlays.
2860 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
2862 *VEC_PTR and *LEN_PTR should contain a valid vector and size
2863 when this function is called.
2865 If EXTEND is non-zero, we make the vector bigger if necessary.
2866 If EXTEND is zero, we never extend the vector,
2867 and we store only as many overlays as will fit.
2868 But we still return the total number of overlays. */
2870 static int
2871 overlays_in (beg, end, extend, vec_ptr, len_ptr, next_ptr, prev_ptr)
2872 int beg, end;
2873 int extend;
2874 Lisp_Object **vec_ptr;
2875 int *len_ptr;
2876 int *next_ptr;
2877 int *prev_ptr;
2879 Lisp_Object overlay, ostart, oend;
2880 struct Lisp_Overlay *tail;
2881 int idx = 0;
2882 int len = *len_ptr;
2883 Lisp_Object *vec = *vec_ptr;
2884 int next = ZV;
2885 int prev = BEGV;
2886 int inhibit_storing = 0;
2887 int end_is_Z = end == Z;
2889 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
2891 int startpos, endpos;
2893 XSETMISC (overlay, tail);
2895 ostart = OVERLAY_START (overlay);
2896 oend = OVERLAY_END (overlay);
2897 endpos = OVERLAY_POSITION (oend);
2898 if (endpos < beg)
2900 if (prev < endpos)
2901 prev = endpos;
2902 break;
2904 startpos = OVERLAY_POSITION (ostart);
2905 /* Count an interval if it overlaps the range, is empty at the
2906 start of the range, or is empty at END provided END denotes the
2907 end of the buffer. */
2908 if ((beg < endpos && startpos < end)
2909 || (startpos == endpos
2910 && (beg == endpos || (end_is_Z && endpos == end))))
2912 if (idx == len)
2914 /* The supplied vector is full.
2915 Either make it bigger, or don't store any more in it. */
2916 if (extend)
2918 /* Make it work with an initial len == 0. */
2919 len *= 2;
2920 if (len == 0)
2921 len = 4;
2922 *len_ptr = len;
2923 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2924 *vec_ptr = vec;
2926 else
2927 inhibit_storing = 1;
2930 if (!inhibit_storing)
2931 vec[idx] = overlay;
2932 /* Keep counting overlays even if we can't return them all. */
2933 idx++;
2935 else if (startpos < next)
2936 next = startpos;
2939 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
2941 int startpos, endpos;
2943 XSETMISC (overlay, tail);
2945 ostart = OVERLAY_START (overlay);
2946 oend = OVERLAY_END (overlay);
2947 startpos = OVERLAY_POSITION (ostart);
2948 if (end < startpos)
2950 if (startpos < next)
2951 next = startpos;
2952 break;
2954 endpos = OVERLAY_POSITION (oend);
2955 /* Count an interval if it overlaps the range, is empty at the
2956 start of the range, or is empty at END provided END denotes the
2957 end of the buffer. */
2958 if ((beg < endpos && startpos < end)
2959 || (startpos == endpos
2960 && (beg == endpos || (end_is_Z && endpos == end))))
2962 if (idx == len)
2964 if (extend)
2966 /* Make it work with an initial len == 0. */
2967 len *= 2;
2968 if (len == 0)
2969 len = 4;
2970 *len_ptr = len;
2971 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2972 *vec_ptr = vec;
2974 else
2975 inhibit_storing = 1;
2978 if (!inhibit_storing)
2979 vec[idx] = overlay;
2980 idx++;
2982 else if (endpos < beg && endpos > prev)
2983 prev = endpos;
2986 if (next_ptr)
2987 *next_ptr = next;
2988 if (prev_ptr)
2989 *prev_ptr = prev;
2990 return idx;
2994 /* Return non-zero if there exists an overlay with a non-nil
2995 `mouse-face' property overlapping OVERLAY. */
2998 mouse_face_overlay_overlaps (overlay)
2999 Lisp_Object overlay;
3001 int start = OVERLAY_POSITION (OVERLAY_START (overlay));
3002 int end = OVERLAY_POSITION (OVERLAY_END (overlay));
3003 int n, i, size;
3004 Lisp_Object *v, tem;
3006 size = 10;
3007 v = (Lisp_Object *) alloca (size * sizeof *v);
3008 n = overlays_in (start, end, 0, &v, &size, NULL, NULL);
3009 if (n > size)
3011 v = (Lisp_Object *) alloca (n * sizeof *v);
3012 overlays_in (start, end, 0, &v, &n, NULL, NULL);
3015 for (i = 0; i < n; ++i)
3016 if (!EQ (v[i], overlay)
3017 && (tem = Foverlay_get (overlay, Qmouse_face),
3018 !NILP (tem)))
3019 break;
3021 return i < n;
3026 /* Fast function to just test if we're at an overlay boundary. */
3028 overlay_touches_p (pos)
3029 int pos;
3031 Lisp_Object overlay;
3032 struct Lisp_Overlay *tail;
3034 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
3036 int endpos;
3038 XSETMISC (overlay ,tail);
3039 if (!OVERLAYP (overlay))
3040 abort ();
3042 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3043 if (endpos < pos)
3044 break;
3045 if (endpos == pos || OVERLAY_POSITION (OVERLAY_START (overlay)) == pos)
3046 return 1;
3049 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
3051 int startpos;
3053 XSETMISC (overlay, tail);
3054 if (!OVERLAYP (overlay))
3055 abort ();
3057 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3058 if (pos < startpos)
3059 break;
3060 if (startpos == pos || OVERLAY_POSITION (OVERLAY_END (overlay)) == pos)
3061 return 1;
3063 return 0;
3066 struct sortvec
3068 Lisp_Object overlay;
3069 int beg, end;
3070 int priority;
3073 static int
3074 compare_overlays (v1, v2)
3075 const void *v1, *v2;
3077 const struct sortvec *s1 = (const struct sortvec *) v1;
3078 const struct sortvec *s2 = (const struct sortvec *) v2;
3079 if (s1->priority != s2->priority)
3080 return s1->priority - s2->priority;
3081 if (s1->beg != s2->beg)
3082 return s1->beg - s2->beg;
3083 if (s1->end != s2->end)
3084 return s2->end - s1->end;
3085 return 0;
3088 /* Sort an array of overlays by priority. The array is modified in place.
3089 The return value is the new size; this may be smaller than the original
3090 size if some of the overlays were invalid or were window-specific. */
3092 sort_overlays (overlay_vec, noverlays, w)
3093 Lisp_Object *overlay_vec;
3094 int noverlays;
3095 struct window *w;
3097 int i, j;
3098 struct sortvec *sortvec;
3099 sortvec = (struct sortvec *) alloca (noverlays * sizeof (struct sortvec));
3101 /* Put the valid and relevant overlays into sortvec. */
3103 for (i = 0, j = 0; i < noverlays; i++)
3105 Lisp_Object tem;
3106 Lisp_Object overlay;
3108 overlay = overlay_vec[i];
3109 if (OVERLAY_VALID (overlay)
3110 && OVERLAY_POSITION (OVERLAY_START (overlay)) > 0
3111 && OVERLAY_POSITION (OVERLAY_END (overlay)) > 0)
3113 /* If we're interested in a specific window, then ignore
3114 overlays that are limited to some other window. */
3115 if (w)
3117 Lisp_Object window;
3119 window = Foverlay_get (overlay, Qwindow);
3120 if (WINDOWP (window) && XWINDOW (window) != w)
3121 continue;
3124 /* This overlay is good and counts: put it into sortvec. */
3125 sortvec[j].overlay = overlay;
3126 sortvec[j].beg = OVERLAY_POSITION (OVERLAY_START (overlay));
3127 sortvec[j].end = OVERLAY_POSITION (OVERLAY_END (overlay));
3128 tem = Foverlay_get (overlay, Qpriority);
3129 if (INTEGERP (tem))
3130 sortvec[j].priority = XINT (tem);
3131 else
3132 sortvec[j].priority = 0;
3133 j++;
3136 noverlays = j;
3138 /* Sort the overlays into the proper order: increasing priority. */
3140 if (noverlays > 1)
3141 qsort (sortvec, noverlays, sizeof (struct sortvec), compare_overlays);
3143 for (i = 0; i < noverlays; i++)
3144 overlay_vec[i] = sortvec[i].overlay;
3145 return (noverlays);
3148 struct sortstr
3150 Lisp_Object string, string2;
3151 int size;
3152 int priority;
3155 struct sortstrlist
3157 struct sortstr *buf; /* An array that expands as needed; never freed. */
3158 int size; /* Allocated length of that array. */
3159 int used; /* How much of the array is currently in use. */
3160 int bytes; /* Total length of the strings in buf. */
3163 /* Buffers for storing information about the overlays touching a given
3164 position. These could be automatic variables in overlay_strings, but
3165 it's more efficient to hold onto the memory instead of repeatedly
3166 allocating and freeing it. */
3167 static struct sortstrlist overlay_heads, overlay_tails;
3168 static unsigned char *overlay_str_buf;
3170 /* Allocated length of overlay_str_buf. */
3171 static int overlay_str_len;
3173 /* A comparison function suitable for passing to qsort. */
3174 static int
3175 cmp_for_strings (as1, as2)
3176 char *as1, *as2;
3178 struct sortstr *s1 = (struct sortstr *)as1;
3179 struct sortstr *s2 = (struct sortstr *)as2;
3180 if (s1->size != s2->size)
3181 return s2->size - s1->size;
3182 if (s1->priority != s2->priority)
3183 return s1->priority - s2->priority;
3184 return 0;
3187 static void
3188 record_overlay_string (ssl, str, str2, pri, size)
3189 struct sortstrlist *ssl;
3190 Lisp_Object str, str2, pri;
3191 int size;
3193 int nbytes;
3195 if (ssl->used == ssl->size)
3197 if (ssl->buf)
3198 ssl->size *= 2;
3199 else
3200 ssl->size = 5;
3201 ssl->buf = ((struct sortstr *)
3202 xrealloc (ssl->buf, ssl->size * sizeof (struct sortstr)));
3204 ssl->buf[ssl->used].string = str;
3205 ssl->buf[ssl->used].string2 = str2;
3206 ssl->buf[ssl->used].size = size;
3207 ssl->buf[ssl->used].priority = (INTEGERP (pri) ? XINT (pri) : 0);
3208 ssl->used++;
3210 if (NILP (current_buffer->enable_multibyte_characters))
3211 nbytes = SCHARS (str);
3212 else if (! STRING_MULTIBYTE (str))
3213 nbytes = count_size_as_multibyte (SDATA (str),
3214 SBYTES (str));
3215 else
3216 nbytes = SBYTES (str);
3218 ssl->bytes += nbytes;
3220 if (STRINGP (str2))
3222 if (NILP (current_buffer->enable_multibyte_characters))
3223 nbytes = SCHARS (str2);
3224 else if (! STRING_MULTIBYTE (str2))
3225 nbytes = count_size_as_multibyte (SDATA (str2),
3226 SBYTES (str2));
3227 else
3228 nbytes = SBYTES (str2);
3230 ssl->bytes += nbytes;
3234 /* Return the concatenation of the strings associated with overlays that
3235 begin or end at POS, ignoring overlays that are specific to a window
3236 other than W. The strings are concatenated in the appropriate order:
3237 shorter overlays nest inside longer ones, and higher priority inside
3238 lower. Normally all of the after-strings come first, but zero-sized
3239 overlays have their after-strings ride along with the before-strings
3240 because it would look strange to print them inside-out.
3242 Returns the string length, and stores the contents indirectly through
3243 PSTR, if that variable is non-null. The string may be overwritten by
3244 subsequent calls. */
3247 overlay_strings (pos, w, pstr)
3248 EMACS_INT pos;
3249 struct window *w;
3250 unsigned char **pstr;
3252 Lisp_Object overlay, window, str;
3253 struct Lisp_Overlay *ov;
3254 int startpos, endpos;
3255 int multibyte = ! NILP (current_buffer->enable_multibyte_characters);
3257 overlay_heads.used = overlay_heads.bytes = 0;
3258 overlay_tails.used = overlay_tails.bytes = 0;
3259 for (ov = current_buffer->overlays_before; ov; ov = ov->next)
3261 XSETMISC (overlay, ov);
3262 eassert (OVERLAYP (overlay));
3264 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3265 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3266 if (endpos < pos)
3267 break;
3268 if (endpos != pos && startpos != pos)
3269 continue;
3270 window = Foverlay_get (overlay, Qwindow);
3271 if (WINDOWP (window) && XWINDOW (window) != w)
3272 continue;
3273 if (startpos == pos
3274 && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
3275 record_overlay_string (&overlay_heads, str,
3276 (startpos == endpos
3277 ? Foverlay_get (overlay, Qafter_string)
3278 : Qnil),
3279 Foverlay_get (overlay, Qpriority),
3280 endpos - startpos);
3281 else if (endpos == pos
3282 && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
3283 record_overlay_string (&overlay_tails, str, Qnil,
3284 Foverlay_get (overlay, Qpriority),
3285 endpos - startpos);
3287 for (ov = current_buffer->overlays_after; ov; ov = ov->next)
3289 XSETMISC (overlay, ov);
3290 eassert (OVERLAYP (overlay));
3292 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3293 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3294 if (startpos > pos)
3295 break;
3296 if (endpos != pos && startpos != pos)
3297 continue;
3298 window = Foverlay_get (overlay, Qwindow);
3299 if (WINDOWP (window) && XWINDOW (window) != w)
3300 continue;
3301 if (startpos == pos
3302 && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
3303 record_overlay_string (&overlay_heads, str,
3304 (startpos == endpos
3305 ? Foverlay_get (overlay, Qafter_string)
3306 : Qnil),
3307 Foverlay_get (overlay, Qpriority),
3308 endpos - startpos);
3309 else if (endpos == pos
3310 && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
3311 record_overlay_string (&overlay_tails, str, Qnil,
3312 Foverlay_get (overlay, Qpriority),
3313 endpos - startpos);
3315 if (overlay_tails.used > 1)
3316 qsort (overlay_tails.buf, overlay_tails.used, sizeof (struct sortstr),
3317 cmp_for_strings);
3318 if (overlay_heads.used > 1)
3319 qsort (overlay_heads.buf, overlay_heads.used, sizeof (struct sortstr),
3320 cmp_for_strings);
3321 if (overlay_heads.bytes || overlay_tails.bytes)
3323 Lisp_Object tem;
3324 int i;
3325 unsigned char *p;
3326 int total = overlay_heads.bytes + overlay_tails.bytes;
3328 if (total > overlay_str_len)
3330 overlay_str_len = total;
3331 overlay_str_buf = (unsigned char *)xrealloc (overlay_str_buf,
3332 total);
3334 p = overlay_str_buf;
3335 for (i = overlay_tails.used; --i >= 0;)
3337 int nbytes;
3338 tem = overlay_tails.buf[i].string;
3339 nbytes = copy_text (SDATA (tem), p,
3340 SBYTES (tem),
3341 STRING_MULTIBYTE (tem), multibyte);
3342 p += nbytes;
3344 for (i = 0; i < overlay_heads.used; ++i)
3346 int nbytes;
3347 tem = overlay_heads.buf[i].string;
3348 nbytes = copy_text (SDATA (tem), p,
3349 SBYTES (tem),
3350 STRING_MULTIBYTE (tem), multibyte);
3351 p += nbytes;
3352 tem = overlay_heads.buf[i].string2;
3353 if (STRINGP (tem))
3355 nbytes = copy_text (SDATA (tem), p,
3356 SBYTES (tem),
3357 STRING_MULTIBYTE (tem), multibyte);
3358 p += nbytes;
3361 if (p != overlay_str_buf + total)
3362 abort ();
3363 if (pstr)
3364 *pstr = overlay_str_buf;
3365 return total;
3367 return 0;
3370 /* Shift overlays in BUF's overlay lists, to center the lists at POS. */
3372 void
3373 recenter_overlay_lists (buf, pos)
3374 struct buffer *buf;
3375 EMACS_INT pos;
3377 Lisp_Object overlay, beg, end;
3378 struct Lisp_Overlay *prev, *tail, *next;
3380 /* See if anything in overlays_before should move to overlays_after. */
3382 /* We don't strictly need prev in this loop; it should always be nil.
3383 But we use it for symmetry and in case that should cease to be true
3384 with some future change. */
3385 prev = NULL;
3386 for (tail = buf->overlays_before; tail; prev = tail, tail = next)
3388 next = tail->next;
3389 XSETMISC (overlay, tail);
3391 /* If the overlay is not valid, get rid of it. */
3392 if (!OVERLAY_VALID (overlay))
3393 #if 1
3394 abort ();
3395 #else
3397 /* Splice the cons cell TAIL out of overlays_before. */
3398 if (!NILP (prev))
3399 XCDR (prev) = next;
3400 else
3401 buf->overlays_before = next;
3402 tail = prev;
3403 continue;
3405 #endif
3407 beg = OVERLAY_START (overlay);
3408 end = OVERLAY_END (overlay);
3410 if (OVERLAY_POSITION (end) > pos)
3412 /* OVERLAY needs to be moved. */
3413 int where = OVERLAY_POSITION (beg);
3414 struct Lisp_Overlay *other, *other_prev;
3416 /* Splice the cons cell TAIL out of overlays_before. */
3417 if (prev)
3418 prev->next = next;
3419 else
3420 buf->overlays_before = next;
3422 /* Search thru overlays_after for where to put it. */
3423 other_prev = NULL;
3424 for (other = buf->overlays_after; other;
3425 other_prev = other, other = other->next)
3427 Lisp_Object otherbeg, otheroverlay;
3429 XSETMISC (otheroverlay, other);
3430 eassert (OVERLAY_VALID (otheroverlay));
3432 otherbeg = OVERLAY_START (otheroverlay);
3433 if (OVERLAY_POSITION (otherbeg) >= where)
3434 break;
3437 /* Add TAIL to overlays_after before OTHER. */
3438 tail->next = other;
3439 if (other_prev)
3440 other_prev->next = tail;
3441 else
3442 buf->overlays_after = tail;
3443 tail = prev;
3445 else
3446 /* We've reached the things that should stay in overlays_before.
3447 All the rest of overlays_before must end even earlier,
3448 so stop now. */
3449 break;
3452 /* See if anything in overlays_after should be in overlays_before. */
3453 prev = NULL;
3454 for (tail = buf->overlays_after; tail; prev = tail, tail = next)
3456 next = tail->next;
3457 XSETMISC (overlay, tail);
3459 /* If the overlay is not valid, get rid of it. */
3460 if (!OVERLAY_VALID (overlay))
3461 #if 1
3462 abort ();
3463 #else
3465 /* Splice the cons cell TAIL out of overlays_after. */
3466 if (!NILP (prev))
3467 XCDR (prev) = next;
3468 else
3469 buf->overlays_after = next;
3470 tail = prev;
3471 continue;
3473 #endif
3475 beg = OVERLAY_START (overlay);
3476 end = OVERLAY_END (overlay);
3478 /* Stop looking, when we know that nothing further
3479 can possibly end before POS. */
3480 if (OVERLAY_POSITION (beg) > pos)
3481 break;
3483 if (OVERLAY_POSITION (end) <= pos)
3485 /* OVERLAY needs to be moved. */
3486 int where = OVERLAY_POSITION (end);
3487 struct Lisp_Overlay *other, *other_prev;
3489 /* Splice the cons cell TAIL out of overlays_after. */
3490 if (prev)
3491 prev->next = next;
3492 else
3493 buf->overlays_after = next;
3495 /* Search thru overlays_before for where to put it. */
3496 other_prev = NULL;
3497 for (other = buf->overlays_before; other;
3498 other_prev = other, other = other->next)
3500 Lisp_Object otherend, otheroverlay;
3502 XSETMISC (otheroverlay, other);
3503 eassert (OVERLAY_VALID (otheroverlay));
3505 otherend = OVERLAY_END (otheroverlay);
3506 if (OVERLAY_POSITION (otherend) <= where)
3507 break;
3510 /* Add TAIL to overlays_before before OTHER. */
3511 tail->next = other;
3512 if (other_prev)
3513 other_prev->next = tail;
3514 else
3515 buf->overlays_before = tail;
3516 tail = prev;
3520 buf->overlay_center = pos;
3523 void
3524 adjust_overlays_for_insert (pos, length)
3525 EMACS_INT pos;
3526 EMACS_INT length;
3528 /* After an insertion, the lists are still sorted properly,
3529 but we may need to update the value of the overlay center. */
3530 if (current_buffer->overlay_center >= pos)
3531 current_buffer->overlay_center += length;
3534 void
3535 adjust_overlays_for_delete (pos, length)
3536 EMACS_INT pos;
3537 EMACS_INT length;
3539 if (current_buffer->overlay_center < pos)
3540 /* The deletion was to our right. No change needed; the before- and
3541 after-lists are still consistent. */
3543 else if (current_buffer->overlay_center > pos + length)
3544 /* The deletion was to our left. We need to adjust the center value
3545 to account for the change in position, but the lists are consistent
3546 given the new value. */
3547 current_buffer->overlay_center -= length;
3548 else
3549 /* We're right in the middle. There might be things on the after-list
3550 that now belong on the before-list. Recentering will move them,
3551 and also update the center point. */
3552 recenter_overlay_lists (current_buffer, pos);
3555 /* Fix up overlays that were garbled as a result of permuting markers
3556 in the range START through END. Any overlay with at least one
3557 endpoint in this range will need to be unlinked from the overlay
3558 list and reinserted in its proper place.
3559 Such an overlay might even have negative size at this point.
3560 If so, we'll make the overlay empty. */
3561 void
3562 fix_start_end_in_overlays (start, end)
3563 register int start, end;
3565 Lisp_Object overlay;
3566 struct Lisp_Overlay *before_list, *after_list;
3567 /* These are either nil, indicating that before_list or after_list
3568 should be assigned, or the cons cell the cdr of which should be
3569 assigned. */
3570 struct Lisp_Overlay *beforep = NULL, *afterp = NULL;
3571 /* 'Parent', likewise, indicates a cons cell or
3572 current_buffer->overlays_before or overlays_after, depending
3573 which loop we're in. */
3574 struct Lisp_Overlay *tail, *parent;
3575 int startpos, endpos;
3577 /* This algorithm shifts links around instead of consing and GCing.
3578 The loop invariant is that before_list (resp. after_list) is a
3579 well-formed list except that its last element, the CDR of beforep
3580 (resp. afterp) if beforep (afterp) isn't nil or before_list
3581 (after_list) if it is, is still uninitialized. So it's not a bug
3582 that before_list isn't initialized, although it may look
3583 strange. */
3584 for (parent = NULL, tail = current_buffer->overlays_before; tail;)
3586 XSETMISC (overlay, tail);
3588 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3589 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3591 /* If the overlay is backwards, make it empty. */
3592 if (endpos < startpos)
3594 startpos = endpos;
3595 Fset_marker (OVERLAY_START (overlay), make_number (startpos),
3596 Qnil);
3599 if (endpos < start)
3600 break;
3602 if (endpos < end
3603 || (startpos >= start && startpos < end))
3605 /* Add it to the end of the wrong list. Later on,
3606 recenter_overlay_lists will move it to the right place. */
3607 if (endpos < current_buffer->overlay_center)
3609 if (!afterp)
3610 after_list = tail;
3611 else
3612 afterp->next = tail;
3613 afterp = tail;
3615 else
3617 if (!beforep)
3618 before_list = tail;
3619 else
3620 beforep->next = tail;
3621 beforep = tail;
3623 if (!parent)
3624 current_buffer->overlays_before = tail->next;
3625 else
3626 parent->next = tail->next;
3627 tail = tail->next;
3629 else
3630 parent = tail, tail = parent->next;
3632 for (parent = NULL, tail = current_buffer->overlays_after; tail;)
3634 XSETMISC (overlay, tail);
3636 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3637 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3639 /* If the overlay is backwards, make it empty. */
3640 if (endpos < startpos)
3642 startpos = endpos;
3643 Fset_marker (OVERLAY_START (overlay), make_number (startpos),
3644 Qnil);
3647 if (startpos >= end)
3648 break;
3650 if (startpos >= start
3651 || (endpos >= start && endpos < end))
3653 if (endpos < current_buffer->overlay_center)
3655 if (!afterp)
3656 after_list = tail;
3657 else
3658 afterp->next = tail;
3659 afterp = tail;
3661 else
3663 if (!beforep)
3664 before_list = tail;
3665 else
3666 beforep->next = tail;
3667 beforep = tail;
3669 if (!parent)
3670 current_buffer->overlays_after = tail->next;
3671 else
3672 parent->next = tail->next;
3673 tail = tail->next;
3675 else
3676 parent = tail, tail = parent->next;
3679 /* Splice the constructed (wrong) lists into the buffer's lists,
3680 and let the recenter function make it sane again. */
3681 if (beforep)
3683 beforep->next = current_buffer->overlays_before;
3684 current_buffer->overlays_before = before_list;
3686 recenter_overlay_lists (current_buffer, current_buffer->overlay_center);
3688 if (afterp)
3690 afterp->next = current_buffer->overlays_after;
3691 current_buffer->overlays_after = after_list;
3693 recenter_overlay_lists (current_buffer, current_buffer->overlay_center);
3696 /* We have two types of overlay: the one whose ending marker is
3697 after-insertion-marker (this is the usual case) and the one whose
3698 ending marker is before-insertion-marker. When `overlays_before'
3699 contains overlays of the latter type and the former type in this
3700 order and both overlays end at inserting position, inserting a text
3701 increases only the ending marker of the latter type, which results
3702 in incorrect ordering of `overlays_before'.
3704 This function fixes ordering of overlays in the slot
3705 `overlays_before' of the buffer *BP. Before the insertion, `point'
3706 was at PREV, and now is at POS. */
3708 void
3709 fix_overlays_before (bp, prev, pos)
3710 struct buffer *bp;
3711 EMACS_INT prev, pos;
3713 /* If parent is nil, replace overlays_before; otherwise, parent->next. */
3714 struct Lisp_Overlay *tail = bp->overlays_before, *parent = NULL, *right_pair;
3715 Lisp_Object tem;
3716 EMACS_INT end;
3718 /* After the insertion, the several overlays may be in incorrect
3719 order. The possibility is that, in the list `overlays_before',
3720 an overlay which ends at POS appears after an overlay which ends
3721 at PREV. Since POS is greater than PREV, we must fix the
3722 ordering of these overlays, by moving overlays ends at POS before
3723 the overlays ends at PREV. */
3725 /* At first, find a place where disordered overlays should be linked
3726 in. It is where an overlay which end before POS exists. (i.e. an
3727 overlay whose ending marker is after-insertion-marker if disorder
3728 exists). */
3729 while (tail
3730 && (XSETMISC (tem, tail),
3731 (end = OVERLAY_POSITION (OVERLAY_END (tem))) >= pos))
3733 parent = tail;
3734 tail = tail->next;
3737 /* If we don't find such an overlay,
3738 or the found one ends before PREV,
3739 or the found one is the last one in the list,
3740 we don't have to fix anything. */
3741 if (!tail || end < prev || !tail->next)
3742 return;
3744 right_pair = parent;
3745 parent = tail;
3746 tail = tail->next;
3748 /* Now, end position of overlays in the list TAIL should be before
3749 or equal to PREV. In the loop, an overlay which ends at POS is
3750 moved ahead to the place indicated by the CDR of RIGHT_PAIR. If
3751 we found an overlay which ends before PREV, the remaining
3752 overlays are in correct order. */
3753 while (tail)
3755 XSETMISC (tem, tail);
3756 end = OVERLAY_POSITION (OVERLAY_END (tem));
3758 if (end == pos)
3759 { /* This overlay is disordered. */
3760 struct Lisp_Overlay *found = tail;
3762 /* Unlink the found overlay. */
3763 tail = found->next;
3764 parent->next = tail;
3765 /* Move an overlay at RIGHT_PLACE to the next of the found one,
3766 and link it into the right place. */
3767 if (!right_pair)
3769 found->next = bp->overlays_before;
3770 bp->overlays_before = found;
3772 else
3774 found->next = right_pair->next;
3775 right_pair->next = found;
3778 else if (end == prev)
3780 parent = tail;
3781 tail = tail->next;
3783 else /* No more disordered overlay. */
3784 break;
3788 DEFUN ("overlayp", Foverlayp, Soverlayp, 1, 1, 0,
3789 doc: /* Return t if OBJECT is an overlay. */)
3790 (object)
3791 Lisp_Object object;
3793 return (OVERLAYP (object) ? Qt : Qnil);
3796 DEFUN ("make-overlay", Fmake_overlay, Smake_overlay, 2, 5, 0,
3797 doc: /* Create a new overlay with range BEG to END in BUFFER.
3798 If omitted, BUFFER defaults to the current buffer.
3799 BEG and END may be integers or markers.
3800 The fourth arg FRONT-ADVANCE, if non-nil, makes the marker
3801 for the front of the overlay advance when text is inserted there
3802 \(which means the text *is not* included in the overlay).
3803 The fifth arg REAR-ADVANCE, if non-nil, makes the marker
3804 for the rear of the overlay advance when text is inserted there
3805 \(which means the text *is* included in the overlay). */)
3806 (beg, end, buffer, front_advance, rear_advance)
3807 Lisp_Object beg, end, buffer;
3808 Lisp_Object front_advance, rear_advance;
3810 Lisp_Object overlay;
3811 struct buffer *b;
3813 if (NILP (buffer))
3814 XSETBUFFER (buffer, current_buffer);
3815 else
3816 CHECK_BUFFER (buffer);
3817 if (MARKERP (beg)
3818 && ! EQ (Fmarker_buffer (beg), buffer))
3819 error ("Marker points into wrong buffer");
3820 if (MARKERP (end)
3821 && ! EQ (Fmarker_buffer (end), buffer))
3822 error ("Marker points into wrong buffer");
3824 CHECK_NUMBER_COERCE_MARKER (beg);
3825 CHECK_NUMBER_COERCE_MARKER (end);
3827 if (XINT (beg) > XINT (end))
3829 Lisp_Object temp;
3830 temp = beg; beg = end; end = temp;
3833 b = XBUFFER (buffer);
3835 beg = Fset_marker (Fmake_marker (), beg, buffer);
3836 end = Fset_marker (Fmake_marker (), end, buffer);
3838 if (!NILP (front_advance))
3839 XMARKER (beg)->insertion_type = 1;
3840 if (!NILP (rear_advance))
3841 XMARKER (end)->insertion_type = 1;
3843 overlay = allocate_misc ();
3844 XMISCTYPE (overlay) = Lisp_Misc_Overlay;
3845 XOVERLAY (overlay)->start = beg;
3846 XOVERLAY (overlay)->end = end;
3847 XOVERLAY (overlay)->plist = Qnil;
3848 XOVERLAY (overlay)->next = NULL;
3850 /* Put the new overlay on the wrong list. */
3851 end = OVERLAY_END (overlay);
3852 if (OVERLAY_POSITION (end) < b->overlay_center)
3854 if (b->overlays_after)
3855 XOVERLAY (overlay)->next = b->overlays_after;
3856 b->overlays_after = XOVERLAY (overlay);
3858 else
3860 if (b->overlays_before)
3861 XOVERLAY (overlay)->next = b->overlays_before;
3862 b->overlays_before = XOVERLAY (overlay);
3865 /* This puts it in the right list, and in the right order. */
3866 recenter_overlay_lists (b, b->overlay_center);
3868 /* We don't need to redisplay the region covered by the overlay, because
3869 the overlay has no properties at the moment. */
3871 return overlay;
3874 /* Mark a section of BUF as needing redisplay because of overlays changes. */
3876 static void
3877 modify_overlay (buf, start, end)
3878 struct buffer *buf;
3879 EMACS_INT start, end;
3881 if (start > end)
3883 int temp = start;
3884 start = end;
3885 end = temp;
3888 BUF_COMPUTE_UNCHANGED (buf, start, end);
3890 /* If this is a buffer not in the selected window,
3891 we must do other windows. */
3892 if (buf != XBUFFER (XWINDOW (selected_window)->buffer))
3893 windows_or_buffers_changed = 1;
3894 /* If multiple windows show this buffer, we must do other windows. */
3895 else if (buffer_shared > 1)
3896 windows_or_buffers_changed = 1;
3897 /* If we modify an overlay at the end of the buffer, we cannot
3898 be sure that window end is still valid. */
3899 else if (end >= ZV && start <= ZV)
3900 windows_or_buffers_changed = 1;
3902 ++BUF_OVERLAY_MODIFF (buf);
3906 Lisp_Object Fdelete_overlay ();
3908 static struct Lisp_Overlay *
3909 unchain_overlay (list, overlay)
3910 struct Lisp_Overlay *list, *overlay;
3912 struct Lisp_Overlay *tmp, *prev;
3913 for (tmp = list, prev = NULL; tmp; prev = tmp, tmp = tmp->next)
3914 if (tmp == overlay)
3916 if (prev)
3917 prev->next = tmp->next;
3918 else
3919 list = tmp->next;
3920 overlay->next = NULL;
3921 break;
3923 return list;
3926 DEFUN ("move-overlay", Fmove_overlay, Smove_overlay, 3, 4, 0,
3927 doc: /* Set the endpoints of OVERLAY to BEG and END in BUFFER.
3928 If BUFFER is omitted, leave OVERLAY in the same buffer it inhabits now.
3929 If BUFFER is omitted, and OVERLAY is in no buffer, put it in the current
3930 buffer. */)
3931 (overlay, beg, end, buffer)
3932 Lisp_Object overlay, beg, end, buffer;
3934 struct buffer *b, *ob;
3935 Lisp_Object obuffer;
3936 int count = SPECPDL_INDEX ();
3938 CHECK_OVERLAY (overlay);
3939 if (NILP (buffer))
3940 buffer = Fmarker_buffer (OVERLAY_START (overlay));
3941 if (NILP (buffer))
3942 XSETBUFFER (buffer, current_buffer);
3943 CHECK_BUFFER (buffer);
3945 if (MARKERP (beg)
3946 && ! EQ (Fmarker_buffer (beg), buffer))
3947 error ("Marker points into wrong buffer");
3948 if (MARKERP (end)
3949 && ! EQ (Fmarker_buffer (end), buffer))
3950 error ("Marker points into wrong buffer");
3952 CHECK_NUMBER_COERCE_MARKER (beg);
3953 CHECK_NUMBER_COERCE_MARKER (end);
3955 if (XINT (beg) == XINT (end) && ! NILP (Foverlay_get (overlay, Qevaporate)))
3956 return Fdelete_overlay (overlay);
3958 if (XINT (beg) > XINT (end))
3960 Lisp_Object temp;
3961 temp = beg; beg = end; end = temp;
3964 specbind (Qinhibit_quit, Qt);
3966 obuffer = Fmarker_buffer (OVERLAY_START (overlay));
3967 b = XBUFFER (buffer);
3968 ob = BUFFERP (obuffer) ? XBUFFER (obuffer) : (struct buffer *) 0;
3970 /* If the overlay has changed buffers, do a thorough redisplay. */
3971 if (!EQ (buffer, obuffer))
3973 /* Redisplay where the overlay was. */
3974 if (!NILP (obuffer))
3976 int o_beg;
3977 int o_end;
3979 o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
3980 o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
3982 modify_overlay (ob, o_beg, o_end);
3985 /* Redisplay where the overlay is going to be. */
3986 modify_overlay (b, XINT (beg), XINT (end));
3988 else
3989 /* Redisplay the area the overlay has just left, or just enclosed. */
3991 int o_beg, o_end;
3993 o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
3994 o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
3996 if (o_beg == XINT (beg))
3997 modify_overlay (b, o_end, XINT (end));
3998 else if (o_end == XINT (end))
3999 modify_overlay (b, o_beg, XINT (beg));
4000 else
4002 if (XINT (beg) < o_beg) o_beg = XINT (beg);
4003 if (XINT (end) > o_end) o_end = XINT (end);
4004 modify_overlay (b, o_beg, o_end);
4008 if (!NILP (obuffer))
4010 ob->overlays_before
4011 = unchain_overlay (ob->overlays_before, XOVERLAY (overlay));
4012 ob->overlays_after
4013 = unchain_overlay (ob->overlays_after, XOVERLAY (overlay));
4014 eassert (XOVERLAY (overlay)->next == NULL);
4017 Fset_marker (OVERLAY_START (overlay), beg, buffer);
4018 Fset_marker (OVERLAY_END (overlay), end, buffer);
4020 /* Put the overlay on the wrong list. */
4021 end = OVERLAY_END (overlay);
4022 if (OVERLAY_POSITION (end) < b->overlay_center)
4024 XOVERLAY (overlay)->next = b->overlays_after;
4025 b->overlays_after = XOVERLAY (overlay);
4027 else
4029 XOVERLAY (overlay)->next = b->overlays_before;
4030 b->overlays_before = XOVERLAY (overlay);
4033 /* This puts it in the right list, and in the right order. */
4034 recenter_overlay_lists (b, b->overlay_center);
4036 return unbind_to (count, overlay);
4039 DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0,
4040 doc: /* Delete the overlay OVERLAY from its buffer. */)
4041 (overlay)
4042 Lisp_Object overlay;
4044 Lisp_Object buffer;
4045 struct buffer *b;
4046 int count = SPECPDL_INDEX ();
4048 CHECK_OVERLAY (overlay);
4050 buffer = Fmarker_buffer (OVERLAY_START (overlay));
4051 if (NILP (buffer))
4052 return Qnil;
4054 b = XBUFFER (buffer);
4055 specbind (Qinhibit_quit, Qt);
4057 b->overlays_before = unchain_overlay (b->overlays_before,XOVERLAY (overlay));
4058 b->overlays_after = unchain_overlay (b->overlays_after, XOVERLAY (overlay));
4059 eassert (XOVERLAY (overlay)->next == NULL);
4060 modify_overlay (b,
4061 marker_position (OVERLAY_START (overlay)),
4062 marker_position (OVERLAY_END (overlay)));
4063 Fset_marker (OVERLAY_START (overlay), Qnil, Qnil);
4064 Fset_marker (OVERLAY_END (overlay), Qnil, Qnil);
4066 /* When deleting an overlay with before or after strings, turn off
4067 display optimizations for the affected buffer, on the basis that
4068 these strings may contain newlines. This is easier to do than to
4069 check for that situation during redisplay. */
4070 if (!windows_or_buffers_changed
4071 && (!NILP (Foverlay_get (overlay, Qbefore_string))
4072 || !NILP (Foverlay_get (overlay, Qafter_string))))
4073 b->prevent_redisplay_optimizations_p = 1;
4075 return unbind_to (count, Qnil);
4078 /* Overlay dissection functions. */
4080 DEFUN ("overlay-start", Foverlay_start, Soverlay_start, 1, 1, 0,
4081 doc: /* Return the position at which OVERLAY starts. */)
4082 (overlay)
4083 Lisp_Object overlay;
4085 CHECK_OVERLAY (overlay);
4087 return (Fmarker_position (OVERLAY_START (overlay)));
4090 DEFUN ("overlay-end", Foverlay_end, Soverlay_end, 1, 1, 0,
4091 doc: /* Return the position at which OVERLAY ends. */)
4092 (overlay)
4093 Lisp_Object overlay;
4095 CHECK_OVERLAY (overlay);
4097 return (Fmarker_position (OVERLAY_END (overlay)));
4100 DEFUN ("overlay-buffer", Foverlay_buffer, Soverlay_buffer, 1, 1, 0,
4101 doc: /* Return the buffer OVERLAY belongs to.
4102 Return nil if OVERLAY has been deleted. */)
4103 (overlay)
4104 Lisp_Object overlay;
4106 CHECK_OVERLAY (overlay);
4108 return Fmarker_buffer (OVERLAY_START (overlay));
4111 DEFUN ("overlay-properties", Foverlay_properties, Soverlay_properties, 1, 1, 0,
4112 doc: /* Return a list of the properties on OVERLAY.
4113 This is a copy of OVERLAY's plist; modifying its conses has no effect on
4114 OVERLAY. */)
4115 (overlay)
4116 Lisp_Object overlay;
4118 CHECK_OVERLAY (overlay);
4120 return Fcopy_sequence (XOVERLAY (overlay)->plist);
4124 DEFUN ("overlays-at", Foverlays_at, Soverlays_at, 1, 1, 0,
4125 doc: /* Return a list of the overlays that contain the character at POS. */)
4126 (pos)
4127 Lisp_Object pos;
4129 int noverlays;
4130 Lisp_Object *overlay_vec;
4131 int len;
4132 Lisp_Object result;
4134 CHECK_NUMBER_COERCE_MARKER (pos);
4136 len = 10;
4137 /* We can't use alloca here because overlays_at can call xrealloc. */
4138 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
4140 /* Put all the overlays we want in a vector in overlay_vec.
4141 Store the length in len. */
4142 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
4143 (EMACS_INT *) 0, (EMACS_INT *) 0, 0);
4145 /* Make a list of them all. */
4146 result = Flist (noverlays, overlay_vec);
4148 xfree (overlay_vec);
4149 return result;
4152 DEFUN ("overlays-in", Foverlays_in, Soverlays_in, 2, 2, 0,
4153 doc: /* Return a list of the overlays that overlap the region BEG ... END.
4154 Overlap means that at least one character is contained within the overlay
4155 and also contained within the specified region.
4156 Empty overlays are included in the result if they are located at BEG,
4157 between BEG and END, or at END provided END denotes the position at the
4158 end of the buffer. */)
4159 (beg, end)
4160 Lisp_Object beg, end;
4162 int noverlays;
4163 Lisp_Object *overlay_vec;
4164 int len;
4165 Lisp_Object result;
4167 CHECK_NUMBER_COERCE_MARKER (beg);
4168 CHECK_NUMBER_COERCE_MARKER (end);
4170 len = 10;
4171 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
4173 /* Put all the overlays we want in a vector in overlay_vec.
4174 Store the length in len. */
4175 noverlays = overlays_in (XINT (beg), XINT (end), 1, &overlay_vec, &len,
4176 (int *) 0, (int *) 0);
4178 /* Make a list of them all. */
4179 result = Flist (noverlays, overlay_vec);
4181 xfree (overlay_vec);
4182 return result;
4185 DEFUN ("next-overlay-change", Fnext_overlay_change, Snext_overlay_change,
4186 1, 1, 0,
4187 doc: /* Return the next position after POS where an overlay starts or ends.
4188 If there are no overlay boundaries from POS to (point-max),
4189 the value is (point-max). */)
4190 (pos)
4191 Lisp_Object pos;
4193 int noverlays;
4194 EMACS_INT endpos;
4195 Lisp_Object *overlay_vec;
4196 int len;
4197 int i;
4199 CHECK_NUMBER_COERCE_MARKER (pos);
4201 len = 10;
4202 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
4204 /* Put all the overlays we want in a vector in overlay_vec.
4205 Store the length in len.
4206 endpos gets the position where the next overlay starts. */
4207 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
4208 &endpos, (EMACS_INT *) 0, 1);
4210 /* If any of these overlays ends before endpos,
4211 use its ending point instead. */
4212 for (i = 0; i < noverlays; i++)
4214 Lisp_Object oend;
4215 EMACS_INT oendpos;
4217 oend = OVERLAY_END (overlay_vec[i]);
4218 oendpos = OVERLAY_POSITION (oend);
4219 if (oendpos < endpos)
4220 endpos = oendpos;
4223 xfree (overlay_vec);
4224 return make_number (endpos);
4227 DEFUN ("previous-overlay-change", Fprevious_overlay_change,
4228 Sprevious_overlay_change, 1, 1, 0,
4229 doc: /* Return the previous position before POS where an overlay starts or ends.
4230 If there are no overlay boundaries from (point-min) to POS,
4231 the value is (point-min). */)
4232 (pos)
4233 Lisp_Object pos;
4235 int noverlays;
4236 EMACS_INT prevpos;
4237 Lisp_Object *overlay_vec;
4238 int len;
4240 CHECK_NUMBER_COERCE_MARKER (pos);
4242 /* At beginning of buffer, we know the answer;
4243 avoid bug subtracting 1 below. */
4244 if (XINT (pos) == BEGV)
4245 return pos;
4247 len = 10;
4248 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
4250 /* Put all the overlays we want in a vector in overlay_vec.
4251 Store the length in len.
4252 prevpos gets the position of the previous change. */
4253 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
4254 (EMACS_INT *) 0, &prevpos, 1);
4256 xfree (overlay_vec);
4257 return make_number (prevpos);
4260 /* These functions are for debugging overlays. */
4262 DEFUN ("overlay-lists", Foverlay_lists, Soverlay_lists, 0, 0, 0,
4263 doc: /* Return a pair of lists giving all the overlays of the current buffer.
4264 The car has all the overlays before the overlay center;
4265 the cdr has all the overlays after the overlay center.
4266 Recentering overlays moves overlays between these lists.
4267 The lists you get are copies, so that changing them has no effect.
4268 However, the overlays you get are the real objects that the buffer uses. */)
4271 struct Lisp_Overlay *ol;
4272 Lisp_Object before = Qnil, after = Qnil, tmp;
4273 for (ol = current_buffer->overlays_before; ol; ol = ol->next)
4275 XSETMISC (tmp, ol);
4276 before = Fcons (tmp, before);
4278 for (ol = current_buffer->overlays_after; ol; ol = ol->next)
4280 XSETMISC (tmp, ol);
4281 after = Fcons (tmp, after);
4283 return Fcons (Fnreverse (before), Fnreverse (after));
4286 DEFUN ("overlay-recenter", Foverlay_recenter, Soverlay_recenter, 1, 1, 0,
4287 doc: /* Recenter the overlays of the current buffer around position POS.
4288 That makes overlay lookup faster for positions near POS (but perhaps slower
4289 for positions far away from POS). */)
4290 (pos)
4291 Lisp_Object pos;
4293 CHECK_NUMBER_COERCE_MARKER (pos);
4295 recenter_overlay_lists (current_buffer, XINT (pos));
4296 return Qnil;
4299 DEFUN ("overlay-get", Foverlay_get, Soverlay_get, 2, 2, 0,
4300 doc: /* Get the property of overlay OVERLAY with property name PROP. */)
4301 (overlay, prop)
4302 Lisp_Object overlay, prop;
4304 CHECK_OVERLAY (overlay);
4305 return lookup_char_property (XOVERLAY (overlay)->plist, prop, 0);
4308 DEFUN ("overlay-put", Foverlay_put, Soverlay_put, 3, 3, 0,
4309 doc: /* Set one property of overlay OVERLAY: give property PROP value VALUE. */)
4310 (overlay, prop, value)
4311 Lisp_Object overlay, prop, value;
4313 Lisp_Object tail, buffer;
4314 int changed;
4316 CHECK_OVERLAY (overlay);
4318 buffer = Fmarker_buffer (OVERLAY_START (overlay));
4320 for (tail = XOVERLAY (overlay)->plist;
4321 CONSP (tail) && CONSP (XCDR (tail));
4322 tail = XCDR (XCDR (tail)))
4323 if (EQ (XCAR (tail), prop))
4325 changed = !EQ (XCAR (XCDR (tail)), value);
4326 XSETCAR (XCDR (tail), value);
4327 goto found;
4329 /* It wasn't in the list, so add it to the front. */
4330 changed = !NILP (value);
4331 XOVERLAY (overlay)->plist
4332 = Fcons (prop, Fcons (value, XOVERLAY (overlay)->plist));
4333 found:
4334 if (! NILP (buffer))
4336 if (changed)
4337 modify_overlay (XBUFFER (buffer),
4338 marker_position (OVERLAY_START (overlay)),
4339 marker_position (OVERLAY_END (overlay)));
4340 if (EQ (prop, Qevaporate) && ! NILP (value)
4341 && (OVERLAY_POSITION (OVERLAY_START (overlay))
4342 == OVERLAY_POSITION (OVERLAY_END (overlay))))
4343 Fdelete_overlay (overlay);
4346 return value;
4349 /* Subroutine of report_overlay_modification. */
4351 /* Lisp vector holding overlay hook functions to call.
4352 Vector elements come in pairs.
4353 Each even-index element is a list of hook functions.
4354 The following odd-index element is the overlay they came from.
4356 Before the buffer change, we fill in this vector
4357 as we call overlay hook functions.
4358 After the buffer change, we get the functions to call from this vector.
4359 This way we always call the same functions before and after the change. */
4360 static Lisp_Object last_overlay_modification_hooks;
4362 /* Number of elements actually used in last_overlay_modification_hooks. */
4363 static int last_overlay_modification_hooks_used;
4365 /* Add one functionlist/overlay pair
4366 to the end of last_overlay_modification_hooks. */
4368 static void
4369 add_overlay_mod_hooklist (functionlist, overlay)
4370 Lisp_Object functionlist, overlay;
4372 int oldsize = XVECTOR (last_overlay_modification_hooks)->size;
4374 if (last_overlay_modification_hooks_used == oldsize)
4375 last_overlay_modification_hooks = larger_vector
4376 (last_overlay_modification_hooks, oldsize * 2, Qnil);
4377 ASET (last_overlay_modification_hooks, last_overlay_modification_hooks_used,
4378 functionlist); last_overlay_modification_hooks_used++;
4379 ASET (last_overlay_modification_hooks, last_overlay_modification_hooks_used,
4380 overlay); last_overlay_modification_hooks_used++;
4383 /* Run the modification-hooks of overlays that include
4384 any part of the text in START to END.
4385 If this change is an insertion, also
4386 run the insert-before-hooks of overlay starting at END,
4387 and the insert-after-hooks of overlay ending at START.
4389 This is called both before and after the modification.
4390 AFTER is nonzero when we call after the modification.
4392 ARG1, ARG2, ARG3 are arguments to pass to the hook functions.
4393 When AFTER is nonzero, they are the start position,
4394 the position after the inserted new text,
4395 and the length of deleted or replaced old text. */
4397 void
4398 report_overlay_modification (start, end, after, arg1, arg2, arg3)
4399 Lisp_Object start, end;
4400 int after;
4401 Lisp_Object arg1, arg2, arg3;
4403 Lisp_Object prop, overlay;
4404 struct Lisp_Overlay *tail;
4405 /* 1 if this change is an insertion. */
4406 int insertion = (after ? XFASTINT (arg3) == 0 : EQ (start, end));
4407 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4409 overlay = Qnil;
4410 tail = NULL;
4412 /* We used to run the functions as soon as we found them and only register
4413 them in last_overlay_modification_hooks for the purpose of the `after'
4414 case. But running elisp code as we traverse the list of overlays is
4415 painful because the list can be modified by the elisp code so we had to
4416 copy at several places. We now simply do a read-only traversal that
4417 only collects the functions to run and we run them afterwards. It's
4418 simpler, especially since all the code was already there. -stef */
4420 if (!after)
4422 /* We are being called before a change.
4423 Scan the overlays to find the functions to call. */
4424 last_overlay_modification_hooks_used = 0;
4425 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
4427 int startpos, endpos;
4428 Lisp_Object ostart, oend;
4430 XSETMISC (overlay, tail);
4432 ostart = OVERLAY_START (overlay);
4433 oend = OVERLAY_END (overlay);
4434 endpos = OVERLAY_POSITION (oend);
4435 if (XFASTINT (start) > endpos)
4436 break;
4437 startpos = OVERLAY_POSITION (ostart);
4438 if (insertion && (XFASTINT (start) == startpos
4439 || XFASTINT (end) == startpos))
4441 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
4442 if (!NILP (prop))
4443 add_overlay_mod_hooklist (prop, overlay);
4445 if (insertion && (XFASTINT (start) == endpos
4446 || XFASTINT (end) == endpos))
4448 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
4449 if (!NILP (prop))
4450 add_overlay_mod_hooklist (prop, overlay);
4452 /* Test for intersecting intervals. This does the right thing
4453 for both insertion and deletion. */
4454 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
4456 prop = Foverlay_get (overlay, Qmodification_hooks);
4457 if (!NILP (prop))
4458 add_overlay_mod_hooklist (prop, overlay);
4462 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
4464 int startpos, endpos;
4465 Lisp_Object ostart, oend;
4467 XSETMISC (overlay, tail);
4469 ostart = OVERLAY_START (overlay);
4470 oend = OVERLAY_END (overlay);
4471 startpos = OVERLAY_POSITION (ostart);
4472 endpos = OVERLAY_POSITION (oend);
4473 if (XFASTINT (end) < startpos)
4474 break;
4475 if (insertion && (XFASTINT (start) == startpos
4476 || XFASTINT (end) == startpos))
4478 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
4479 if (!NILP (prop))
4480 add_overlay_mod_hooklist (prop, overlay);
4482 if (insertion && (XFASTINT (start) == endpos
4483 || XFASTINT (end) == endpos))
4485 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
4486 if (!NILP (prop))
4487 add_overlay_mod_hooklist (prop, overlay);
4489 /* Test for intersecting intervals. This does the right thing
4490 for both insertion and deletion. */
4491 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
4493 prop = Foverlay_get (overlay, Qmodification_hooks);
4494 if (!NILP (prop))
4495 add_overlay_mod_hooklist (prop, overlay);
4500 GCPRO4 (overlay, arg1, arg2, arg3);
4502 /* Call the functions recorded in last_overlay_modification_hooks.
4503 First copy the vector contents, in case some of these hooks
4504 do subsequent modification of the buffer. */
4505 int size = last_overlay_modification_hooks_used;
4506 Lisp_Object *copy = (Lisp_Object *) alloca (size * sizeof (Lisp_Object));
4507 int i;
4509 bcopy (XVECTOR (last_overlay_modification_hooks)->contents,
4510 copy, size * sizeof (Lisp_Object));
4511 gcpro1.var = copy;
4512 gcpro1.nvars = size;
4514 for (i = 0; i < size;)
4516 Lisp_Object prop, overlay;
4517 prop = copy[i++];
4518 overlay = copy[i++];
4519 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
4522 UNGCPRO;
4525 static void
4526 call_overlay_mod_hooks (list, overlay, after, arg1, arg2, arg3)
4527 Lisp_Object list, overlay;
4528 int after;
4529 Lisp_Object arg1, arg2, arg3;
4531 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4533 GCPRO4 (list, arg1, arg2, arg3);
4535 while (CONSP (list))
4537 if (NILP (arg3))
4538 call4 (XCAR (list), overlay, after ? Qt : Qnil, arg1, arg2);
4539 else
4540 call5 (XCAR (list), overlay, after ? Qt : Qnil, arg1, arg2, arg3);
4541 list = XCDR (list);
4543 UNGCPRO;
4546 /* Delete any zero-sized overlays at position POS, if the `evaporate'
4547 property is set. */
4548 void
4549 evaporate_overlays (pos)
4550 EMACS_INT pos;
4552 Lisp_Object overlay, hit_list;
4553 struct Lisp_Overlay *tail;
4555 hit_list = Qnil;
4556 if (pos <= current_buffer->overlay_center)
4557 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
4559 int endpos;
4560 XSETMISC (overlay, tail);
4561 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
4562 if (endpos < pos)
4563 break;
4564 if (endpos == pos && OVERLAY_POSITION (OVERLAY_START (overlay)) == pos
4565 && ! NILP (Foverlay_get (overlay, Qevaporate)))
4566 hit_list = Fcons (overlay, hit_list);
4568 else
4569 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
4571 int startpos;
4572 XSETMISC (overlay, tail);
4573 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
4574 if (startpos > pos)
4575 break;
4576 if (startpos == pos && OVERLAY_POSITION (OVERLAY_END (overlay)) == pos
4577 && ! NILP (Foverlay_get (overlay, Qevaporate)))
4578 hit_list = Fcons (overlay, hit_list);
4580 for (; CONSP (hit_list); hit_list = XCDR (hit_list))
4581 Fdelete_overlay (XCAR (hit_list));
4584 /* Somebody has tried to store a value with an unacceptable type
4585 in the slot with offset OFFSET. */
4587 void
4588 buffer_slot_type_mismatch (newval, type)
4589 Lisp_Object newval;
4590 int type;
4592 Lisp_Object predicate;
4594 switch (type)
4596 case_Lisp_Int: predicate = Qintegerp; break;
4597 case Lisp_String: predicate = Qstringp; break;
4598 case Lisp_Symbol: predicate = Qsymbolp; break;
4599 default: abort ();
4602 wrong_type_argument (predicate, newval);
4606 /***********************************************************************
4607 Allocation with mmap
4608 ***********************************************************************/
4610 #ifdef USE_MMAP_FOR_BUFFERS
4612 #include <sys/types.h>
4613 #include <sys/mman.h>
4615 #ifndef MAP_ANON
4616 #ifdef MAP_ANONYMOUS
4617 #define MAP_ANON MAP_ANONYMOUS
4618 #else
4619 #define MAP_ANON 0
4620 #endif
4621 #endif
4623 #ifndef MAP_FAILED
4624 #define MAP_FAILED ((void *) -1)
4625 #endif
4627 #include <stdio.h>
4628 #include <errno.h>
4630 #if MAP_ANON == 0
4631 #include <fcntl.h>
4632 #endif
4634 #include "coding.h"
4637 /* Memory is allocated in regions which are mapped using mmap(2).
4638 The current implementation lets the system select mapped
4639 addresses; we're not using MAP_FIXED in general, except when
4640 trying to enlarge regions.
4642 Each mapped region starts with a mmap_region structure, the user
4643 area starts after that structure, aligned to MEM_ALIGN.
4645 +-----------------------+
4646 | struct mmap_info + |
4647 | padding |
4648 +-----------------------+
4649 | user data |
4652 +-----------------------+ */
4654 struct mmap_region
4656 /* User-specified size. */
4657 size_t nbytes_specified;
4659 /* Number of bytes mapped */
4660 size_t nbytes_mapped;
4662 /* Pointer to the location holding the address of the memory
4663 allocated with the mmap'd block. The variable actually points
4664 after this structure. */
4665 POINTER_TYPE **var;
4667 /* Next and previous in list of all mmap'd regions. */
4668 struct mmap_region *next, *prev;
4671 /* Doubly-linked list of mmap'd regions. */
4673 static struct mmap_region *mmap_regions;
4675 /* File descriptor for mmap. If we don't have anonymous mapping,
4676 /dev/zero will be opened on it. */
4678 static int mmap_fd;
4680 /* Temporary storage for mmap_set_vars, see there. */
4682 static struct mmap_region *mmap_regions_1;
4683 static int mmap_fd_1;
4685 /* Page size on this system. */
4687 static int mmap_page_size;
4689 /* 1 means mmap has been intialized. */
4691 static int mmap_initialized_p;
4693 /* Value is X rounded up to the next multiple of N. */
4695 #define ROUND(X, N) (((X) + (N) - 1) / (N) * (N))
4697 /* Size of mmap_region structure plus padding. */
4699 #define MMAP_REGION_STRUCT_SIZE \
4700 ROUND (sizeof (struct mmap_region), MEM_ALIGN)
4702 /* Given a pointer P to the start of the user-visible part of a mapped
4703 region, return a pointer to the start of the region. */
4705 #define MMAP_REGION(P) \
4706 ((struct mmap_region *) ((char *) (P) - MMAP_REGION_STRUCT_SIZE))
4708 /* Given a pointer P to the start of a mapped region, return a pointer
4709 to the start of the user-visible part of the region. */
4711 #define MMAP_USER_AREA(P) \
4712 ((POINTER_TYPE *) ((char *) (P) + MMAP_REGION_STRUCT_SIZE))
4714 #define MEM_ALIGN sizeof (double)
4716 /* Predicate returning true if part of the address range [START .. END]
4717 is currently mapped. Used to prevent overwriting an existing
4718 memory mapping.
4720 Default is to conservativly assume the address range is occupied by
4721 something else. This can be overridden by system configuration
4722 files if system-specific means to determine this exists. */
4724 #ifndef MMAP_ALLOCATED_P
4725 #define MMAP_ALLOCATED_P(start, end) 1
4726 #endif
4728 /* Function prototypes. */
4730 static int mmap_free_1 P_ ((struct mmap_region *));
4731 static int mmap_enlarge P_ ((struct mmap_region *, int));
4732 static struct mmap_region *mmap_find P_ ((POINTER_TYPE *, POINTER_TYPE *));
4733 static POINTER_TYPE *mmap_alloc P_ ((POINTER_TYPE **, size_t));
4734 static POINTER_TYPE *mmap_realloc P_ ((POINTER_TYPE **, size_t));
4735 static void mmap_free P_ ((POINTER_TYPE **ptr));
4736 static void mmap_init P_ ((void));
4739 /* Return a region overlapping address range START...END, or null if
4740 none. END is not including, i.e. the last byte in the range
4741 is at END - 1. */
4743 static struct mmap_region *
4744 mmap_find (start, end)
4745 POINTER_TYPE *start, *end;
4747 struct mmap_region *r;
4748 char *s = (char *) start, *e = (char *) end;
4750 for (r = mmap_regions; r; r = r->next)
4752 char *rstart = (char *) r;
4753 char *rend = rstart + r->nbytes_mapped;
4755 if (/* First byte of range, i.e. START, in this region? */
4756 (s >= rstart && s < rend)
4757 /* Last byte of range, i.e. END - 1, in this region? */
4758 || (e > rstart && e <= rend)
4759 /* First byte of this region in the range? */
4760 || (rstart >= s && rstart < e)
4761 /* Last byte of this region in the range? */
4762 || (rend > s && rend <= e))
4763 break;
4766 return r;
4770 /* Unmap a region. P is a pointer to the start of the user-araa of
4771 the region. Value is non-zero if successful. */
4773 static int
4774 mmap_free_1 (r)
4775 struct mmap_region *r;
4777 if (r->next)
4778 r->next->prev = r->prev;
4779 if (r->prev)
4780 r->prev->next = r->next;
4781 else
4782 mmap_regions = r->next;
4784 if (munmap ((POINTER_TYPE *) r, r->nbytes_mapped) == -1)
4786 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4787 return 0;
4790 return 1;
4794 /* Enlarge region R by NPAGES pages. NPAGES < 0 means shrink R.
4795 Value is non-zero if successful. */
4797 static int
4798 mmap_enlarge (r, npages)
4799 struct mmap_region *r;
4800 int npages;
4802 char *region_end = (char *) r + r->nbytes_mapped;
4803 size_t nbytes;
4804 int success = 0;
4806 if (npages < 0)
4808 /* Unmap pages at the end of the region. */
4809 nbytes = - npages * mmap_page_size;
4810 if (munmap (region_end - nbytes, nbytes) == -1)
4811 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4812 else
4814 r->nbytes_mapped -= nbytes;
4815 success = 1;
4818 else if (npages > 0)
4820 nbytes = npages * mmap_page_size;
4822 /* Try to map additional pages at the end of the region. We
4823 cannot do this if the address range is already occupied by
4824 something else because mmap deletes any previous mapping.
4825 I'm not sure this is worth doing, let's see. */
4826 if (!MMAP_ALLOCATED_P (region_end, region_end + nbytes))
4828 POINTER_TYPE *p;
4830 p = mmap (region_end, nbytes, PROT_READ | PROT_WRITE,
4831 MAP_ANON | MAP_PRIVATE | MAP_FIXED, mmap_fd, 0);
4832 if (p == MAP_FAILED)
4833 ; /* fprintf (stderr, "mmap: %s\n", emacs_strerror (errno)); */
4834 else if (p != (POINTER_TYPE *) region_end)
4836 /* Kernels are free to choose a different address. In
4837 that case, unmap what we've mapped above; we have
4838 no use for it. */
4839 if (munmap (p, nbytes) == -1)
4840 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4842 else
4844 r->nbytes_mapped += nbytes;
4845 success = 1;
4850 return success;
4854 /* Set or reset variables holding references to mapped regions. If
4855 RESTORE_P is zero, set all variables to null. If RESTORE_P is
4856 non-zero, set all variables to the start of the user-areas
4857 of mapped regions.
4859 This function is called from Fdump_emacs to ensure that the dumped
4860 Emacs doesn't contain references to memory that won't be mapped
4861 when Emacs starts. */
4863 void
4864 mmap_set_vars (restore_p)
4865 int restore_p;
4867 struct mmap_region *r;
4869 if (restore_p)
4871 mmap_regions = mmap_regions_1;
4872 mmap_fd = mmap_fd_1;
4873 for (r = mmap_regions; r; r = r->next)
4874 *r->var = MMAP_USER_AREA (r);
4876 else
4878 for (r = mmap_regions; r; r = r->next)
4879 *r->var = NULL;
4880 mmap_regions_1 = mmap_regions;
4881 mmap_regions = NULL;
4882 mmap_fd_1 = mmap_fd;
4883 mmap_fd = -1;
4888 /* Allocate a block of storage large enough to hold NBYTES bytes of
4889 data. A pointer to the data is returned in *VAR. VAR is thus the
4890 address of some variable which will use the data area.
4892 The allocation of 0 bytes is valid.
4894 If we can't allocate the necessary memory, set *VAR to null, and
4895 return null. */
4897 static POINTER_TYPE *
4898 mmap_alloc (var, nbytes)
4899 POINTER_TYPE **var;
4900 size_t nbytes;
4902 void *p;
4903 size_t map;
4905 mmap_init ();
4907 map = ROUND (nbytes + MMAP_REGION_STRUCT_SIZE, mmap_page_size);
4908 p = mmap (NULL, map, PROT_READ | PROT_WRITE, MAP_ANON | MAP_PRIVATE,
4909 mmap_fd, 0);
4911 if (p == MAP_FAILED)
4913 if (errno != ENOMEM)
4914 fprintf (stderr, "mmap: %s\n", emacs_strerror (errno));
4915 p = NULL;
4917 else
4919 struct mmap_region *r = (struct mmap_region *) p;
4921 r->nbytes_specified = nbytes;
4922 r->nbytes_mapped = map;
4923 r->var = var;
4924 r->prev = NULL;
4925 r->next = mmap_regions;
4926 if (r->next)
4927 r->next->prev = r;
4928 mmap_regions = r;
4930 p = MMAP_USER_AREA (p);
4933 return *var = p;
4937 /* Given a pointer at address VAR to data allocated with mmap_alloc,
4938 resize it to size NBYTES. Change *VAR to reflect the new block,
4939 and return this value. If more memory cannot be allocated, then
4940 leave *VAR unchanged, and return null. */
4942 static POINTER_TYPE *
4943 mmap_realloc (var, nbytes)
4944 POINTER_TYPE **var;
4945 size_t nbytes;
4947 POINTER_TYPE *result;
4949 mmap_init ();
4951 if (*var == NULL)
4952 result = mmap_alloc (var, nbytes);
4953 else if (nbytes == 0)
4955 mmap_free (var);
4956 result = mmap_alloc (var, nbytes);
4958 else
4960 struct mmap_region *r = MMAP_REGION (*var);
4961 size_t room = r->nbytes_mapped - MMAP_REGION_STRUCT_SIZE;
4963 if (room < nbytes)
4965 /* Must enlarge. */
4966 POINTER_TYPE *old_ptr = *var;
4968 /* Try to map additional pages at the end of the region.
4969 If that fails, allocate a new region, copy data
4970 from the old region, then free it. */
4971 if (mmap_enlarge (r, (ROUND (nbytes - room, mmap_page_size)
4972 / mmap_page_size)))
4974 r->nbytes_specified = nbytes;
4975 *var = result = old_ptr;
4977 else if (mmap_alloc (var, nbytes))
4979 bcopy (old_ptr, *var, r->nbytes_specified);
4980 mmap_free_1 (MMAP_REGION (old_ptr));
4981 result = *var;
4982 r = MMAP_REGION (result);
4983 r->nbytes_specified = nbytes;
4985 else
4987 *var = old_ptr;
4988 result = NULL;
4991 else if (room - nbytes >= mmap_page_size)
4993 /* Shrinking by at least a page. Let's give some
4994 memory back to the system.
4996 The extra parens are to make the division happens first,
4997 on positive values, so we know it will round towards
4998 zero. */
4999 mmap_enlarge (r, - ((room - nbytes) / mmap_page_size));
5000 result = *var;
5001 r->nbytes_specified = nbytes;
5003 else
5005 /* Leave it alone. */
5006 result = *var;
5007 r->nbytes_specified = nbytes;
5011 return result;
5015 /* Free a block of relocatable storage whose data is pointed to by
5016 PTR. Store 0 in *PTR to show there's no block allocated. */
5018 static void
5019 mmap_free (var)
5020 POINTER_TYPE **var;
5022 mmap_init ();
5024 if (*var)
5026 mmap_free_1 (MMAP_REGION (*var));
5027 *var = NULL;
5032 /* Perform necessary intializations for the use of mmap. */
5034 static void
5035 mmap_init ()
5037 #if MAP_ANON == 0
5038 /* The value of mmap_fd is initially 0 in temacs, and -1
5039 in a dumped Emacs. */
5040 if (mmap_fd <= 0)
5042 /* No anonymous mmap -- we need the file descriptor. */
5043 mmap_fd = open ("/dev/zero", O_RDONLY);
5044 if (mmap_fd == -1)
5045 fatal ("Cannot open /dev/zero: %s", emacs_strerror (errno));
5047 #endif /* MAP_ANON == 0 */
5049 if (mmap_initialized_p)
5050 return;
5051 mmap_initialized_p = 1;
5053 #if MAP_ANON != 0
5054 mmap_fd = -1;
5055 #endif
5057 mmap_page_size = getpagesize ();
5060 #endif /* USE_MMAP_FOR_BUFFERS */
5064 /***********************************************************************
5065 Buffer-text Allocation
5066 ***********************************************************************/
5068 #ifdef REL_ALLOC
5069 extern POINTER_TYPE *r_alloc P_ ((POINTER_TYPE **, size_t));
5070 extern POINTER_TYPE *r_re_alloc P_ ((POINTER_TYPE **, size_t));
5071 extern void r_alloc_free P_ ((POINTER_TYPE **ptr));
5072 #endif /* REL_ALLOC */
5075 /* Allocate NBYTES bytes for buffer B's text buffer. */
5077 static void
5078 alloc_buffer_text (b, nbytes)
5079 struct buffer *b;
5080 size_t nbytes;
5082 POINTER_TYPE *p;
5084 BLOCK_INPUT;
5085 #if defined USE_MMAP_FOR_BUFFERS
5086 p = mmap_alloc ((POINTER_TYPE **) &b->text->beg, nbytes);
5087 #elif defined REL_ALLOC
5088 p = r_alloc ((POINTER_TYPE **) &b->text->beg, nbytes);
5089 #else
5090 p = xmalloc (nbytes);
5091 #endif
5093 if (p == NULL)
5095 UNBLOCK_INPUT;
5096 memory_full ();
5099 b->text->beg = (unsigned char *) p;
5100 UNBLOCK_INPUT;
5103 /* Enlarge buffer B's text buffer by DELTA bytes. DELTA < 0 means
5104 shrink it. */
5106 void
5107 enlarge_buffer_text (struct buffer *b, EMACS_INT delta)
5109 POINTER_TYPE *p;
5110 size_t nbytes = (BUF_Z_BYTE (b) - BUF_BEG_BYTE (b) + BUF_GAP_SIZE (b) + 1
5111 + delta);
5112 BLOCK_INPUT;
5113 #if defined USE_MMAP_FOR_BUFFERS
5114 p = mmap_realloc ((POINTER_TYPE **) &b->text->beg, nbytes);
5115 #elif defined REL_ALLOC
5116 p = r_re_alloc ((POINTER_TYPE **) &b->text->beg, nbytes);
5117 #else
5118 p = xrealloc (b->text->beg, nbytes);
5119 #endif
5121 if (p == NULL)
5123 UNBLOCK_INPUT;
5124 memory_full ();
5127 BUF_BEG_ADDR (b) = (unsigned char *) p;
5128 UNBLOCK_INPUT;
5132 /* Free buffer B's text buffer. */
5134 static void
5135 free_buffer_text (b)
5136 struct buffer *b;
5138 BLOCK_INPUT;
5140 #if defined USE_MMAP_FOR_BUFFERS
5141 mmap_free ((POINTER_TYPE **) &b->text->beg);
5142 #elif defined REL_ALLOC
5143 r_alloc_free ((POINTER_TYPE **) &b->text->beg);
5144 #else
5145 xfree (b->text->beg);
5146 #endif
5148 BUF_BEG_ADDR (b) = NULL;
5149 UNBLOCK_INPUT;
5154 /***********************************************************************
5155 Initialization
5156 ***********************************************************************/
5158 void
5159 init_buffer_once ()
5161 int idx;
5163 bzero (buffer_permanent_local_flags, sizeof buffer_permanent_local_flags);
5165 /* Make sure all markable slots in buffer_defaults
5166 are initialized reasonably, so mark_buffer won't choke. */
5167 reset_buffer (&buffer_defaults);
5168 reset_buffer_local_variables (&buffer_defaults, 1);
5169 reset_buffer (&buffer_local_symbols);
5170 reset_buffer_local_variables (&buffer_local_symbols, 1);
5171 /* Prevent GC from getting confused. */
5172 buffer_defaults.text = &buffer_defaults.own_text;
5173 buffer_local_symbols.text = &buffer_local_symbols.own_text;
5174 BUF_INTERVALS (&buffer_defaults) = 0;
5175 BUF_INTERVALS (&buffer_local_symbols) = 0;
5176 XSETPVECTYPE (&buffer_defaults, PVEC_BUFFER);
5177 XSETBUFFER (Vbuffer_defaults, &buffer_defaults);
5178 XSETPVECTYPE (&buffer_local_symbols, PVEC_BUFFER);
5179 XSETBUFFER (Vbuffer_local_symbols, &buffer_local_symbols);
5181 /* Set up the default values of various buffer slots. */
5182 /* Must do these before making the first buffer! */
5184 /* real setup is done in bindings.el */
5185 buffer_defaults.mode_line_format = make_pure_c_string ("%-");
5186 buffer_defaults.header_line_format = Qnil;
5187 buffer_defaults.abbrev_mode = Qnil;
5188 buffer_defaults.overwrite_mode = Qnil;
5189 buffer_defaults.case_fold_search = Qt;
5190 buffer_defaults.auto_fill_function = Qnil;
5191 buffer_defaults.selective_display = Qnil;
5192 #ifndef old
5193 buffer_defaults.selective_display_ellipses = Qt;
5194 #endif
5195 buffer_defaults.abbrev_table = Qnil;
5196 buffer_defaults.display_table = Qnil;
5197 buffer_defaults.undo_list = Qnil;
5198 buffer_defaults.mark_active = Qnil;
5199 buffer_defaults.file_format = Qnil;
5200 buffer_defaults.auto_save_file_format = Qt;
5201 buffer_defaults.overlays_before = NULL;
5202 buffer_defaults.overlays_after = NULL;
5203 buffer_defaults.overlay_center = BEG;
5205 XSETFASTINT (buffer_defaults.tab_width, 8);
5206 buffer_defaults.truncate_lines = Qnil;
5207 buffer_defaults.word_wrap = Qnil;
5208 buffer_defaults.ctl_arrow = Qt;
5209 buffer_defaults.bidi_display_reordering = Qnil;
5210 buffer_defaults.direction_reversed = Qnil;
5211 buffer_defaults.bidi_paragraph_direction = Qnil;
5212 buffer_defaults.cursor_type = Qt;
5213 buffer_defaults.extra_line_spacing = Qnil;
5214 buffer_defaults.cursor_in_non_selected_windows = Qt;
5216 #ifdef DOS_NT
5217 buffer_defaults.buffer_file_type = Qnil; /* TEXT */
5218 #endif
5219 buffer_defaults.enable_multibyte_characters = Qt;
5220 buffer_defaults.buffer_file_coding_system = Qnil;
5221 XSETFASTINT (buffer_defaults.fill_column, 70);
5222 XSETFASTINT (buffer_defaults.left_margin, 0);
5223 buffer_defaults.cache_long_line_scans = Qnil;
5224 buffer_defaults.file_truename = Qnil;
5225 XSETFASTINT (buffer_defaults.display_count, 0);
5226 XSETFASTINT (buffer_defaults.left_margin_cols, 0);
5227 XSETFASTINT (buffer_defaults.right_margin_cols, 0);
5228 buffer_defaults.left_fringe_width = Qnil;
5229 buffer_defaults.right_fringe_width = Qnil;
5230 buffer_defaults.fringes_outside_margins = Qnil;
5231 buffer_defaults.scroll_bar_width = Qnil;
5232 buffer_defaults.vertical_scroll_bar_type = Qt;
5233 buffer_defaults.indicate_empty_lines = Qnil;
5234 buffer_defaults.indicate_buffer_boundaries = Qnil;
5235 buffer_defaults.fringe_indicator_alist = Qnil;
5236 buffer_defaults.fringe_cursor_alist = Qnil;
5237 buffer_defaults.scroll_up_aggressively = Qnil;
5238 buffer_defaults.scroll_down_aggressively = Qnil;
5239 buffer_defaults.display_time = Qnil;
5241 /* Assign the local-flags to the slots that have default values.
5242 The local flag is a bit that is used in the buffer
5243 to say that it has its own local value for the slot.
5244 The local flag bits are in the local_var_flags slot of the buffer. */
5246 /* Nothing can work if this isn't true */
5247 if (sizeof (EMACS_INT) != sizeof (Lisp_Object)) abort ();
5249 /* 0 means not a lisp var, -1 means always local, else mask */
5250 bzero (&buffer_local_flags, sizeof buffer_local_flags);
5251 XSETINT (buffer_local_flags.filename, -1);
5252 XSETINT (buffer_local_flags.directory, -1);
5253 XSETINT (buffer_local_flags.backed_up, -1);
5254 XSETINT (buffer_local_flags.save_length, -1);
5255 XSETINT (buffer_local_flags.auto_save_file_name, -1);
5256 XSETINT (buffer_local_flags.read_only, -1);
5257 XSETINT (buffer_local_flags.major_mode, -1);
5258 XSETINT (buffer_local_flags.mode_name, -1);
5259 XSETINT (buffer_local_flags.undo_list, -1);
5260 XSETINT (buffer_local_flags.mark_active, -1);
5261 XSETINT (buffer_local_flags.point_before_scroll, -1);
5262 XSETINT (buffer_local_flags.file_truename, -1);
5263 XSETINT (buffer_local_flags.invisibility_spec, -1);
5264 XSETINT (buffer_local_flags.file_format, -1);
5265 XSETINT (buffer_local_flags.auto_save_file_format, -1);
5266 XSETINT (buffer_local_flags.display_count, -1);
5267 XSETINT (buffer_local_flags.display_time, -1);
5268 XSETINT (buffer_local_flags.enable_multibyte_characters, -1);
5270 idx = 1;
5271 XSETFASTINT (buffer_local_flags.mode_line_format, idx); ++idx;
5272 XSETFASTINT (buffer_local_flags.abbrev_mode, idx); ++idx;
5273 XSETFASTINT (buffer_local_flags.overwrite_mode, idx); ++idx;
5274 XSETFASTINT (buffer_local_flags.case_fold_search, idx); ++idx;
5275 XSETFASTINT (buffer_local_flags.auto_fill_function, idx); ++idx;
5276 XSETFASTINT (buffer_local_flags.selective_display, idx); ++idx;
5277 #ifndef old
5278 XSETFASTINT (buffer_local_flags.selective_display_ellipses, idx); ++idx;
5279 #endif
5280 XSETFASTINT (buffer_local_flags.tab_width, idx); ++idx;
5281 XSETFASTINT (buffer_local_flags.truncate_lines, idx); ++idx;
5282 XSETFASTINT (buffer_local_flags.word_wrap, idx); ++idx;
5283 XSETFASTINT (buffer_local_flags.ctl_arrow, idx); ++idx;
5284 XSETFASTINT (buffer_local_flags.fill_column, idx); ++idx;
5285 XSETFASTINT (buffer_local_flags.left_margin, idx); ++idx;
5286 XSETFASTINT (buffer_local_flags.abbrev_table, idx); ++idx;
5287 XSETFASTINT (buffer_local_flags.display_table, idx); ++idx;
5288 #ifdef DOS_NT
5289 XSETFASTINT (buffer_local_flags.buffer_file_type, idx);
5290 /* Make this one a permanent local. */
5291 buffer_permanent_local_flags[idx++] = 1;
5292 #endif
5293 XSETFASTINT (buffer_local_flags.syntax_table, idx); ++idx;
5294 XSETFASTINT (buffer_local_flags.cache_long_line_scans, idx); ++idx;
5295 XSETFASTINT (buffer_local_flags.category_table, idx); ++idx;
5296 XSETFASTINT (buffer_local_flags.bidi_display_reordering, idx); ++idx;
5297 XSETFASTINT (buffer_local_flags.direction_reversed, idx); ++idx;
5298 XSETFASTINT (buffer_local_flags.bidi_paragraph_direction, idx); ++idx;
5299 XSETFASTINT (buffer_local_flags.buffer_file_coding_system, idx);
5300 /* Make this one a permanent local. */
5301 buffer_permanent_local_flags[idx++] = 1;
5302 XSETFASTINT (buffer_local_flags.left_margin_cols, idx); ++idx;
5303 XSETFASTINT (buffer_local_flags.right_margin_cols, idx); ++idx;
5304 XSETFASTINT (buffer_local_flags.left_fringe_width, idx); ++idx;
5305 XSETFASTINT (buffer_local_flags.right_fringe_width, idx); ++idx;
5306 XSETFASTINT (buffer_local_flags.fringes_outside_margins, idx); ++idx;
5307 XSETFASTINT (buffer_local_flags.scroll_bar_width, idx); ++idx;
5308 XSETFASTINT (buffer_local_flags.vertical_scroll_bar_type, idx); ++idx;
5309 XSETFASTINT (buffer_local_flags.indicate_empty_lines, idx); ++idx;
5310 XSETFASTINT (buffer_local_flags.indicate_buffer_boundaries, idx); ++idx;
5311 XSETFASTINT (buffer_local_flags.fringe_indicator_alist, idx); ++idx;
5312 XSETFASTINT (buffer_local_flags.fringe_cursor_alist, idx); ++idx;
5313 XSETFASTINT (buffer_local_flags.scroll_up_aggressively, idx); ++idx;
5314 XSETFASTINT (buffer_local_flags.scroll_down_aggressively, idx); ++idx;
5315 XSETFASTINT (buffer_local_flags.header_line_format, idx); ++idx;
5316 XSETFASTINT (buffer_local_flags.cursor_type, idx); ++idx;
5317 XSETFASTINT (buffer_local_flags.extra_line_spacing, idx); ++idx;
5318 XSETFASTINT (buffer_local_flags.cursor_in_non_selected_windows, idx); ++idx;
5320 /* Need more room? */
5321 if (idx >= MAX_PER_BUFFER_VARS)
5322 abort ();
5323 last_per_buffer_idx = idx;
5325 Vbuffer_alist = Qnil;
5326 current_buffer = 0;
5327 all_buffers = 0;
5329 QSFundamental = make_pure_c_string ("Fundamental");
5331 Qfundamental_mode = intern_c_string ("fundamental-mode");
5332 buffer_defaults.major_mode = Qfundamental_mode;
5334 Qmode_class = intern_c_string ("mode-class");
5336 Qprotected_field = intern_c_string ("protected-field");
5338 Qpermanent_local = intern_c_string ("permanent-local");
5340 Qkill_buffer_hook = intern_c_string ("kill-buffer-hook");
5341 Fput (Qkill_buffer_hook, Qpermanent_local, Qt);
5343 Qucs_set_table_for_input = intern_c_string ("ucs-set-table-for-input");
5345 /* super-magic invisible buffer */
5346 Vprin1_to_string_buffer = Fget_buffer_create (make_pure_c_string (" prin1"));
5347 Vbuffer_alist = Qnil;
5349 Fset_buffer (Fget_buffer_create (make_pure_c_string ("*scratch*")));
5351 inhibit_modification_hooks = 0;
5354 void
5355 init_buffer ()
5357 char *pwd;
5358 Lisp_Object temp;
5359 int len;
5361 #ifdef USE_MMAP_FOR_BUFFERS
5363 /* When using the ralloc implementation based on mmap(2), buffer
5364 text pointers will have been set to null in the dumped Emacs.
5365 Map new memory. */
5366 struct buffer *b;
5368 for (b = all_buffers; b; b = b->next)
5369 if (b->text->beg == NULL)
5370 enlarge_buffer_text (b, 0);
5372 #endif /* USE_MMAP_FOR_BUFFERS */
5374 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
5375 if (NILP (buffer_defaults.enable_multibyte_characters))
5376 Fset_buffer_multibyte (Qnil);
5378 pwd = get_current_dir_name ();
5380 if (!pwd)
5381 fatal ("`get_current_dir_name' failed: %s\n", strerror (errno));
5383 /* Maybe this should really use some standard subroutine
5384 whose definition is filename syntax dependent. */
5385 len = strlen (pwd);
5386 if (!(IS_DIRECTORY_SEP (pwd[len - 1])))
5388 /* Grow buffer to add directory separator and '\0'. */
5389 pwd = (char *) realloc (pwd, len + 2);
5390 if (!pwd)
5391 fatal ("`get_current_dir_name' failed: %s\n", strerror (errno));
5392 pwd[len] = DIRECTORY_SEP;
5393 pwd[len + 1] = '\0';
5396 current_buffer->directory = make_unibyte_string (pwd, strlen (pwd));
5397 if (! NILP (buffer_defaults.enable_multibyte_characters))
5398 /* At this moment, we still don't know how to decode the
5399 directory name. So, we keep the bytes in multibyte form so
5400 that ENCODE_FILE correctly gets the original bytes. */
5401 current_buffer->directory
5402 = string_to_multibyte (current_buffer->directory);
5404 /* Add /: to the front of the name
5405 if it would otherwise be treated as magic. */
5406 temp = Ffind_file_name_handler (current_buffer->directory, Qt);
5407 if (! NILP (temp)
5408 /* If the default dir is just /, TEMP is non-nil
5409 because of the ange-ftp completion handler.
5410 However, it is not necessary to turn / into /:/.
5411 So avoid doing that. */
5412 && strcmp ("/", SDATA (current_buffer->directory)))
5413 current_buffer->directory
5414 = concat2 (build_string ("/:"), current_buffer->directory);
5416 temp = get_minibuffer (0);
5417 XBUFFER (temp)->directory = current_buffer->directory;
5419 free (pwd);
5422 /* Similar to defvar_lisp but define a variable whose value is the Lisp
5423 Object stored in the current buffer. address is the address of the slot
5424 in the buffer that is current now. */
5426 /* TYPE is nil for a general Lisp variable.
5427 An integer specifies a type; then only LIsp values
5428 with that type code are allowed (except that nil is allowed too).
5429 LNAME is the LIsp-level variable name.
5430 VNAME is the name of the buffer slot.
5431 DOC is a dummy where you write the doc string as a comment. */
5432 #define DEFVAR_PER_BUFFER(lname, vname, type, doc) \
5433 defvar_per_buffer (lname, vname, type, 0)
5435 static void
5436 defvar_per_buffer (namestring, address, type, doc)
5437 char *namestring;
5438 Lisp_Object *address;
5439 Lisp_Object type;
5440 char *doc;
5442 Lisp_Object sym, val;
5443 int offset;
5445 sym = intern (namestring);
5446 val = allocate_misc ();
5447 offset = (char *)address - (char *)current_buffer;
5449 XMISCTYPE (val) = Lisp_Misc_Buffer_Objfwd;
5450 XBUFFER_OBJFWD (val)->offset = offset;
5451 XBUFFER_OBJFWD (val)->slottype = type;
5452 SET_SYMBOL_VALUE (sym, val);
5453 PER_BUFFER_SYMBOL (offset) = sym;
5455 if (PER_BUFFER_IDX (offset) == 0)
5456 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
5457 slot of buffer_local_flags */
5458 abort ();
5462 /* initialize the buffer routines */
5463 void
5464 syms_of_buffer ()
5466 staticpro (&last_overlay_modification_hooks);
5467 last_overlay_modification_hooks
5468 = Fmake_vector (make_number (10), Qnil);
5470 staticpro (&Vbuffer_defaults);
5471 staticpro (&Vbuffer_local_symbols);
5472 staticpro (&Qfundamental_mode);
5473 staticpro (&Qmode_class);
5474 staticpro (&QSFundamental);
5475 staticpro (&Vbuffer_alist);
5476 staticpro (&Qprotected_field);
5477 staticpro (&Qpermanent_local);
5478 Qpermanent_local_hook = intern_c_string ("permanent-local-hook");
5479 staticpro (&Qpermanent_local_hook);
5480 staticpro (&Qkill_buffer_hook);
5481 Qoverlayp = intern_c_string ("overlayp");
5482 staticpro (&Qoverlayp);
5483 Qevaporate = intern_c_string ("evaporate");
5484 staticpro (&Qevaporate);
5485 Qmodification_hooks = intern_c_string ("modification-hooks");
5486 staticpro (&Qmodification_hooks);
5487 Qinsert_in_front_hooks = intern_c_string ("insert-in-front-hooks");
5488 staticpro (&Qinsert_in_front_hooks);
5489 Qinsert_behind_hooks = intern_c_string ("insert-behind-hooks");
5490 staticpro (&Qinsert_behind_hooks);
5491 Qget_file_buffer = intern_c_string ("get-file-buffer");
5492 staticpro (&Qget_file_buffer);
5493 Qpriority = intern_c_string ("priority");
5494 staticpro (&Qpriority);
5495 Qwindow = intern_c_string ("window");
5496 staticpro (&Qwindow);
5497 Qbefore_string = intern_c_string ("before-string");
5498 staticpro (&Qbefore_string);
5499 Qafter_string = intern_c_string ("after-string");
5500 staticpro (&Qafter_string);
5501 Qfirst_change_hook = intern_c_string ("first-change-hook");
5502 staticpro (&Qfirst_change_hook);
5503 Qbefore_change_functions = intern_c_string ("before-change-functions");
5504 staticpro (&Qbefore_change_functions);
5505 Qafter_change_functions = intern_c_string ("after-change-functions");
5506 staticpro (&Qafter_change_functions);
5507 /* The next one is initialized in init_buffer_once. */
5508 staticpro (&Qucs_set_table_for_input);
5510 Qkill_buffer_query_functions = intern_c_string ("kill-buffer-query-functions");
5511 staticpro (&Qkill_buffer_query_functions);
5513 Fput (Qprotected_field, Qerror_conditions,
5514 pure_cons (Qprotected_field, pure_cons (Qerror, Qnil)));
5515 Fput (Qprotected_field, Qerror_message,
5516 make_pure_c_string ("Attempt to modify a protected field"));
5518 /* All these use DEFVAR_LISP_NOPRO because the slots in
5519 buffer_defaults will all be marked via Vbuffer_defaults. */
5521 DEFVAR_LISP_NOPRO ("default-mode-line-format",
5522 &buffer_defaults.mode_line_format,
5523 doc: /* Default value of `mode-line-format' for buffers that don't override it.
5524 This is the same as (default-value 'mode-line-format). */);
5526 DEFVAR_LISP_NOPRO ("default-header-line-format",
5527 &buffer_defaults.header_line_format,
5528 doc: /* Default value of `header-line-format' for buffers that don't override it.
5529 This is the same as (default-value 'header-line-format). */);
5531 DEFVAR_LISP_NOPRO ("default-cursor-type", &buffer_defaults.cursor_type,
5532 doc: /* Default value of `cursor-type' for buffers that don't override it.
5533 This is the same as (default-value 'cursor-type). */);
5535 DEFVAR_LISP_NOPRO ("default-line-spacing",
5536 &buffer_defaults.extra_line_spacing,
5537 doc: /* Default value of `line-spacing' for buffers that don't override it.
5538 This is the same as (default-value 'line-spacing). */);
5540 DEFVAR_LISP_NOPRO ("default-cursor-in-non-selected-windows",
5541 &buffer_defaults.cursor_in_non_selected_windows,
5542 doc: /* Default value of `cursor-in-non-selected-windows'.
5543 This is the same as (default-value 'cursor-in-non-selected-windows). */);
5545 DEFVAR_LISP_NOPRO ("default-abbrev-mode",
5546 &buffer_defaults.abbrev_mode,
5547 doc: /* Default value of `abbrev-mode' for buffers that do not override it.
5548 This is the same as (default-value 'abbrev-mode). */);
5550 DEFVAR_LISP_NOPRO ("default-ctl-arrow",
5551 &buffer_defaults.ctl_arrow,
5552 doc: /* Default value of `ctl-arrow' for buffers that do not override it.
5553 This is the same as (default-value 'ctl-arrow). */);
5555 DEFVAR_LISP_NOPRO ("default-enable-multibyte-characters",
5556 &buffer_defaults.enable_multibyte_characters,
5557 doc: /* *Default value of `enable-multibyte-characters' for buffers not overriding it.
5558 This is the same as (default-value 'enable-multibyte-characters). */);
5560 DEFVAR_LISP_NOPRO ("default-buffer-file-coding-system",
5561 &buffer_defaults.buffer_file_coding_system,
5562 doc: /* Default value of `buffer-file-coding-system' for buffers not overriding it.
5563 This is the same as (default-value 'buffer-file-coding-system). */);
5565 DEFVAR_LISP_NOPRO ("default-truncate-lines",
5566 &buffer_defaults.truncate_lines,
5567 doc: /* Default value of `truncate-lines' for buffers that do not override it.
5568 This is the same as (default-value 'truncate-lines). */);
5570 DEFVAR_LISP_NOPRO ("default-fill-column",
5571 &buffer_defaults.fill_column,
5572 doc: /* Default value of `fill-column' for buffers that do not override it.
5573 This is the same as (default-value 'fill-column). */);
5575 DEFVAR_LISP_NOPRO ("default-left-margin",
5576 &buffer_defaults.left_margin,
5577 doc: /* Default value of `left-margin' for buffers that do not override it.
5578 This is the same as (default-value 'left-margin). */);
5580 DEFVAR_LISP_NOPRO ("default-tab-width",
5581 &buffer_defaults.tab_width,
5582 doc: /* Default value of `tab-width' for buffers that do not override it.
5583 This is the same as (default-value 'tab-width). */);
5585 DEFVAR_LISP_NOPRO ("default-case-fold-search",
5586 &buffer_defaults.case_fold_search,
5587 doc: /* Default value of `case-fold-search' for buffers that don't override it.
5588 This is the same as (default-value 'case-fold-search). */);
5590 #ifdef DOS_NT
5591 DEFVAR_LISP_NOPRO ("default-buffer-file-type",
5592 &buffer_defaults.buffer_file_type,
5593 doc: /* Default file type for buffers that do not override it.
5594 This is the same as (default-value 'buffer-file-type).
5595 The file type is nil for text, t for binary. */);
5596 #endif
5598 DEFVAR_LISP_NOPRO ("default-left-margin-width",
5599 &buffer_defaults.left_margin_cols,
5600 doc: /* Default value of `left-margin-width' for buffers that don't override it.
5601 This is the same as (default-value 'left-margin-width). */);
5603 DEFVAR_LISP_NOPRO ("default-right-margin-width",
5604 &buffer_defaults.right_margin_cols,
5605 doc: /* Default value of `right-margin-width' for buffers that don't override it.
5606 This is the same as (default-value 'right-margin-width). */);
5608 DEFVAR_LISP_NOPRO ("default-left-fringe-width",
5609 &buffer_defaults.left_fringe_width,
5610 doc: /* Default value of `left-fringe-width' for buffers that don't override it.
5611 This is the same as (default-value 'left-fringe-width). */);
5613 DEFVAR_LISP_NOPRO ("default-right-fringe-width",
5614 &buffer_defaults.right_fringe_width,
5615 doc: /* Default value of `right-fringe-width' for buffers that don't override it.
5616 This is the same as (default-value 'right-fringe-width). */);
5618 DEFVAR_LISP_NOPRO ("default-fringes-outside-margins",
5619 &buffer_defaults.fringes_outside_margins,
5620 doc: /* Default value of `fringes-outside-margins' for buffers that don't override it.
5621 This is the same as (default-value 'fringes-outside-margins). */);
5623 DEFVAR_LISP_NOPRO ("default-scroll-bar-width",
5624 &buffer_defaults.scroll_bar_width,
5625 doc: /* Default value of `scroll-bar-width' for buffers that don't override it.
5626 This is the same as (default-value 'scroll-bar-width). */);
5628 DEFVAR_LISP_NOPRO ("default-vertical-scroll-bar",
5629 &buffer_defaults.vertical_scroll_bar_type,
5630 doc: /* Default value of `vertical-scroll-bar' for buffers that don't override it.
5631 This is the same as (default-value 'vertical-scroll-bar). */);
5633 DEFVAR_LISP_NOPRO ("default-indicate-empty-lines",
5634 &buffer_defaults.indicate_empty_lines,
5635 doc: /* Default value of `indicate-empty-lines' for buffers that don't override it.
5636 This is the same as (default-value 'indicate-empty-lines). */);
5638 DEFVAR_LISP_NOPRO ("default-indicate-buffer-boundaries",
5639 &buffer_defaults.indicate_buffer_boundaries,
5640 doc: /* Default value of `indicate-buffer-boundaries' for buffers that don't override it.
5641 This is the same as (default-value 'indicate-buffer-boundaries). */);
5643 DEFVAR_LISP_NOPRO ("default-fringe-indicator-alist",
5644 &buffer_defaults.fringe_indicator_alist,
5645 doc: /* Default value of `fringe-indicator-alist' for buffers that don't override it.
5646 This is the same as (default-value 'fringe-indicator-alist'). */);
5648 DEFVAR_LISP_NOPRO ("default-fringe-cursor-alist",
5649 &buffer_defaults.fringe_cursor_alist,
5650 doc: /* Default value of `fringe-cursor-alist' for buffers that don't override it.
5651 This is the same as (default-value 'fringe-cursor-alist'). */);
5653 DEFVAR_LISP_NOPRO ("default-scroll-up-aggressively",
5654 &buffer_defaults.scroll_up_aggressively,
5655 doc: /* Default value of `scroll-up-aggressively'.
5656 This value applies in buffers that don't have their own local values.
5657 This is the same as (default-value 'scroll-up-aggressively). */);
5659 DEFVAR_LISP_NOPRO ("default-scroll-down-aggressively",
5660 &buffer_defaults.scroll_down_aggressively,
5661 doc: /* Default value of `scroll-down-aggressively'.
5662 This value applies in buffers that don't have their own local values.
5663 This is the same as (default-value 'scroll-down-aggressively). */);
5665 DEFVAR_PER_BUFFER ("header-line-format",
5666 &current_buffer->header_line_format,
5667 Qnil,
5668 doc: /* Analogous to `mode-line-format', but controls the header line.
5669 The header line appears, optionally, at the top of a window;
5670 the mode line appears at the bottom. */);
5672 DEFVAR_PER_BUFFER ("mode-line-format", &current_buffer->mode_line_format,
5673 Qnil,
5674 doc: /* Template for displaying mode line for current buffer.
5675 Each buffer has its own value of this variable.
5676 Value may be nil, a string, a symbol or a list or cons cell.
5677 A value of nil means don't display a mode line.
5678 For a symbol, its value is used (but it is ignored if t or nil).
5679 A string appearing directly as the value of a symbol is processed verbatim
5680 in that the %-constructs below are not recognized.
5681 Note that unless the symbol is marked as a `risky-local-variable', all
5682 properties in any strings, as well as all :eval and :propertize forms
5683 in the value of that symbol will be ignored.
5684 For a list of the form `(:eval FORM)', FORM is evaluated and the result
5685 is used as a mode line element. Be careful--FORM should not load any files,
5686 because that can cause an infinite recursion.
5687 For a list of the form `(:propertize ELT PROPS...)', ELT is displayed
5688 with the specified properties PROPS applied.
5689 For a list whose car is a symbol, the symbol's value is taken,
5690 and if that is non-nil, the cadr of the list is processed recursively.
5691 Otherwise, the caddr of the list (if there is one) is processed.
5692 For a list whose car is a string or list, each element is processed
5693 recursively and the results are effectively concatenated.
5694 For a list whose car is an integer, the cdr of the list is processed
5695 and padded (if the number is positive) or truncated (if negative)
5696 to the width specified by that number.
5697 A string is printed verbatim in the mode line except for %-constructs:
5698 (%-constructs are allowed when the string is the entire mode-line-format
5699 or when it is found in a cons-cell or a list)
5700 %b -- print buffer name. %f -- print visited file name.
5701 %F -- print frame name.
5702 %* -- print %, * or hyphen. %+ -- print *, % or hyphen.
5703 %& is like %*, but ignore read-only-ness.
5704 % means buffer is read-only and * means it is modified.
5705 For a modified read-only buffer, %* gives % and %+ gives *.
5706 %s -- print process status. %l -- print the current line number.
5707 %c -- print the current column number (this makes editing slower).
5708 To make the column number update correctly in all cases,
5709 `column-number-mode' must be non-nil.
5710 %i -- print the size of the buffer.
5711 %I -- like %i, but use k, M, G, etc., to abbreviate.
5712 %p -- print percent of buffer above top of window, or Top, Bot or All.
5713 %P -- print percent of buffer above bottom of window, perhaps plus Top,
5714 or print Bottom or All.
5715 %n -- print Narrow if appropriate.
5716 %t -- visited file is text or binary (if OS supports this distinction).
5717 %z -- print mnemonics of keyboard, terminal, and buffer coding systems.
5718 %Z -- like %z, but including the end-of-line format.
5719 %e -- print error message about full memory.
5720 %@ -- print @ or hyphen. @ means that default-directory is on a
5721 remote machine.
5722 %[ -- print one [ for each recursive editing level. %] similar.
5723 %% -- print %. %- -- print infinitely many dashes.
5724 Decimal digits after the % specify field width to which to pad. */);
5726 DEFVAR_LISP_NOPRO ("default-major-mode", &buffer_defaults.major_mode,
5727 doc: /* *Value of `major-mode' for new buffers. */);
5729 DEFVAR_PER_BUFFER ("major-mode", &current_buffer->major_mode,
5730 make_number (Lisp_Symbol),
5731 doc: /* Symbol for current buffer's major mode.
5732 The default value (normally `fundamental-mode') affects new buffers.
5733 A value of nil means to use the current buffer's major mode, provided
5734 it is not marked as "special".
5736 When a mode is used by default, `find-file' switches to it before it
5737 reads the contents into the buffer and before it finishes setting up
5738 the buffer. Thus, the mode and its hooks should not expect certain
5739 variables such as `buffer-read-only' and `buffer-file-coding-system'
5740 to be set up. */);
5742 DEFVAR_PER_BUFFER ("mode-name", &current_buffer->mode_name,
5743 Qnil,
5744 doc: /* Pretty name of current buffer's major mode.
5745 Usually a string, but can use any of the constructs for `mode-line-format',
5746 which see.
5747 Format with `format-mode-line' to produce a string value. */);
5749 DEFVAR_PER_BUFFER ("local-abbrev-table", &current_buffer->abbrev_table, Qnil,
5750 doc: /* Local (mode-specific) abbrev table of current buffer. */);
5752 DEFVAR_PER_BUFFER ("abbrev-mode", &current_buffer->abbrev_mode, Qnil,
5753 doc: /* Non-nil turns on automatic expansion of abbrevs as they are inserted. */);
5755 DEFVAR_PER_BUFFER ("case-fold-search", &current_buffer->case_fold_search,
5756 Qnil,
5757 doc: /* *Non-nil if searches and matches should ignore case. */);
5759 DEFVAR_PER_BUFFER ("fill-column", &current_buffer->fill_column,
5760 make_number (LISP_INT_TAG),
5761 doc: /* *Column beyond which automatic line-wrapping should happen.
5762 Interactively, you can set the buffer local value using \\[set-fill-column]. */);
5764 DEFVAR_PER_BUFFER ("left-margin", &current_buffer->left_margin,
5765 make_number (LISP_INT_TAG),
5766 doc: /* *Column for the default `indent-line-function' to indent to.
5767 Linefeed indents to this column in Fundamental mode. */);
5769 DEFVAR_PER_BUFFER ("tab-width", &current_buffer->tab_width,
5770 make_number (LISP_INT_TAG),
5771 doc: /* *Distance between tab stops (for display of tab characters), in columns. */);
5773 DEFVAR_PER_BUFFER ("ctl-arrow", &current_buffer->ctl_arrow, Qnil,
5774 doc: /* *Non-nil means display control chars with uparrow.
5775 A value of nil means use backslash and octal digits.
5776 This variable does not apply to characters whose display is specified
5777 in the current display table (if there is one). */);
5779 DEFVAR_PER_BUFFER ("enable-multibyte-characters",
5780 &current_buffer->enable_multibyte_characters,
5781 Qnil,
5782 doc: /* Non-nil means the buffer contents are regarded as multi-byte characters.
5783 Otherwise they are regarded as unibyte. This affects the display,
5784 file I/O and the behavior of various editing commands.
5786 This variable is buffer-local but you cannot set it directly;
5787 use the function `set-buffer-multibyte' to change a buffer's representation.
5788 Changing its default value with `setq-default' is supported.
5789 See also variable `default-enable-multibyte-characters' and Info node
5790 `(elisp)Text Representations'. */);
5791 XSYMBOL (intern_c_string ("enable-multibyte-characters"))->constant = 1;
5793 DEFVAR_PER_BUFFER ("buffer-file-coding-system",
5794 &current_buffer->buffer_file_coding_system, Qnil,
5795 doc: /* Coding system to be used for encoding the buffer contents on saving.
5796 This variable applies to saving the buffer, and also to `write-region'
5797 and other functions that use `write-region'.
5798 It does not apply to sending output to subprocesses, however.
5800 If this is nil, the buffer is saved without any code conversion
5801 unless some coding system is specified in `file-coding-system-alist'
5802 for the buffer file.
5804 If the text to be saved cannot be encoded as specified by this variable,
5805 an alternative encoding is selected by `select-safe-coding-system', which see.
5807 The variable `coding-system-for-write', if non-nil, overrides this variable.
5809 This variable is never applied to a way of decoding a file while reading it. */);
5811 DEFVAR_PER_BUFFER ("direction-reversed",
5812 &current_buffer->direction_reversed, Qnil,
5813 doc: /* Non-nil means set beginning of lines at the right edge of the window.
5814 See also the variable `bidi-display-reordering'. */);
5816 DEFVAR_PER_BUFFER ("bidi-display-reordering",
5817 &current_buffer->bidi_display_reordering, Qnil,
5818 doc: /* Non-nil means reorder bidirectional text for display in the visual order.
5819 See also the variable `direction-reversed'. */);
5821 DEFVAR_PER_BUFFER ("bidi-paragraph-direction",
5822 &current_buffer->bidi_paragraph_direction, Qnil,
5823 doc: /* *If non-nil, forces directionality of text paragraphs in the buffer.
5825 If this is nil (the default), the direction of each paragraph is
5826 determined by the first strong directional character of its text.
5827 The values of `right-to-left' and `left-to-right' override that.
5828 Any other value is treated as nil.
5830 This variable has no effect unless the buffer's value of
5831 \`bidi-display-reordering' is non-nil. */);
5833 DEFVAR_PER_BUFFER ("truncate-lines", &current_buffer->truncate_lines, Qnil,
5834 doc: /* *Non-nil means do not display continuation lines.
5835 Instead, give each line of text just one screen line.
5837 Note that this is overridden by the variable
5838 `truncate-partial-width-windows' if that variable is non-nil
5839 and this buffer is not full-frame width. */);
5841 DEFVAR_PER_BUFFER ("word-wrap", &current_buffer->word_wrap, Qnil,
5842 doc: /* *Non-nil means to use word-wrapping for continuation lines.
5843 When word-wrapping is on, continuation lines are wrapped at the space
5844 or tab character nearest to the right window edge.
5845 If nil, continuation lines are wrapped at the right screen edge.
5847 This variable has no effect if long lines are truncated (see
5848 `truncate-lines' and `truncate-partial-width-windows'). If you use
5849 word-wrapping, you might want to reduce the value of
5850 `truncate-partial-width-windows', since wrapping can make text readable
5851 in narrower windows. */);
5853 #ifdef DOS_NT
5854 DEFVAR_PER_BUFFER ("buffer-file-type", &current_buffer->buffer_file_type,
5855 Qnil,
5856 doc: /* Non-nil if the visited file is a binary file.
5857 This variable is meaningful on MS-DOG and Windows NT.
5858 On those systems, it is automatically local in every buffer.
5859 On other systems, this variable is normally always nil. */);
5860 #endif
5862 DEFVAR_PER_BUFFER ("default-directory", &current_buffer->directory,
5863 make_number (Lisp_String),
5864 doc: /* Name of default directory of current buffer. Should end with slash.
5865 To interactively change the default directory, use command `cd'. */);
5867 DEFVAR_PER_BUFFER ("auto-fill-function", &current_buffer->auto_fill_function,
5868 Qnil,
5869 doc: /* Function called (if non-nil) to perform auto-fill.
5870 It is called after self-inserting any character specified in
5871 the `auto-fill-chars' table.
5872 NOTE: This variable is not a hook;
5873 its value may not be a list of functions. */);
5875 DEFVAR_PER_BUFFER ("buffer-file-name", &current_buffer->filename,
5876 make_number (Lisp_String),
5877 doc: /* Name of file visited in current buffer, or nil if not visiting a file. */);
5879 DEFVAR_PER_BUFFER ("buffer-file-truename", &current_buffer->file_truename,
5880 make_number (Lisp_String),
5881 doc: /* Abbreviated truename of file visited in current buffer, or nil if none.
5882 The truename of a file is calculated by `file-truename'
5883 and then abbreviated with `abbreviate-file-name'. */);
5885 DEFVAR_PER_BUFFER ("buffer-auto-save-file-name",
5886 &current_buffer->auto_save_file_name,
5887 make_number (Lisp_String),
5888 doc: /* Name of file for auto-saving current buffer.
5889 If it is nil, that means don't auto-save this buffer. */);
5891 DEFVAR_PER_BUFFER ("buffer-read-only", &current_buffer->read_only, Qnil,
5892 doc: /* Non-nil if this buffer is read-only. */);
5894 DEFVAR_PER_BUFFER ("buffer-backed-up", &current_buffer->backed_up, Qnil,
5895 doc: /* Non-nil if this buffer's file has been backed up.
5896 Backing up is done before the first time the file is saved. */);
5898 DEFVAR_PER_BUFFER ("buffer-saved-size", &current_buffer->save_length,
5899 make_number (LISP_INT_TAG),
5900 doc: /* Length of current buffer when last read in, saved or auto-saved.
5901 0 initially.
5902 -1 means auto-saving turned off until next real save.
5904 If you set this to -2, that means don't turn off auto-saving in this buffer
5905 if its text size shrinks. If you use `buffer-swap-text' on a buffer,
5906 you probably should set this to -2 in that buffer. */);
5908 DEFVAR_PER_BUFFER ("selective-display", &current_buffer->selective_display,
5909 Qnil,
5910 doc: /* Non-nil enables selective display.
5911 An integer N as value means display only lines
5912 that start with less than N columns of space.
5913 A value of t means that the character ^M makes itself and
5914 all the rest of the line invisible; also, when saving the buffer
5915 in a file, save the ^M as a newline. */);
5917 #ifndef old
5918 DEFVAR_PER_BUFFER ("selective-display-ellipses",
5919 &current_buffer->selective_display_ellipses,
5920 Qnil,
5921 doc: /* Non-nil means display ... on previous line when a line is invisible. */);
5922 #endif
5924 DEFVAR_PER_BUFFER ("overwrite-mode", &current_buffer->overwrite_mode, Qnil,
5925 doc: /* Non-nil if self-insertion should replace existing text.
5926 The value should be one of `overwrite-mode-textual',
5927 `overwrite-mode-binary', or nil.
5928 If it is `overwrite-mode-textual', self-insertion still
5929 inserts at the end of a line, and inserts when point is before a tab,
5930 until the tab is filled in.
5931 If `overwrite-mode-binary', self-insertion replaces newlines and tabs too. */);
5933 DEFVAR_PER_BUFFER ("buffer-display-table", &current_buffer->display_table,
5934 Qnil,
5935 doc: /* Display table that controls display of the contents of current buffer.
5937 If this variable is nil, the value of `standard-display-table' is used.
5938 Each window can have its own, overriding display table, see
5939 `set-window-display-table' and `window-display-table'.
5941 The display table is a char-table created with `make-display-table'.
5942 A char-table is an array indexed by character codes. Normal array
5943 primitives `aref' and `aset' can be used to access elements of a char-table.
5945 Each of the char-table elements control how to display the corresponding
5946 text character: the element at index C in the table says how to display
5947 the character whose code is C. Each element should be a vector of
5948 characters or nil. The value nil means display the character in the
5949 default fashion; otherwise, the characters from the vector are delivered
5950 to the screen instead of the original character.
5952 For example, (aset buffer-display-table ?X [?Y]) tells Emacs
5953 to display a capital Y instead of each X character.
5955 In addition, a char-table has six extra slots to control the display of:
5957 the end of a truncated screen line (extra-slot 0, a single character);
5958 the end of a continued line (extra-slot 1, a single character);
5959 the escape character used to display character codes in octal
5960 (extra-slot 2, a single character);
5961 the character used as an arrow for control characters (extra-slot 3,
5962 a single character);
5963 the decoration indicating the presence of invisible lines (extra-slot 4,
5964 a vector of characters);
5965 the character used to draw the border between side-by-side windows
5966 (extra-slot 5, a single character).
5968 See also the functions `display-table-slot' and `set-display-table-slot'. */);
5970 DEFVAR_PER_BUFFER ("left-margin-width", &current_buffer->left_margin_cols,
5971 Qnil,
5972 doc: /* *Width of left marginal area for display of a buffer.
5973 A value of nil means no marginal area. */);
5975 DEFVAR_PER_BUFFER ("right-margin-width", &current_buffer->right_margin_cols,
5976 Qnil,
5977 doc: /* *Width of right marginal area for display of a buffer.
5978 A value of nil means no marginal area. */);
5980 DEFVAR_PER_BUFFER ("left-fringe-width", &current_buffer->left_fringe_width,
5981 Qnil,
5982 doc: /* *Width of this buffer's left fringe (in pixels).
5983 A value of 0 means no left fringe is shown in this buffer's window.
5984 A value of nil means to use the left fringe width from the window's frame. */);
5986 DEFVAR_PER_BUFFER ("right-fringe-width", &current_buffer->right_fringe_width,
5987 Qnil,
5988 doc: /* *Width of this buffer's right fringe (in pixels).
5989 A value of 0 means no right fringe is shown in this buffer's window.
5990 A value of nil means to use the right fringe width from the window's frame. */);
5992 DEFVAR_PER_BUFFER ("fringes-outside-margins", &current_buffer->fringes_outside_margins,
5993 Qnil,
5994 doc: /* *Non-nil means to display fringes outside display margins.
5995 A value of nil means to display fringes between margins and buffer text. */);
5997 DEFVAR_PER_BUFFER ("scroll-bar-width", &current_buffer->scroll_bar_width,
5998 Qnil,
5999 doc: /* *Width of this buffer's scroll bars in pixels.
6000 A value of nil means to use the scroll bar width from the window's frame. */);
6002 DEFVAR_PER_BUFFER ("vertical-scroll-bar", &current_buffer->vertical_scroll_bar_type,
6003 Qnil,
6004 doc: /* *Position of this buffer's vertical scroll bar.
6005 The value takes effect whenever you tell a window to display this buffer;
6006 for instance, with `set-window-buffer' or when `display-buffer' displays it.
6008 A value of `left' or `right' means put the vertical scroll bar at that side
6009 of the window; a value of nil means don't show any vertical scroll bars.
6010 A value of t (the default) means do whatever the window's frame specifies. */);
6012 DEFVAR_PER_BUFFER ("indicate-empty-lines",
6013 &current_buffer->indicate_empty_lines, Qnil,
6014 doc: /* *Visually indicate empty lines after the buffer end.
6015 If non-nil, a bitmap is displayed in the left fringe of a window on
6016 window-systems. */);
6018 DEFVAR_PER_BUFFER ("indicate-buffer-boundaries",
6019 &current_buffer->indicate_buffer_boundaries, Qnil,
6020 doc: /* *Visually indicate buffer boundaries and scrolling.
6021 If non-nil, the first and last line of the buffer are marked in the fringe
6022 of a window on window-systems with angle bitmaps, or if the window can be
6023 scrolled, the top and bottom line of the window are marked with up and down
6024 arrow bitmaps.
6026 If value is a symbol `left' or `right', both angle and arrow bitmaps
6027 are displayed in the left or right fringe, resp. Any other value
6028 that doesn't look like an alist means display the angle bitmaps in
6029 the left fringe but no arrows.
6031 You can exercise more precise control by using an alist as the
6032 value. Each alist element (INDICATOR . POSITION) specifies
6033 where to show one of the indicators. INDICATOR is one of `top',
6034 `bottom', `up', `down', or t, which specifies the default position,
6035 and POSITION is one of `left', `right', or nil, meaning do not show
6036 this indicator.
6038 For example, ((top . left) (t . right)) places the top angle bitmap in
6039 left fringe, the bottom angle bitmap in right fringe, and both arrow
6040 bitmaps in right fringe. To show just the angle bitmaps in the left
6041 fringe, but no arrow bitmaps, use ((top . left) (bottom . left)). */);
6043 DEFVAR_PER_BUFFER ("fringe-indicator-alist",
6044 &current_buffer->fringe_indicator_alist, Qnil,
6045 doc: /* *Mapping from logical to physical fringe indicator bitmaps.
6046 The value is an alist where each element (INDICATOR . BITMAPS)
6047 specifies the fringe bitmaps used to display a specific logical
6048 fringe indicator.
6050 INDICATOR specifies the logical indicator type which is one of the
6051 following symbols: `truncation' , `continuation', `overlay-arrow',
6052 `top', `bottom', `up', `down', `one-line', `empty-line', or `unknown'.
6054 BITMAPS is list of symbols (LEFT RIGHT [LEFT1 RIGHT1]) which specifies
6055 the actual bitmap shown in the left or right fringe for the logical
6056 indicator. LEFT and RIGHT are the bitmaps shown in the left and/or
6057 right fringe for the specific indicator. The LEFT1 or RIGHT1 bitmaps
6058 are used only for the `bottom' and `one-line' indicators when the last
6059 \(only) line in has no final newline. BITMAPS may also be a single
6060 symbol which is used in both left and right fringes. */);
6062 DEFVAR_PER_BUFFER ("fringe-cursor-alist",
6063 &current_buffer->fringe_cursor_alist, Qnil,
6064 doc: /* *Mapping from logical to physical fringe cursor bitmaps.
6065 The value is an alist where each element (CURSOR . BITMAP)
6066 specifies the fringe bitmaps used to display a specific logical
6067 cursor type in the fringe.
6069 CURSOR specifies the logical cursor type which is one of the following
6070 symbols: `box' , `hollow', `bar', `hbar', or `hollow-small'. The last
6071 one is used to show a hollow cursor on narrow lines display lines
6072 where the normal hollow cursor will not fit.
6074 BITMAP is the corresponding fringe bitmap shown for the logical
6075 cursor type. */);
6077 DEFVAR_PER_BUFFER ("scroll-up-aggressively",
6078 &current_buffer->scroll_up_aggressively, Qnil,
6079 doc: /* How far to scroll windows upward.
6080 If you move point off the bottom, the window scrolls automatically.
6081 This variable controls how far it scrolls. The value nil, the default,
6082 means scroll to center point. A fraction means scroll to put point
6083 that fraction of the window's height from the bottom of the window.
6084 When the value is 0.0, point goes at the bottom line, which in the
6085 simple case that you moved off with C-f means scrolling just one line.
6086 1.0 means point goes at the top, so that in that simple case, the
6087 window scrolls by a full window height. Meaningful values are
6088 between 0.0 and 1.0, inclusive. */);
6090 DEFVAR_PER_BUFFER ("scroll-down-aggressively",
6091 &current_buffer->scroll_down_aggressively, Qnil,
6092 doc: /* How far to scroll windows downward.
6093 If you move point off the top, the window scrolls automatically.
6094 This variable controls how far it scrolls. The value nil, the default,
6095 means scroll to center point. A fraction means scroll to put point
6096 that fraction of the window's height from the top of the window.
6097 When the value is 0.0, point goes at the top line, which in the
6098 simple case that you moved off with C-b means scrolling just one line.
6099 1.0 means point goes at the bottom, so that in that simple case, the
6100 window scrolls by a full window height. Meaningful values are
6101 between 0.0 and 1.0, inclusive. */);
6103 /*DEFVAR_LISP ("debug-check-symbol", &Vcheck_symbol,
6104 "Don't ask.");
6107 DEFVAR_LISP ("before-change-functions", &Vbefore_change_functions,
6108 doc: /* List of functions to call before each text change.
6109 Two arguments are passed to each function: the positions of
6110 the beginning and end of the range of old text to be changed.
6111 \(For an insertion, the beginning and end are at the same place.)
6112 No information is given about the length of the text after the change.
6114 Buffer changes made while executing the `before-change-functions'
6115 don't call any before-change or after-change functions.
6116 That's because these variables are temporarily set to nil.
6117 As a result, a hook function cannot straightforwardly alter the
6118 value of these variables. See the Emacs Lisp manual for a way of
6119 accomplishing an equivalent result by using other variables.
6121 If an unhandled error happens in running these functions,
6122 the variable's value remains nil. That prevents the error
6123 from happening repeatedly and making Emacs nonfunctional. */);
6124 Vbefore_change_functions = Qnil;
6126 DEFVAR_LISP ("after-change-functions", &Vafter_change_functions,
6127 doc: /* List of functions to call after each text change.
6128 Three arguments are passed to each function: the positions of
6129 the beginning and end of the range of changed text,
6130 and the length in bytes of the pre-change text replaced by that range.
6131 \(For an insertion, the pre-change length is zero;
6132 for a deletion, that length is the number of bytes deleted,
6133 and the post-change beginning and end are at the same place.)
6135 Buffer changes made while executing the `after-change-functions'
6136 don't call any before-change or after-change functions.
6137 That's because these variables are temporarily set to nil.
6138 As a result, a hook function cannot straightforwardly alter the
6139 value of these variables. See the Emacs Lisp manual for a way of
6140 accomplishing an equivalent result by using other variables.
6142 If an unhandled error happens in running these functions,
6143 the variable's value remains nil. That prevents the error
6144 from happening repeatedly and making Emacs nonfunctional. */);
6145 Vafter_change_functions = Qnil;
6147 DEFVAR_LISP ("first-change-hook", &Vfirst_change_hook,
6148 doc: /* A list of functions to call before changing a buffer which is unmodified.
6149 The functions are run using the `run-hooks' function. */);
6150 Vfirst_change_hook = Qnil;
6152 DEFVAR_PER_BUFFER ("buffer-undo-list", &current_buffer->undo_list, Qnil,
6153 doc: /* List of undo entries in current buffer.
6154 Recent changes come first; older changes follow newer.
6156 An entry (BEG . END) represents an insertion which begins at
6157 position BEG and ends at position END.
6159 An entry (TEXT . POSITION) represents the deletion of the string TEXT
6160 from (abs POSITION). If POSITION is positive, point was at the front
6161 of the text being deleted; if negative, point was at the end.
6163 An entry (t HIGH . LOW) indicates that the buffer previously had
6164 \"unmodified\" status. HIGH and LOW are the high and low 16-bit portions
6165 of the visited file's modification time, as of that time. If the
6166 modification time of the most recent save is different, this entry is
6167 obsolete.
6169 An entry (nil PROPERTY VALUE BEG . END) indicates that a text property
6170 was modified between BEG and END. PROPERTY is the property name,
6171 and VALUE is the old value.
6173 An entry (apply FUN-NAME . ARGS) means undo the change with
6174 \(apply FUN-NAME ARGS).
6176 An entry (apply DELTA BEG END FUN-NAME . ARGS) supports selective undo
6177 in the active region. BEG and END is the range affected by this entry
6178 and DELTA is the number of bytes added or deleted in that range by
6179 this change.
6181 An entry (MARKER . DISTANCE) indicates that the marker MARKER
6182 was adjusted in position by the offset DISTANCE (an integer).
6184 An entry of the form POSITION indicates that point was at the buffer
6185 location given by the integer. Undoing an entry of this form places
6186 point at POSITION.
6188 Entries with value `nil' mark undo boundaries. The undo command treats
6189 the changes between two undo boundaries as a single step to be undone.
6191 If the value of the variable is t, undo information is not recorded. */);
6193 DEFVAR_PER_BUFFER ("mark-active", &current_buffer->mark_active, Qnil,
6194 doc: /* Non-nil means the mark and region are currently active in this buffer. */);
6196 DEFVAR_PER_BUFFER ("cache-long-line-scans", &current_buffer->cache_long_line_scans, Qnil,
6197 doc: /* Non-nil means that Emacs should use caches to handle long lines more quickly.
6199 Normally, the line-motion functions work by scanning the buffer for
6200 newlines. Columnar operations (like `move-to-column' and
6201 `compute-motion') also work by scanning the buffer, summing character
6202 widths as they go. This works well for ordinary text, but if the
6203 buffer's lines are very long (say, more than 500 characters), these
6204 motion functions will take longer to execute. Emacs may also take
6205 longer to update the display.
6207 If `cache-long-line-scans' is non-nil, these motion functions cache the
6208 results of their scans, and consult the cache to avoid rescanning
6209 regions of the buffer until the text is modified. The caches are most
6210 beneficial when they prevent the most searching---that is, when the
6211 buffer contains long lines and large regions of characters with the
6212 same, fixed screen width.
6214 When `cache-long-line-scans' is non-nil, processing short lines will
6215 become slightly slower (because of the overhead of consulting the
6216 cache), and the caches will use memory roughly proportional to the
6217 number of newlines and characters whose screen width varies.
6219 The caches require no explicit maintenance; their accuracy is
6220 maintained internally by the Emacs primitives. Enabling or disabling
6221 the cache should not affect the behavior of any of the motion
6222 functions; it should only affect their performance. */);
6224 DEFVAR_PER_BUFFER ("point-before-scroll", &current_buffer->point_before_scroll, Qnil,
6225 doc: /* Value of point before the last series of scroll operations, or nil. */);
6227 DEFVAR_PER_BUFFER ("buffer-file-format", &current_buffer->file_format, Qnil,
6228 doc: /* List of formats to use when saving this buffer.
6229 Formats are defined by `format-alist'. This variable is
6230 set when a file is visited. */);
6232 DEFVAR_PER_BUFFER ("buffer-auto-save-file-format",
6233 &current_buffer->auto_save_file_format, Qnil,
6234 doc: /* *Format in which to write auto-save files.
6235 Should be a list of symbols naming formats that are defined in `format-alist'.
6236 If it is t, which is the default, auto-save files are written in the
6237 same format as a regular save would use. */);
6239 DEFVAR_PER_BUFFER ("buffer-invisibility-spec",
6240 &current_buffer->invisibility_spec, Qnil,
6241 doc: /* Invisibility spec of this buffer.
6242 The default is t, which means that text is invisible
6243 if it has a non-nil `invisible' property.
6244 If the value is a list, a text character is invisible if its `invisible'
6245 property is an element in that list (or is a list with members in common).
6246 If an element is a cons cell of the form (PROP . ELLIPSIS),
6247 then characters with property value PROP are invisible,
6248 and they have an ellipsis as well if ELLIPSIS is non-nil. */);
6250 DEFVAR_PER_BUFFER ("buffer-display-count",
6251 &current_buffer->display_count, Qnil,
6252 doc: /* A number incremented each time this buffer is displayed in a window.
6253 The function `set-window-buffer' increments it. */);
6255 DEFVAR_PER_BUFFER ("buffer-display-time",
6256 &current_buffer->display_time, Qnil,
6257 doc: /* Time stamp updated each time this buffer is displayed in a window.
6258 The function `set-window-buffer' updates this variable
6259 to the value obtained by calling `current-time'.
6260 If the buffer has never been shown in a window, the value is nil. */);
6262 DEFVAR_LISP ("transient-mark-mode", &Vtransient_mark_mode,
6263 doc: /* */);
6264 Vtransient_mark_mode = Qnil;
6265 /* The docstring is in simple.el. If we put it here, it would be
6266 overwritten when transient-mark-mode is defined using
6267 define-minor-mode. */
6269 DEFVAR_LISP ("inhibit-read-only", &Vinhibit_read_only,
6270 doc: /* *Non-nil means disregard read-only status of buffers or characters.
6271 If the value is t, disregard `buffer-read-only' and all `read-only'
6272 text properties. If the value is a list, disregard `buffer-read-only'
6273 and disregard a `read-only' text property if the property value
6274 is a member of the list. */);
6275 Vinhibit_read_only = Qnil;
6277 DEFVAR_PER_BUFFER ("cursor-type", &current_buffer->cursor_type, Qnil,
6278 doc: /* Cursor to use when this buffer is in the selected window.
6279 Values are interpreted as follows:
6281 t use the cursor specified for the frame
6282 nil don't display a cursor
6283 box display a filled box cursor
6284 hollow display a hollow box cursor
6285 bar display a vertical bar cursor with default width
6286 (bar . WIDTH) display a vertical bar cursor with width WIDTH
6287 hbar display a horizontal bar cursor with default height
6288 (hbar . HEIGHT) display a horizontal bar cursor with height HEIGHT
6289 ANYTHING ELSE display a hollow box cursor
6291 When the buffer is displayed in a non-selected window, the
6292 cursor's appearance is instead controlled by the variable
6293 `cursor-in-non-selected-windows'. */);
6295 DEFVAR_PER_BUFFER ("line-spacing",
6296 &current_buffer->extra_line_spacing, Qnil,
6297 doc: /* Additional space to put between lines when displaying a buffer.
6298 The space is measured in pixels, and put below lines on graphic displays,
6299 see `display-graphic-p'.
6300 If value is a floating point number, it specifies the spacing relative
6301 to the default frame line height. A value of nil means add no extra space. */);
6303 DEFVAR_PER_BUFFER ("cursor-in-non-selected-windows",
6304 &current_buffer->cursor_in_non_selected_windows, Qnil,
6305 doc: /* *Cursor type to display in non-selected windows.
6306 The value t means to use hollow box cursor. See `cursor-type' for other values. */);
6308 DEFVAR_LISP ("kill-buffer-query-functions", &Vkill_buffer_query_functions,
6309 doc: /* List of functions called with no args to query before killing a buffer.
6310 The buffer being killed will be current while the functions are running.
6311 If any of them returns nil, the buffer is not killed. */);
6312 Vkill_buffer_query_functions = Qnil;
6314 DEFVAR_LISP ("change-major-mode-hook", &Vchange_major_mode_hook,
6315 doc: /* Normal hook run before changing the major mode of a buffer.
6316 The function `kill-all-local-variables' runs this before doing anything else. */);
6317 Vchange_major_mode_hook = Qnil;
6318 Qchange_major_mode_hook = intern_c_string ("change-major-mode-hook");
6319 staticpro (&Qchange_major_mode_hook);
6321 defsubr (&Sbuffer_live_p);
6322 defsubr (&Sbuffer_list);
6323 defsubr (&Sget_buffer);
6324 defsubr (&Sget_file_buffer);
6325 defsubr (&Sget_buffer_create);
6326 defsubr (&Smake_indirect_buffer);
6327 defsubr (&Sgenerate_new_buffer_name);
6328 defsubr (&Sbuffer_name);
6329 /*defsubr (&Sbuffer_number);*/
6330 defsubr (&Sbuffer_file_name);
6331 defsubr (&Sbuffer_base_buffer);
6332 defsubr (&Sbuffer_local_value);
6333 defsubr (&Sbuffer_local_variables);
6334 defsubr (&Sbuffer_modified_p);
6335 defsubr (&Sset_buffer_modified_p);
6336 defsubr (&Sbuffer_modified_tick);
6337 defsubr (&Sbuffer_chars_modified_tick);
6338 defsubr (&Srename_buffer);
6339 defsubr (&Sother_buffer);
6340 defsubr (&Sbuffer_enable_undo);
6341 defsubr (&Skill_buffer);
6342 defsubr (&Sset_buffer_major_mode);
6343 defsubr (&Sswitch_to_buffer);
6344 defsubr (&Scurrent_buffer);
6345 defsubr (&Sset_buffer);
6346 defsubr (&Sbarf_if_buffer_read_only);
6347 defsubr (&Sbury_buffer);
6348 defsubr (&Serase_buffer);
6349 defsubr (&Sbuffer_swap_text);
6350 defsubr (&Sset_buffer_multibyte);
6351 defsubr (&Skill_all_local_variables);
6353 defsubr (&Soverlayp);
6354 defsubr (&Smake_overlay);
6355 defsubr (&Sdelete_overlay);
6356 defsubr (&Smove_overlay);
6357 defsubr (&Soverlay_start);
6358 defsubr (&Soverlay_end);
6359 defsubr (&Soverlay_buffer);
6360 defsubr (&Soverlay_properties);
6361 defsubr (&Soverlays_at);
6362 defsubr (&Soverlays_in);
6363 defsubr (&Snext_overlay_change);
6364 defsubr (&Sprevious_overlay_change);
6365 defsubr (&Soverlay_recenter);
6366 defsubr (&Soverlay_lists);
6367 defsubr (&Soverlay_get);
6368 defsubr (&Soverlay_put);
6369 defsubr (&Srestore_buffer_modified_p);
6372 void
6373 keys_of_buffer ()
6375 initial_define_key (control_x_map, 'b', "switch-to-buffer");
6376 initial_define_key (control_x_map, 'k', "kill-buffer");
6378 /* This must not be in syms_of_buffer, because Qdisabled is not
6379 initialized when that function gets called. */
6380 Fput (intern_c_string ("erase-buffer"), Qdisabled, Qt);
6383 /* arch-tag: e48569bf-69a9-4b65-a23b-8e68769436e1
6384 (do not change this comment) */