Use ALLOCATE_PSEUDOVECTOR.
[emacs.git] / src / buffer.c
blobe144a8bfaf25a4bad854092b6d09c4da37b20e17
1 /* Buffer manipulation primitives for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994,
3 1995, 1997, 1998, 1999, 2000, 2001, 2002,
4 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
5 Free Software Foundation, Inc.
7 This file is part of GNU Emacs.
9 GNU Emacs is free software: you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
14 GNU Emacs is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
22 #include <config.h>
24 #include <sys/types.h>
25 #include <sys/stat.h>
26 #include <sys/param.h>
27 #include <errno.h>
28 #include <stdio.h>
29 #include <setjmp.h>
31 #ifndef USE_CRT_DLL
32 extern int errno;
33 #endif
36 #ifdef HAVE_UNISTD_H
37 #include <unistd.h>
38 #endif
40 #include <pthread.h>
42 #include "lisp.h"
43 #include "intervals.h"
44 #include "window.h"
45 #include "commands.h"
46 #include "buffer.h"
47 #include "character.h"
48 #include "region-cache.h"
49 #include "indent.h"
50 #include "blockinput.h"
51 #include "keyboard.h"
52 #include "keymap.h"
53 #include "frame.h"
55 /* First buffer in chain of all buffers (in reverse order of creation).
56 Threaded through ->next. */
58 struct buffer *all_buffers;
60 /* This structure holds the default values of the buffer-local variables
61 defined with DEFVAR_PER_BUFFER, that have special slots in each buffer.
62 The default value occupies the same slot in this structure
63 as an individual buffer's value occupies in that buffer.
64 Setting the default value also goes through the alist of buffers
65 and stores into each buffer that does not say it has a local value. */
67 DECL_ALIGN (struct buffer, buffer_defaults);
69 /* A Lisp_Object pointer to the above, used for staticpro */
71 static Lisp_Object Vbuffer_defaults;
73 /* This structure marks which slots in a buffer have corresponding
74 default values in buffer_defaults.
75 Each such slot has a nonzero value in this structure.
76 The value has only one nonzero bit.
78 When a buffer has its own local value for a slot,
79 the entry for that slot (found in the same slot in this structure)
80 is turned on in the buffer's local_flags array.
82 If a slot in this structure is -1, then even though there may
83 be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
84 and the corresponding slot in buffer_defaults is not used.
86 If a slot is -2, then there is no DEFVAR_PER_BUFFER for it,
87 but there is a default value which is copied into each buffer.
89 If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is
90 zero, that is a bug */
92 struct buffer buffer_local_flags;
94 /* This structure holds the names of symbols whose values may be
95 buffer-local. It is indexed and accessed in the same way as the above. */
97 DECL_ALIGN (struct buffer, buffer_local_symbols);
99 /* A Lisp_Object pointer to the above, used for staticpro */
100 static Lisp_Object Vbuffer_local_symbols;
102 /* Flags indicating which built-in buffer-local variables
103 are permanent locals. */
104 static char buffer_permanent_local_flags[MAX_PER_BUFFER_VARS];
106 /* Number of per-buffer variables used. */
108 int last_per_buffer_idx;
110 EXFUN (Fset_buffer, 1);
111 void set_buffer_internal P_ ((struct buffer *b));
112 void set_buffer_internal_1 P_ ((struct buffer *b));
113 static void call_overlay_mod_hooks P_ ((Lisp_Object list, Lisp_Object overlay,
114 int after, Lisp_Object arg1,
115 Lisp_Object arg2, Lisp_Object arg3));
116 static void swap_out_buffer_local_variables P_ ((struct buffer *b));
117 static void reset_buffer_local_variables P_ ((struct buffer *b, int permanent_too));
119 /* Alist of all buffer names vs the buffers. */
120 /* This used to be a variable, but is no longer,
121 to prevent lossage due to user rplac'ing this alist or its elements. */
122 Lisp_Object Vbuffer_alist;
124 /* Functions to call before and after each text change. */
125 Lisp_Object impl_Vbefore_change_functions;
126 Lisp_Object impl_Vafter_change_functions;
128 Lisp_Object impl_Vtransient_mark_mode;
130 /* t means ignore all read-only text properties.
131 A list means ignore such a property if its value is a member of the list.
132 Any non-nil value means ignore buffer-read-only. */
133 Lisp_Object impl_Vinhibit_read_only;
135 /* List of functions to call that can query about killing a buffer.
136 If any of these functions returns nil, we don't kill it. */
137 Lisp_Object impl_Vkill_buffer_query_functions;
138 Lisp_Object Qkill_buffer_query_functions;
140 /* Hook run before changing a major mode. */
141 Lisp_Object impl_Vchange_major_mode_hook, Qchange_major_mode_hook;
143 /* List of functions to call before changing an unmodified buffer. */
144 Lisp_Object impl_Vfirst_change_hook;
146 Lisp_Object Qfirst_change_hook;
147 Lisp_Object Qbefore_change_functions;
148 Lisp_Object Qafter_change_functions;
149 Lisp_Object Qucs_set_table_for_input;
151 /* If nonzero, all modification hooks are suppressed. */
152 int inhibit_modification_hooks;
154 Lisp_Object Qfundamental_mode, Qmode_class, Qpermanent_local;
155 Lisp_Object Qpermanent_local_hook;
157 Lisp_Object Qprotected_field;
159 Lisp_Object QSFundamental; /* A string "Fundamental" */
161 Lisp_Object Qkill_buffer_hook;
163 Lisp_Object Qget_file_buffer;
165 Lisp_Object Qoverlayp;
167 Lisp_Object Qpriority, Qwindow, Qevaporate, Qbefore_string, Qafter_string;
169 Lisp_Object Qmodification_hooks;
170 Lisp_Object Qinsert_in_front_hooks;
171 Lisp_Object Qinsert_behind_hooks;
173 static void alloc_buffer_text P_ ((struct buffer *, size_t));
174 static void free_buffer_text P_ ((struct buffer *b));
175 static struct Lisp_Overlay * copy_overlays P_ ((struct buffer *, struct Lisp_Overlay *));
176 static void modify_overlay P_ ((struct buffer *, EMACS_INT, EMACS_INT));
177 static Lisp_Object buffer_lisp_local_variables P_ ((struct buffer *));
179 extern char * emacs_strerror P_ ((int));
181 /* For debugging; temporary. See set_buffer_internal. */
182 /* Lisp_Object Qlisp_mode, Vcheck_symbol; */
184 void
185 nsberror (spec)
186 Lisp_Object spec;
188 if (STRINGP (spec))
189 error ("No buffer named %s", SDATA (spec));
190 error ("Invalid buffer argument");
193 DEFUN ("buffer-live-p", Fbuffer_live_p, Sbuffer_live_p, 1, 1, 0,
194 doc: /* Return non-nil if OBJECT is a buffer which has not been killed.
195 Value is nil if OBJECT is not a buffer or if it has been killed. */)
196 (object)
197 Lisp_Object object;
199 return ((BUFFERP (object) && ! NILP (BUF_NAME (XBUFFER (object))))
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 (BUF_FILENAME (XBUFFER (buf)))) continue;
309 tem = Fstring_equal (BUF_FILENAME (XBUFFER (buf)), 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 (BUF_FILE_TRUENAME (XBUFFER (buf)))) continue;
327 tem = Fstring_equal (BUF_FILE_TRUENAME (XBUFFER (buf)), filename);
328 if (!NILP (tem))
329 return buf;
331 return Qnil;
334 DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 1, 0,
335 doc: /* Return the buffer specified by BUFFER-OR-NAME, creating a new one if needed.
336 If BUFFER-OR-NAME is a string and a live buffer with that name exists,
337 return that buffer. If no such buffer exists, create a new buffer with
338 that name and return it. If BUFFER-OR-NAME starts with a space, the new
339 buffer does not keep undo information.
341 If BUFFER-OR-NAME is a buffer instead of a string, return it as given,
342 even if it is dead. The return value is never nil. */)
343 (buffer_or_name)
344 register Lisp_Object buffer_or_name;
346 register Lisp_Object buffer, name;
347 register struct buffer *b;
349 buffer = Fget_buffer (buffer_or_name);
350 if (!NILP (buffer))
351 return buffer;
353 if (SCHARS (buffer_or_name) == 0)
354 error ("Empty string for buffer name is not allowed");
356 b = allocate_buffer ();
358 /* An ordinary buffer uses its own struct buffer_text. */
359 b->text = &b->own_text;
360 b->base_buffer = 0;
362 BUF_GAP_SIZE (b) = 20;
363 BLOCK_INPUT;
364 /* We allocate extra 1-byte at the tail and keep it always '\0' for
365 anchoring a search. */
366 alloc_buffer_text (b, BUF_GAP_SIZE (b) + 1);
367 UNBLOCK_INPUT;
368 if (! BUF_BEG_ADDR (b))
369 buffer_memory_full ();
371 BUF_PT (b) = BEG;
372 BUF_GPT (b) = BEG;
373 BUF_BEGV (b) = BEG;
374 BUF_ZV (b) = BEG;
375 BUF_Z (b) = BEG;
376 BUF_PT_BYTE (b) = BEG_BYTE;
377 BUF_GPT_BYTE (b) = BEG_BYTE;
378 BUF_BEGV_BYTE (b) = BEG_BYTE;
379 BUF_ZV_BYTE (b) = BEG_BYTE;
380 BUF_Z_BYTE (b) = BEG_BYTE;
381 BUF_MODIFF (b) = 1;
382 BUF_CHARS_MODIFF (b) = 1;
383 BUF_OVERLAY_MODIFF (b) = 1;
384 BUF_SAVE_MODIFF (b) = 1;
385 BUF_INTERVALS (b) = 0;
386 BUF_UNCHANGED_MODIFIED (b) = 1;
387 BUF_OVERLAY_UNCHANGED_MODIFIED (b) = 1;
388 BUF_END_UNCHANGED (b) = 0;
389 BUF_BEG_UNCHANGED (b) = 0;
390 *(BUF_GPT_ADDR (b)) = *(BUF_Z_ADDR (b)) = 0; /* Put an anchor '\0'. */
392 b->newline_cache = 0;
393 b->width_run_cache = 0;
394 BUF_WIDTH_TABLE (b) = Qnil;
395 b->prevent_redisplay_optimizations_p = 1;
397 /* Put this on the chain of all buffers including killed ones. */
398 b->next = all_buffers;
399 all_buffers = b;
401 /* An ordinary buffer normally doesn't need markers
402 to handle BEGV and ZV. */
403 BUF_PT_MARKER (b) = Qnil;
404 BUF_BEGV_MARKER (b) = Qnil;
405 BUF_ZV_MARKER (b) = Qnil;
407 name = Fcopy_sequence (buffer_or_name);
408 STRING_SET_INTERVALS (name, NULL_INTERVAL);
409 BUF_NAME (b) = name;
411 BUF_UNDO_LIST (b) = (SREF (name, 0) != ' ') ? Qnil : Qt;
413 reset_buffer (b);
414 reset_buffer_local_variables (b, 1);
416 BUF_MARK (b) = Fmake_marker ();
417 BUF_MARKERS (b) = NULL;
418 BUF_NAME (b) = name;
419 b->owner = Qnil;
420 b->prev_owner = Qnil;
422 /* Put this in the alist of all live buffers. */
423 XSETBUFFER (buffer, b);
424 Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buffer), Qnil));
426 /* An error in calling the function here (should someone redefine it)
427 can lead to infinite regress until you run out of stack. rms
428 says that's not worth protecting against. */
429 if (!NILP (Ffboundp (Qucs_set_table_for_input)))
430 /* buffer is on buffer-alist, so no gcpro. */
431 call1 (Qucs_set_table_for_input, buffer);
433 return buffer;
437 /* Return a list of overlays which is a copy of the overlay list
438 LIST, but for buffer B. */
440 static struct Lisp_Overlay *
441 copy_overlays (b, list)
442 struct buffer *b;
443 struct Lisp_Overlay *list;
445 Lisp_Object buffer;
446 struct Lisp_Overlay *result = NULL, *tail = NULL;
448 XSETBUFFER (buffer, b);
450 for (; list; list = list->next)
452 Lisp_Object overlay, start, end, old_overlay;
453 EMACS_INT charpos;
455 XSETMISC (old_overlay, list);
456 charpos = marker_position (OVERLAY_START (old_overlay));
457 start = Fmake_marker ();
458 Fset_marker (start, make_number (charpos), buffer);
459 XMARKER (start)->insertion_type
460 = XMARKER (OVERLAY_START (old_overlay))->insertion_type;
462 charpos = marker_position (OVERLAY_END (old_overlay));
463 end = Fmake_marker ();
464 Fset_marker (end, make_number (charpos), buffer);
465 XMARKER (end)->insertion_type
466 = XMARKER (OVERLAY_END (old_overlay))->insertion_type;
468 overlay = allocate_misc ();
469 XMISCTYPE (overlay) = Lisp_Misc_Overlay;
470 OVERLAY_START (overlay) = start;
471 OVERLAY_END (overlay) = end;
472 OVERLAY_PLIST (overlay) = Fcopy_sequence (OVERLAY_PLIST (old_overlay));
473 XOVERLAY (overlay)->next = NULL;
475 if (tail)
476 tail = tail->next = XOVERLAY (overlay);
477 else
478 result = tail = XOVERLAY (overlay);
481 return result;
485 /* Clone per-buffer values of buffer FROM.
487 Buffer TO gets the same per-buffer values as FROM, with the
488 following exceptions: (1) TO's name is left untouched, (2) markers
489 are copied and made to refer to TO, and (3) overlay lists are
490 copied. */
492 static void
493 clone_per_buffer_values (from, to)
494 struct buffer *from, *to;
496 Lisp_Object to_buffer;
497 int offset;
499 XSETBUFFER (to_buffer, to);
501 /* buffer-local Lisp variables start at `undo_list',
502 tho only the ones from `name' on are GC'd normally. */
503 for (offset = PER_BUFFER_VAR_OFFSET (undo_list);
504 offset < sizeof *to;
505 offset += sizeof (Lisp_Object))
507 Lisp_Object obj;
509 /* Don't touch the `name' which should be unique for every buffer. */
510 if (offset == PER_BUFFER_VAR_OFFSET (name))
511 continue;
513 obj = PER_BUFFER_VALUE (from, offset);
514 if (MARKERP (obj))
516 struct Lisp_Marker *m = XMARKER (obj);
517 obj = Fmake_marker ();
518 XMARKER (obj)->insertion_type = m->insertion_type;
519 set_marker_both (obj, to_buffer, m->charpos, m->bytepos);
522 PER_BUFFER_VALUE (to, offset) = obj;
525 bcopy (from->local_flags, to->local_flags, sizeof to->local_flags);
527 to->overlays_before = copy_overlays (to, from->overlays_before);
528 to->overlays_after = copy_overlays (to, from->overlays_after);
530 /* Get (a copy of) the alist of Lisp-level local variables of FROM
531 and install that in TO. */
532 BUF_LOCAL_VAR_ALIST (to) = buffer_lisp_local_variables (from);
535 DEFUN ("make-indirect-buffer", Fmake_indirect_buffer, Smake_indirect_buffer,
536 2, 3,
537 "bMake indirect buffer (to buffer): \nBName of indirect buffer: ",
538 doc: /* Create and return an indirect buffer for buffer BASE-BUFFER, named NAME.
539 BASE-BUFFER should be a live buffer, or the name of an existing buffer.
540 NAME should be a string which is not the name of an existing buffer.
541 Optional argument CLONE non-nil means preserve BASE-BUFFER's state,
542 such as major and minor modes, in the indirect buffer.
543 CLONE nil means the indirect buffer's state is reset to default values. */)
544 (base_buffer, name, clone)
545 Lisp_Object base_buffer, name, clone;
547 Lisp_Object buf, tem;
548 struct buffer *b;
550 CHECK_STRING (name);
551 buf = Fget_buffer (name);
552 if (!NILP (buf))
553 error ("Buffer name `%s' is in use", SDATA (name));
555 tem = base_buffer;
556 base_buffer = Fget_buffer (base_buffer);
557 if (NILP (base_buffer))
558 error ("No such buffer: `%s'", SDATA (tem));
559 if (NILP (BUF_NAME (XBUFFER (base_buffer))))
560 error ("Base buffer has been killed");
562 if (SCHARS (name) == 0)
563 error ("Empty string for buffer name is not allowed");
565 b = allocate_buffer ();
567 b->base_buffer = (XBUFFER (base_buffer)->base_buffer
568 ? XBUFFER (base_buffer)->base_buffer
569 : XBUFFER (base_buffer));
571 /* Use the base buffer's text object. */
572 b->text = b->base_buffer->text;
574 BUF_BEGV (b) = BUF_BEGV (b->base_buffer);
575 BUF_ZV (b) = BUF_ZV (b->base_buffer);
576 BUF_PT (b) = BUF_PT (b->base_buffer);
577 BUF_BEGV_BYTE (b) = BUF_BEGV_BYTE (b->base_buffer);
578 BUF_ZV_BYTE (b) = BUF_ZV_BYTE (b->base_buffer);
579 BUF_PT_BYTE (b) = BUF_PT_BYTE (b->base_buffer);
581 b->newline_cache = 0;
582 b->width_run_cache = 0;
583 BUF_WIDTH_TABLE (b) = Qnil;
585 /* Put this on the chain of all buffers including killed ones. */
586 b->next = all_buffers;
587 all_buffers = b;
589 name = Fcopy_sequence (name);
590 STRING_SET_INTERVALS (name, NULL_INTERVAL);
591 BUF_NAME (b) = name;
593 reset_buffer (b);
594 reset_buffer_local_variables (b, 1);
596 /* Put this in the alist of all live buffers. */
597 XSETBUFFER (buf, b);
598 Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));
600 BUF_MARK (b) = Fmake_marker ();
601 BUF_NAME (b) = name;
602 b->owner = Qnil;
604 /* The multibyte status belongs to the base buffer. */
605 BUF_ENABLE_MULTIBYTE_CHARACTERS (b) = BUF_ENABLE_MULTIBYTE_CHARACTERS (b->base_buffer);
607 /* Make sure the base buffer has markers for its narrowing. */
608 if (NILP (BUF_PT_MARKER (b->base_buffer)))
610 BUF_PT_MARKER (b->base_buffer) = Fmake_marker ();
611 set_marker_both (BUF_PT_MARKER (b->base_buffer), base_buffer,
612 BUF_PT (b->base_buffer),
613 BUF_PT_BYTE (b->base_buffer));
615 if (NILP (BUF_BEGV_MARKER (b->base_buffer)))
617 BUF_BEGV_MARKER (b->base_buffer) = Fmake_marker ();
618 set_marker_both (BUF_BEGV_MARKER (b->base_buffer), base_buffer,
619 BUF_BEGV (b->base_buffer),
620 BUF_BEGV_BYTE (b->base_buffer));
622 if (NILP (BUF_ZV_MARKER (b->base_buffer)))
624 BUF_ZV_MARKER (b->base_buffer) = Fmake_marker ();
625 set_marker_both (BUF_ZV_MARKER (b->base_buffer), base_buffer,
626 BUF_ZV (b->base_buffer),
627 BUF_ZV_BYTE (b->base_buffer));
628 XMARKER (BUF_ZV_MARKER (b->base_buffer))->insertion_type = 1;
631 if (NILP (clone))
633 /* Give the indirect buffer markers for its narrowing. */
634 BUF_PT_MARKER (b) = Fmake_marker ();
635 set_marker_both (BUF_PT_MARKER (b), buf, BUF_PT (b), BUF_PT_BYTE (b));
636 BUF_BEGV_MARKER (b) = Fmake_marker ();
637 set_marker_both (BUF_BEGV_MARKER (b), buf, BUF_BEGV (b), BUF_BEGV_BYTE (b));
638 BUF_ZV_MARKER (b) = Fmake_marker ();
639 set_marker_both (BUF_ZV_MARKER (b), buf, BUF_ZV (b), BUF_ZV_BYTE (b));
640 XMARKER (BUF_ZV_MARKER (b))->insertion_type = 1;
642 else
644 struct buffer *old_b = current_buffer;
646 clone_per_buffer_values (b->base_buffer, b);
647 BUF_FILENAME (b) = Qnil;
648 BUF_FILE_TRUENAME (b) = Qnil;
649 BUF_DISPLAY_COUNT (b) = make_number (0);
650 BUF_BACKED_UP (b) = Qnil;
651 BUF_AUTO_SAVE_FILE_NAME (b) = 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 BUF_NAME (current_buffer);
888 CHECK_BUFFER (buffer);
889 return BUF_NAME (XBUFFER (buffer));
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 BUF_FILENAME (current_buffer);
900 CHECK_BUFFER (buffer);
901 return BUF_FILENAME (XBUFFER (buffer));
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 (buf));
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 (buf); 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 = BUF_FILE_TRUENAME (current_buffer);
1124 /* Test buffer-file-name so that binding it to nil is effective. */
1125 if (!NILP (fn) && ! NILP (BUF_FILENAME (current_buffer)))
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 = BUF_FILE_TRUENAME (current_buffer);
1192 /* Test buffer-file-name so that binding it to nil is effective. */
1193 if (!NILP (fn) && ! NILP (BUF_FILENAME (current_buffer)))
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 BUF_NAME (current_buffer);
1284 if (!NILP (unique))
1285 newname = Fgenerate_new_buffer_name (newname, BUF_NAME (current_buffer));
1286 else
1287 error ("Buffer name `%s' is in use", SDATA (newname));
1290 BUF_NAME (current_buffer) = 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 (BUF_FILENAME (current_buffer))
1299 && !NILP (BUF_AUTO_SAVE_FILE_NAME (current_buffer)))
1300 call0 (intern ("rename-auto-save-file"));
1301 /* Refetch since that last call may have done GC. */
1302 return BUF_NAME (current_buffer);
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 (BUF_NAME (XBUFFER (buf))))
1347 continue;
1348 if (SREF (BUF_NAME (XBUFFER (buf)), 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 (BUF_UNDO_LIST (XBUFFER (real_buffer)), Qt))
1398 BUF_UNDO_LIST (XBUFFER (real_buffer)) = 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 (BUF_NAME (b)))
1445 return Qnil;
1447 tem = get_current_thread ();
1448 if (!EQ (b->owner, Qnil) && !EQ (b->owner, tem))
1449 error ("Buffer locked by another thread");
1451 /* Query if the buffer is still modified. */
1452 if (INTERACTIVE && !NILP (BUF_FILENAME (b))
1453 && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b))
1455 GCPRO1 (buffer);
1456 tem = do_yes_or_no_p (format2 ("Buffer %s modified; kill anyway? ",
1457 BUF_NAME (b), make_number (0)));
1458 UNGCPRO;
1459 if (NILP (tem))
1460 return Qnil;
1463 /* Run hooks with the buffer to be killed the current buffer. */
1465 int count = SPECPDL_INDEX ();
1466 Lisp_Object arglist[1];
1468 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1469 set_buffer_internal (b);
1471 /* First run the query functions; if any query is answered no,
1472 don't kill the buffer. */
1473 arglist[0] = Qkill_buffer_query_functions;
1474 tem = Frun_hook_with_args_until_failure (1, arglist);
1475 if (NILP (tem))
1476 return unbind_to (count, Qnil);
1478 /* Then run the hooks. */
1479 Frun_hooks (1, &Qkill_buffer_hook);
1480 unbind_to (count, Qnil);
1483 /* We have no more questions to ask. Verify that it is valid
1484 to kill the buffer. This must be done after the questions
1485 since anything can happen within do_yes_or_no_p. */
1487 /* Don't kill the minibuffer now current. */
1488 if (EQ (buffer, XWINDOW (minibuf_window)->buffer))
1489 return Qnil;
1491 if (NILP (BUF_NAME (b)))
1492 return Qnil;
1494 /* When we kill a base buffer, kill all its indirect buffers.
1495 We do it at this stage so nothing terrible happens if they
1496 ask questions or their hooks get errors. */
1497 if (! b->base_buffer)
1499 struct buffer *other;
1501 GCPRO1 (buffer);
1503 for (other = all_buffers; other; other = other->next)
1504 /* all_buffers contains dead buffers too;
1505 don't re-kill them. */
1506 if (other->base_buffer == b && !NILP (BUF_NAME (other)))
1508 Lisp_Object buffer;
1509 XSETBUFFER (buffer, other);
1510 Fkill_buffer (buffer);
1513 UNGCPRO;
1516 /* Make this buffer not be current.
1517 In the process, notice if this is the sole visible buffer
1518 and give up if so. */
1519 if (b == current_buffer)
1521 tem = Fother_buffer (buffer, Qnil, Qnil);
1522 Fset_buffer (tem);
1523 if (b == current_buffer)
1524 return Qnil;
1527 /* Notice if the buffer to kill is the sole visible buffer
1528 when we're currently in the mini-buffer, and give up if so. */
1529 XSETBUFFER (tem, current_buffer);
1530 if (EQ (tem, XWINDOW (minibuf_window)->buffer))
1532 tem = Fother_buffer (buffer, Qnil, Qnil);
1533 if (EQ (buffer, tem))
1534 return Qnil;
1537 /* Now there is no question: we can kill the buffer. */
1539 #ifdef CLASH_DETECTION
1540 /* Unlock this buffer's file, if it is locked. */
1541 unlock_buffer (b);
1542 #endif /* CLASH_DETECTION */
1544 GCPRO1 (buffer);
1545 kill_buffer_processes (buffer);
1546 UNGCPRO;
1548 /* Killing buffer processes may run sentinels which may
1549 have called kill-buffer. */
1551 if (NILP (BUF_NAME (b)))
1552 return Qnil;
1554 clear_charpos_cache (b);
1556 tem = Vinhibit_quit;
1557 Vinhibit_quit = Qt;
1558 replace_buffer_in_all_windows (buffer);
1559 Vbuffer_alist = Fdelq (Frassq (buffer, Vbuffer_alist), Vbuffer_alist);
1560 frames_discard_buffer (buffer);
1561 Vinhibit_quit = tem;
1563 /* Delete any auto-save file, if we saved it in this session.
1564 But not if the buffer is modified. */
1565 if (STRINGP (b->auto_save_file_name)
1566 && BUF_AUTOSAVE_MODIFF (b) != 0
1567 && BUF_SAVE_MODIFF (b) < BUF_AUTOSAVE_MODIFF (b)
1568 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
1569 && NILP (Fsymbol_value (intern ("auto-save-visited-file-name"))))
1571 Lisp_Object tem;
1572 tem = Fsymbol_value (intern ("delete-auto-save-files"));
1573 if (! NILP (tem))
1574 internal_delete_file (BUF_AUTO_SAVE_FILE_NAME (b));
1577 if (b->base_buffer)
1579 /* Unchain all markers that belong to this indirect buffer.
1580 Don't unchain the markers that belong to the base buffer
1581 or its other indirect buffers. */
1582 for (m = BUF_MARKERS (b); m; )
1584 struct Lisp_Marker *next = m->next;
1585 if (m->buffer == b)
1586 unchain_marker (m);
1587 m = next;
1590 else
1592 /* Unchain all markers of this buffer and its indirect buffers.
1593 and leave them pointing nowhere. */
1594 for (m = BUF_MARKERS (b); m; )
1596 struct Lisp_Marker *next = m->next;
1597 m->buffer = 0;
1598 m->next = NULL;
1599 m = next;
1601 BUF_MARKERS (b) = NULL;
1602 BUF_INTERVALS (b) = NULL_INTERVAL;
1604 /* Perhaps we should explicitly free the interval tree here... */
1607 /* Reset the local variables, so that this buffer's local values
1608 won't be protected from GC. They would be protected
1609 if they happened to remain encached in their symbols.
1610 This gets rid of them for certain. */
1611 swap_out_buffer_local_variables (b);
1612 reset_buffer_local_variables (b, 1);
1614 BUF_NAME (b) = Qnil;
1616 BLOCK_INPUT;
1617 if (! b->base_buffer)
1618 free_buffer_text (b);
1620 if (b->newline_cache)
1622 free_region_cache (b->newline_cache);
1623 b->newline_cache = 0;
1625 if (b->width_run_cache)
1627 free_region_cache (b->width_run_cache);
1628 b->width_run_cache = 0;
1630 BUF_WIDTH_TABLE (b) = Qnil;
1631 UNBLOCK_INPUT;
1632 BUF_UNDO_LIST (b) = Qnil;
1634 return Qt;
1637 /* Move the assoc for buffer BUF to the front of buffer-alist. Since
1638 we do this each time BUF is selected visibly, the more recently
1639 selected buffers are always closer to the front of the list. This
1640 means that other_buffer is more likely to choose a relevant buffer. */
1642 void
1643 record_buffer (buf)
1644 Lisp_Object buf;
1646 register Lisp_Object link, prev;
1647 Lisp_Object frame;
1648 frame = selected_frame;
1650 prev = Qnil;
1651 for (link = Vbuffer_alist; CONSP (link); link = XCDR (link))
1653 if (EQ (XCDR (XCAR (link)), buf))
1654 break;
1655 prev = link;
1658 /* Effectively do Vbuffer_alist = Fdelq (link, Vbuffer_alist);
1659 we cannot use Fdelq itself here because it allows quitting. */
1661 if (NILP (prev))
1662 Vbuffer_alist = XCDR (Vbuffer_alist);
1663 else
1664 XSETCDR (prev, XCDR (XCDR (prev)));
1666 XSETCDR (link, Vbuffer_alist);
1667 Vbuffer_alist = link;
1669 /* Effectively do a delq on buried_buffer_list. */
1671 prev = Qnil;
1672 for (link = XFRAME (frame)->buried_buffer_list; CONSP (link);
1673 link = XCDR (link))
1675 if (EQ (XCAR (link), buf))
1677 if (NILP (prev))
1678 XFRAME (frame)->buried_buffer_list = XCDR (link);
1679 else
1680 XSETCDR (prev, XCDR (XCDR (prev)));
1681 break;
1683 prev = link;
1686 /* Now move this buffer to the front of frame_buffer_list also. */
1688 prev = Qnil;
1689 for (link = frame_buffer_list (frame); CONSP (link);
1690 link = XCDR (link))
1692 if (EQ (XCAR (link), buf))
1693 break;
1694 prev = link;
1697 /* Effectively do delq. */
1699 if (CONSP (link))
1701 if (NILP (prev))
1702 set_frame_buffer_list (frame,
1703 XCDR (frame_buffer_list (frame)));
1704 else
1705 XSETCDR (prev, XCDR (XCDR (prev)));
1707 XSETCDR (link, frame_buffer_list (frame));
1708 set_frame_buffer_list (frame, link);
1710 else
1711 set_frame_buffer_list (frame, Fcons (buf, frame_buffer_list (frame)));
1714 DEFUN ("set-buffer-major-mode", Fset_buffer_major_mode, Sset_buffer_major_mode, 1, 1, 0,
1715 doc: /* Set an appropriate major mode for BUFFER.
1716 For the *scratch* buffer, use `initial-major-mode', otherwise choose a mode
1717 according to `default-major-mode'.
1718 Use this function before selecting the buffer, since it may need to inspect
1719 the current buffer's major mode. */)
1720 (buffer)
1721 Lisp_Object buffer;
1723 int count;
1724 Lisp_Object function;
1726 CHECK_BUFFER (buffer);
1728 if (STRINGP (BUF_NAME (XBUFFER (buffer)))
1729 && strcmp (SDATA (BUF_NAME (XBUFFER (buffer))), "*scratch*") == 0)
1730 function = find_symbol_value (intern ("initial-major-mode"));
1731 else
1733 function = BUF_MAJOR_MODE (&buffer_defaults);
1734 if (NILP (function)
1735 && NILP (Fget (BUF_MAJOR_MODE (current_buffer), Qmode_class)))
1736 function = BUF_MAJOR_MODE (current_buffer);
1739 if (NILP (function) || EQ (function, Qfundamental_mode))
1740 return Qnil;
1742 count = SPECPDL_INDEX ();
1744 /* To select a nonfundamental mode,
1745 select the buffer temporarily and then call the mode function. */
1747 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1749 Fset_buffer (buffer);
1750 call0 (function);
1752 return unbind_to (count, Qnil);
1755 /* Switch to buffer BUFFER in the selected window.
1756 If NORECORD is non-nil, don't call record_buffer. */
1758 Lisp_Object
1759 switch_to_buffer_1 (buffer_or_name, norecord)
1760 Lisp_Object buffer_or_name, norecord;
1762 register Lisp_Object buffer;
1764 if (NILP (buffer_or_name))
1765 buffer = Fother_buffer (Fcurrent_buffer (), Qnil, Qnil);
1766 else
1768 buffer = Fget_buffer (buffer_or_name);
1769 if (NILP (buffer))
1771 buffer = Fget_buffer_create (buffer_or_name);
1772 Fset_buffer_major_mode (buffer);
1775 Fset_buffer (buffer);
1776 if (NILP (norecord))
1777 record_buffer (buffer);
1779 Fset_window_buffer (EQ (selected_window, minibuf_window)
1780 ? Fnext_window (minibuf_window, Qnil, Qnil)
1781 : selected_window,
1782 buffer, Qnil);
1784 return buffer;
1787 DEFUN ("switch-to-buffer", Fswitch_to_buffer, Sswitch_to_buffer, 1, 2,
1788 "(list (read-buffer-to-switch \"Switch to buffer: \"))",
1789 doc: /* Make BUFFER-OR-NAME current and display it in selected window.
1790 BUFFER-OR-NAME may be a buffer, a string \(a buffer name), or
1791 nil. Return the buffer switched to.
1793 If BUFFER-OR-NAME is a string and does not identify an existing
1794 buffer, create a new buffer with that name. Interactively, if
1795 `confirm-nonexistent-file-or-buffer' is non-nil, request
1796 confirmation before creating a new buffer. If BUFFER-OR-NAME is
1797 nil, switch to buffer returned by `other-buffer'.
1799 Optional second arg NORECORD non-nil means do not put this buffer
1800 at the front of the list of recently selected ones. This
1801 function returns the buffer it switched to as a Lisp object.
1803 If the selected window is the minibuffer window or dedicated to
1804 its buffer, use `pop-to-buffer' for displaying the buffer.
1806 WARNING: This is NOT the way to work on another buffer temporarily
1807 within a Lisp program! Use `set-buffer' instead. That avoids
1808 messing with the window-buffer correspondences. */)
1809 (buffer_or_name, norecord)
1810 Lisp_Object buffer_or_name, norecord;
1812 char *err;
1814 if (EQ (buffer_or_name, Fwindow_buffer (selected_window)))
1816 /* Basically a NOP. Avoid signalling an error in the case where
1817 the selected window is dedicated, or a minibuffer. */
1819 /* But do put this buffer at the front of the buffer list, unless
1820 that has been inhibited. Note that even if BUFFER-OR-NAME is
1821 at the front of the main buffer-list already, we still want to
1822 move it to the front of the frame's buffer list. */
1823 if (NILP (norecord))
1824 record_buffer (buffer_or_name);
1825 return Fset_buffer (buffer_or_name);
1827 else if (EQ (minibuf_window, selected_window)
1828 /* If `dedicated' is neither nil nor t, it means it's
1829 dedicatedness can be overridden by an explicit request
1830 such as a call to switch-to-buffer. */
1831 || EQ (Fwindow_dedicated_p (selected_window), Qt))
1832 /* We can't use the selected window so let `pop-to-buffer' try some
1833 other window. */
1834 return call3 (intern ("pop-to-buffer"), buffer_or_name, Qnil, norecord);
1835 else
1836 return switch_to_buffer_1 (buffer_or_name, norecord);
1839 DEFUN ("current-buffer", Fcurrent_buffer, Scurrent_buffer, 0, 0, 0,
1840 doc: /* Return the current buffer as a Lisp object. */)
1843 register Lisp_Object buf;
1844 XSETBUFFER (buf, current_buffer);
1845 return buf;
1848 /* Set the current buffer to B.
1850 We previously set windows_or_buffers_changed here to invalidate
1851 global unchanged information in beg_unchanged and end_unchanged.
1852 This is no longer necessary because we now compute unchanged
1853 information on a buffer-basis. Every action affecting other
1854 windows than the selected one requires a select_window at some
1855 time, and that increments windows_or_buffers_changed. */
1857 void
1858 set_buffer_internal (b)
1859 register struct buffer *b;
1861 if (current_buffer != b)
1862 set_buffer_internal_1 (b);
1865 /* Set the current buffer to B, and do not set windows_or_buffers_changed.
1866 This is used by redisplay. */
1868 void
1869 set_buffer_internal_1 (b)
1870 register struct buffer *b;
1872 register struct buffer *old_buf;
1873 register Lisp_Object tail, valcontents;
1874 Lisp_Object tem;
1876 #ifdef USE_MMAP_FOR_BUFFERS
1877 if (b->text->beg == NULL)
1878 enlarge_buffer_text (b, 0);
1879 #endif /* USE_MMAP_FOR_BUFFERS */
1881 if (current_buffer == b)
1882 return;
1884 old_buf = current_buffer;
1885 flush_stack_call_func (thread_acquire_buffer, b);
1886 current_buffer = b;
1887 last_known_column_point = -1; /* invalidate indentation cache */
1889 if (old_buf)
1891 /* Put the undo list back in the base buffer, so that it appears
1892 that an indirect buffer shares the undo list of its base. */
1893 if (old_buf->base_buffer)
1894 BUF_UNDO_LIST (old_buf->base_buffer) = BUF_UNDO_LIST (old_buf);
1896 /* If the old current buffer has markers to record PT, BEGV and ZV
1897 when it is not current, update them now. */
1898 if (! NILP (BUF_PT_MARKER (old_buf)))
1900 Lisp_Object obuf;
1901 XSETBUFFER (obuf, old_buf);
1902 set_marker_both (BUF_PT_MARKER (old_buf), obuf,
1903 BUF_PT (old_buf), BUF_PT_BYTE (old_buf));
1905 if (! NILP (BUF_BEGV_MARKER (old_buf)))
1907 Lisp_Object obuf;
1908 XSETBUFFER (obuf, old_buf);
1909 set_marker_both (BUF_BEGV_MARKER (old_buf), obuf,
1910 BUF_BEGV (old_buf), BUF_BEGV_BYTE (old_buf));
1912 if (! NILP (BUF_ZV_MARKER (old_buf)))
1914 Lisp_Object obuf;
1915 XSETBUFFER (obuf, old_buf);
1916 set_marker_both (BUF_ZV_MARKER (old_buf), obuf,
1917 BUF_ZV (old_buf), BUF_ZV_BYTE (old_buf));
1921 /* Get the undo list from the base buffer, so that it appears
1922 that an indirect buffer shares the undo list of its base. */
1923 if (b->base_buffer)
1924 BUF_UNDO_LIST (b) = BUF_UNDO_LIST (b->base_buffer);
1926 /* If the new current buffer has markers to record PT, BEGV and ZV
1927 when it is not current, fetch them now. */
1928 if (! NILP (BUF_PT_MARKER (b)))
1930 BUF_PT (b) = marker_position (BUF_PT_MARKER (b));
1931 BUF_PT_BYTE (b) = marker_byte_position (BUF_PT_MARKER (b));
1933 if (! NILP (BUF_BEGV_MARKER (b)))
1935 BUF_BEGV (b) = marker_position (BUF_BEGV_MARKER (b));
1936 BUF_BEGV_BYTE (b) = marker_byte_position (BUF_BEGV_MARKER (b));
1938 if (! NILP (BUF_ZV_MARKER (b)))
1940 BUF_ZV (b) = marker_position (BUF_ZV_MARKER (b));
1941 BUF_ZV_BYTE (b) = marker_byte_position (BUF_ZV_MARKER (b));
1944 /* Look down buffer's list of local Lisp variables
1945 to find and update any that forward into C variables. */
1947 for (tail = BUF_LOCAL_VAR_ALIST (b); CONSP (tail); tail = XCDR (tail))
1949 if (CONSP (XCAR (tail))
1950 && SYMBOLP (XCAR (XCAR (tail)))
1951 && (valcontents = SYMBOL_VALUE (XCAR (XCAR (tail))),
1952 (BUFFER_LOCAL_VALUEP (valcontents)))
1953 && (tem = XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
1954 (BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem))))
1955 /* Just reference the variable to cause it to become set for
1956 this buffer. */
1957 Fsymbol_value (XCAR (XCAR (tail)));
1960 /* Do the same with any others that were local to the previous buffer */
1962 if (old_buf)
1963 for (tail = BUF_LOCAL_VAR_ALIST (old_buf); CONSP (tail); tail = XCDR (tail))
1965 if (CONSP (tail)
1966 && SYMBOLP (XCAR (XCAR (tail)))
1967 && (valcontents = SYMBOL_VALUE (XCAR (XCAR (tail))),
1968 (BUFFER_LOCAL_VALUEP (valcontents)))
1969 && (tem = XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
1970 (BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem))))
1971 /* Just reference the variable to cause it to become set for
1972 this buffer. */
1973 Fsymbol_value (XCAR (XCAR (tail)));
1977 /* Switch to buffer B temporarily for redisplay purposes.
1978 This avoids certain things that don't need to be done within redisplay. */
1980 void
1981 set_buffer_temp (b)
1982 struct buffer *b;
1984 register struct buffer *old_buf;
1986 if (current_buffer == b)
1987 return;
1989 old_buf = current_buffer;
1990 current_buffer = b;
1992 if (old_buf)
1994 /* If the old current buffer has markers to record PT, BEGV and ZV
1995 when it is not current, update them now. */
1996 if (! NILP (BUF_PT_MARKER (old_buf)))
1998 Lisp_Object obuf;
1999 XSETBUFFER (obuf, old_buf);
2000 set_marker_both (BUF_PT_MARKER (old_buf), obuf,
2001 BUF_PT (old_buf), BUF_PT_BYTE (old_buf));
2003 if (! NILP (BUF_BEGV_MARKER (old_buf)))
2005 Lisp_Object obuf;
2006 XSETBUFFER (obuf, old_buf);
2007 set_marker_both (BUF_BEGV_MARKER (old_buf), obuf,
2008 BUF_BEGV (old_buf), BUF_BEGV_BYTE (old_buf));
2010 if (! NILP (BUF_ZV_MARKER (old_buf)))
2012 Lisp_Object obuf;
2013 XSETBUFFER (obuf, old_buf);
2014 set_marker_both (BUF_ZV_MARKER (old_buf), obuf,
2015 BUF_ZV (old_buf), BUF_ZV_BYTE (old_buf));
2019 /* If the new current buffer has markers to record PT, BEGV and ZV
2020 when it is not current, fetch them now. */
2021 if (! NILP (BUF_PT_MARKER (b)))
2023 BUF_PT (b) = marker_position (BUF_PT_MARKER (b));
2024 BUF_PT_BYTE (b) = marker_byte_position (BUF_PT_MARKER (b));
2026 if (! NILP (BUF_BEGV_MARKER (b)))
2028 BUF_BEGV (b) = marker_position (BUF_BEGV_MARKER (b));
2029 BUF_BEGV_BYTE (b) = marker_byte_position (BUF_BEGV_MARKER (b));
2031 if (! NILP (BUF_ZV_MARKER (b)))
2033 BUF_ZV (b) = marker_position (BUF_ZV_MARKER (b));
2034 BUF_ZV_BYTE (b) = marker_byte_position (BUF_ZV_MARKER (b));
2038 DEFUN ("set-buffer", Fset_buffer, Sset_buffer, 1, 1, 0,
2039 doc: /* Make buffer BUFFER-OR-NAME current for editing operations.
2040 BUFFER-OR-NAME may be a buffer or the name of an existing buffer. See
2041 also `save-excursion' when you want to make a buffer current
2042 temporarily. This function does not display the buffer, so its effect
2043 ends when the current command terminates. Use `switch-to-buffer' or
2044 `pop-to-buffer' to switch buffers permanently. */)
2045 (buffer_or_name)
2046 register Lisp_Object buffer_or_name;
2048 register Lisp_Object buffer;
2049 buffer = Fget_buffer (buffer_or_name);
2050 if (NILP (buffer))
2051 nsberror (buffer_or_name);
2052 if (NILP (BUF_NAME (XBUFFER (buffer))))
2053 error ("Selecting deleted buffer");
2054 set_buffer_internal (XBUFFER (buffer));
2055 return buffer;
2058 /* Set the current buffer to BUFFER provided it is alive. */
2060 Lisp_Object
2061 set_buffer_if_live (buffer)
2062 Lisp_Object buffer;
2064 if (! NILP (BUF_NAME (XBUFFER (buffer))))
2065 Fset_buffer (buffer);
2066 return Qnil;
2069 DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only,
2070 Sbarf_if_buffer_read_only, 0, 0, 0,
2071 doc: /* Signal a `buffer-read-only' error if the current buffer is read-only. */)
2074 if (!NILP (BUF_READ_ONLY (current_buffer))
2075 && NILP (Vinhibit_read_only))
2076 xsignal1 (Qbuffer_read_only, Fcurrent_buffer ());
2077 return Qnil;
2080 DEFUN ("bury-buffer", Fbury_buffer, Sbury_buffer, 0, 1, "",
2081 doc: /* Put BUFFER-OR-NAME at the end of the list of all buffers.
2082 There it is the least likely candidate for `other-buffer' to return;
2083 thus, the least likely buffer for \\[switch-to-buffer] to select by
2084 default.
2086 The argument may be a buffer name or an actual buffer object. If
2087 BUFFER-OR-NAME is nil or omitted, bury the current buffer and remove it
2088 from the selected window if it is displayed there. If the selected
2089 window is dedicated to its buffer, delete that window if there are other
2090 windows on the same frame. If the selected window is the only window on
2091 its frame, iconify that frame. */)
2092 (buffer_or_name)
2093 register Lisp_Object buffer_or_name;
2095 Lisp_Object buffer;
2097 /* Figure out what buffer we're going to bury. */
2098 if (NILP (buffer_or_name))
2100 Lisp_Object tem;
2101 XSETBUFFER (buffer, current_buffer);
2103 tem = Fwindow_buffer (selected_window);
2104 /* If we're burying the current buffer, unshow it. */
2105 if (EQ (buffer, tem))
2107 if (NILP (Fwindow_dedicated_p (selected_window)))
2108 Fswitch_to_buffer (Fother_buffer (buffer, Qnil, Qnil), Qnil);
2109 else if (NILP (XWINDOW (selected_window)->parent))
2110 Ficonify_frame (Fwindow_frame (selected_window));
2111 else
2112 Fdelete_window (selected_window);
2115 else
2117 buffer = Fget_buffer (buffer_or_name);
2118 if (NILP (buffer))
2119 nsberror (buffer_or_name);
2122 /* Move buffer to the end of the buffer list. Do nothing if the
2123 buffer is killed. */
2124 if (!NILP (BUF_NAME (XBUFFER (buffer))))
2126 Lisp_Object aelt, link;
2128 aelt = Frassq (buffer, Vbuffer_alist);
2129 link = Fmemq (aelt, Vbuffer_alist);
2130 Vbuffer_alist = Fdelq (aelt, Vbuffer_alist);
2131 XSETCDR (link, Qnil);
2132 Vbuffer_alist = nconc2 (Vbuffer_alist, link);
2134 XFRAME (selected_frame)->buffer_list
2135 = Fdelq (buffer, XFRAME (selected_frame)->buffer_list);
2136 XFRAME (selected_frame)->buried_buffer_list
2137 = Fcons (buffer, Fdelq (buffer, XFRAME (selected_frame)->buried_buffer_list));
2140 return Qnil;
2143 DEFUN ("erase-buffer", Ferase_buffer, Serase_buffer, 0, 0, "*",
2144 doc: /* Delete the entire contents of the current buffer.
2145 Any narrowing restriction in effect (see `narrow-to-region') is removed,
2146 so the buffer is truly empty after this. */)
2149 Fwiden ();
2151 del_range (BEG, Z);
2153 current_buffer->last_window_start = 1;
2154 /* Prevent warnings, or suspension of auto saving, that would happen
2155 if future size is less than past size. Use of erase-buffer
2156 implies that the future text is not really related to the past text. */
2157 XSETFASTINT (BUF_SAVE_LENGTH (current_buffer), 0);
2158 return Qnil;
2161 void
2162 validate_region (b, e)
2163 register Lisp_Object *b, *e;
2165 CHECK_NUMBER_COERCE_MARKER (*b);
2166 CHECK_NUMBER_COERCE_MARKER (*e);
2168 if (XINT (*b) > XINT (*e))
2170 Lisp_Object tem;
2171 tem = *b; *b = *e; *e = tem;
2174 if (!(BEGV <= XINT (*b) && XINT (*b) <= XINT (*e)
2175 && XINT (*e) <= ZV))
2176 args_out_of_range (*b, *e);
2179 /* Advance BYTE_POS up to a character boundary
2180 and return the adjusted position. */
2182 static int
2183 advance_to_char_boundary (byte_pos)
2184 int byte_pos;
2186 int c;
2188 if (byte_pos == BEG)
2189 /* Beginning of buffer is always a character boundary. */
2190 return BEG;
2192 c = FETCH_BYTE (byte_pos);
2193 if (! CHAR_HEAD_P (c))
2195 /* We should advance BYTE_POS only when C is a constituent of a
2196 multibyte sequence. */
2197 int orig_byte_pos = byte_pos;
2201 byte_pos--;
2202 c = FETCH_BYTE (byte_pos);
2204 while (! CHAR_HEAD_P (c) && byte_pos > BEG);
2205 INC_POS (byte_pos);
2206 if (byte_pos < orig_byte_pos)
2207 byte_pos = orig_byte_pos;
2208 /* If C is a constituent of a multibyte sequence, BYTE_POS was
2209 surely advance to the correct character boundary. If C is
2210 not, BYTE_POS was unchanged. */
2213 return byte_pos;
2216 #ifdef REL_ALLOC
2217 extern void r_alloc_reset_variable P_ ((POINTER_TYPE *, POINTER_TYPE *));
2218 #endif /* REL_ALLOC */
2220 DEFUN ("buffer-swap-text", Fbuffer_swap_text, Sbuffer_swap_text,
2221 1, 1, 0,
2222 doc: /* Swap the text between current buffer and BUFFER. */)
2223 (buffer)
2224 Lisp_Object buffer;
2226 struct buffer *other_buffer;
2227 CHECK_BUFFER (buffer);
2228 other_buffer = XBUFFER (buffer);
2230 if (NILP (BUF_NAME (other_buffer)))
2231 error ("Cannot swap a dead buffer's text");
2233 /* Actually, it probably works just fine.
2234 * if (other_buffer == current_buffer)
2235 * error ("Cannot swap a buffer's text with itself"); */
2237 /* Actually, this may be workable as well, tho probably only if they're
2238 *both* indirect. */
2239 if (other_buffer->base_buffer
2240 || current_buffer->base_buffer)
2241 error ("Cannot swap indirect buffers's text");
2243 { /* This is probably harder to make work. */
2244 struct buffer *other;
2245 for (other = all_buffers; other; other = other->next)
2246 if (other->base_buffer == other_buffer
2247 || other->base_buffer == current_buffer)
2248 error ("One of the buffers to swap has indirect buffers");
2251 #define swapfield(field, type) \
2252 do { \
2253 type tmp##field = other_buffer->field; \
2254 other_buffer->field = current_buffer->field; \
2255 current_buffer->field = tmp##field; \
2256 } while (0)
2257 #define swapfield_(field, type) \
2258 do { \
2259 type tmp##field = other_buffer->field ## _; \
2260 other_buffer->field ## _ = current_buffer->field ## _; \
2261 current_buffer->field ## _ = tmp##field; \
2262 } while (0)
2264 swapfield (own_text, struct buffer_text);
2265 eassert (current_buffer->text == &current_buffer->own_text);
2266 eassert (other_buffer->text == &other_buffer->own_text);
2267 #ifdef REL_ALLOC
2268 r_alloc_reset_variable ((POINTER_TYPE **) &current_buffer->own_text.beg,
2269 (POINTER_TYPE **) &other_buffer->own_text.beg);
2270 r_alloc_reset_variable ((POINTER_TYPE **) &other_buffer->own_text.beg,
2271 (POINTER_TYPE **) &current_buffer->own_text.beg);
2272 #endif /* REL_ALLOC */
2274 swapfield (pt, EMACS_INT);
2275 swapfield (pt_byte, EMACS_INT);
2276 swapfield (begv, EMACS_INT);
2277 swapfield (begv_byte, EMACS_INT);
2278 swapfield (zv, EMACS_INT);
2279 swapfield (zv_byte, EMACS_INT);
2280 eassert (!current_buffer->base_buffer);
2281 eassert (!other_buffer->base_buffer);
2282 current_buffer->clip_changed = 1; other_buffer->clip_changed = 1;
2283 swapfield (newline_cache, struct region_cache *);
2284 swapfield (width_run_cache, struct region_cache *);
2285 current_buffer->prevent_redisplay_optimizations_p = 1;
2286 other_buffer->prevent_redisplay_optimizations_p = 1;
2287 swapfield (overlays_before, struct Lisp_Overlay *);
2288 swapfield (overlays_after, struct Lisp_Overlay *);
2289 swapfield (overlay_center, EMACS_INT);
2290 swapfield_ (undo_list, Lisp_Object);
2291 swapfield_ (mark, Lisp_Object);
2292 swapfield_ (enable_multibyte_characters, Lisp_Object);
2293 /* FIXME: Not sure what we should do with these *_marker fields.
2294 Hopefully they're just nil anyway. */
2295 swapfield_ (pt_marker, Lisp_Object);
2296 swapfield_ (begv_marker, Lisp_Object);
2297 swapfield_ (zv_marker, Lisp_Object);
2298 BUF_POINT_BEFORE_SCROLL (current_buffer) = Qnil;
2299 BUF_POINT_BEFORE_SCROLL (other_buffer) = Qnil;
2301 current_buffer->text->modiff++; other_buffer->text->modiff++;
2302 current_buffer->text->chars_modiff++; other_buffer->text->chars_modiff++;
2303 current_buffer->text->overlay_modiff++; other_buffer->text->overlay_modiff++;
2304 current_buffer->text->beg_unchanged = current_buffer->text->gpt;
2305 current_buffer->text->end_unchanged = current_buffer->text->gpt;
2306 other_buffer->text->beg_unchanged = other_buffer->text->gpt;
2307 other_buffer->text->end_unchanged = other_buffer->text->gpt;
2309 struct Lisp_Marker *m;
2310 for (m = BUF_MARKERS (current_buffer); m; m = m->next)
2311 if (m->buffer == other_buffer)
2312 m->buffer = current_buffer;
2313 else
2314 /* Since there's no indirect buffer in sight, markers on
2315 BUF_MARKERS(buf) should either be for `buf' or dead. */
2316 eassert (!m->buffer);
2317 for (m = BUF_MARKERS (other_buffer); m; m = m->next)
2318 if (m->buffer == current_buffer)
2319 m->buffer = other_buffer;
2320 else
2321 /* Since there's no indirect buffer in sight, markers on
2322 BUF_MARKERS(buf) should either be for `buf' or dead. */
2323 eassert (!m->buffer);
2325 { /* Some of the C code expects that w->buffer == w->pointm->buffer.
2326 So since we just swapped the markers between the two buffers, we need
2327 to undo the effect of this swap for window markers. */
2328 Lisp_Object w = Fselected_window (), ws = Qnil;
2329 Lisp_Object buf1, buf2;
2330 XSETBUFFER (buf1, current_buffer); XSETBUFFER (buf2, other_buffer);
2332 while (NILP (Fmemq (w, ws)))
2334 ws = Fcons (w, ws);
2335 if (MARKERP (XWINDOW (w)->pointm)
2336 && (EQ (XWINDOW (w)->buffer, buf1)
2337 || EQ (XWINDOW (w)->buffer, buf2)))
2338 Fset_marker (XWINDOW (w)->pointm,
2339 make_number (BUF_BEGV (XBUFFER (XWINDOW (w)->buffer))),
2340 XWINDOW (w)->buffer);
2341 w = Fnext_window (w, Qt, Qt);
2345 if (current_buffer->text->intervals)
2346 (eassert (EQ (current_buffer->text->intervals->up.obj, buffer)),
2347 XSETBUFFER (current_buffer->text->intervals->up.obj, current_buffer));
2348 if (other_buffer->text->intervals)
2349 (eassert (EQ (other_buffer->text->intervals->up.obj, Fcurrent_buffer ())),
2350 XSETBUFFER (other_buffer->text->intervals->up.obj, other_buffer));
2352 return Qnil;
2355 DEFUN ("set-buffer-multibyte", Fset_buffer_multibyte, Sset_buffer_multibyte,
2356 1, 1, 0,
2357 doc: /* Set the multibyte flag of the current buffer to FLAG.
2358 If FLAG is t, this makes the buffer a multibyte buffer.
2359 If FLAG is nil, this makes the buffer a single-byte buffer.
2360 In these cases, the buffer contents remain unchanged as a sequence of
2361 bytes but the contents viewed as characters do change.
2362 If FLAG is `to', this makes the buffer a multibyte buffer by changing
2363 all eight-bit bytes to eight-bit characters.
2364 If the multibyte flag was really changed, undo information of the
2365 current buffer is cleared. */)
2366 (flag)
2367 Lisp_Object flag;
2369 struct Lisp_Marker *tail, *markers;
2370 struct buffer *other;
2371 int begv, zv;
2372 int narrowed = (BEG != BEGV || Z != ZV);
2373 int modified_p = !NILP (Fbuffer_modified_p (Qnil));
2374 Lisp_Object old_undo = BUF_UNDO_LIST (current_buffer);
2375 struct gcpro gcpro1;
2377 if (current_buffer->base_buffer)
2378 error ("Cannot do `set-buffer-multibyte' on an indirect buffer");
2380 /* Do nothing if nothing actually changes. */
2381 if (NILP (flag) == NILP (BUF_ENABLE_MULTIBYTE_CHARACTERS (current_buffer)))
2382 return flag;
2384 GCPRO1 (old_undo);
2386 /* Don't record these buffer changes. We will put a special undo entry
2387 instead. */
2388 BUF_UNDO_LIST (current_buffer) = Qt;
2390 /* If the cached position is for this buffer, clear it out. */
2391 clear_charpos_cache (current_buffer);
2393 if (NILP (flag))
2394 begv = BEGV_BYTE, zv = ZV_BYTE;
2395 else
2396 begv = BEGV, zv = ZV;
2398 if (narrowed)
2399 Fwiden ();
2401 if (NILP (flag))
2403 int pos, stop;
2404 unsigned char *p;
2406 /* Do this first, so it can use CHAR_TO_BYTE
2407 to calculate the old correspondences. */
2408 set_intervals_multibyte (0);
2410 BUF_ENABLE_MULTIBYTE_CHARACTERS (current_buffer) = Qnil;
2412 Z = Z_BYTE;
2413 BEGV = BEGV_BYTE;
2414 ZV = ZV_BYTE;
2415 GPT = GPT_BYTE;
2416 TEMP_SET_PT_BOTH (PT_BYTE, PT_BYTE);
2419 for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
2420 tail->charpos = tail->bytepos;
2422 /* Convert multibyte form of 8-bit characters to unibyte. */
2423 pos = BEG;
2424 stop = GPT;
2425 p = BEG_ADDR;
2426 while (1)
2428 int c, bytes;
2430 if (pos == stop)
2432 if (pos == Z)
2433 break;
2434 p = GAP_END_ADDR;
2435 stop = Z;
2437 if (ASCII_BYTE_P (*p))
2438 p++, pos++;
2439 else if (CHAR_BYTE8_HEAD_P (*p))
2441 c = STRING_CHAR_AND_LENGTH (p, bytes);
2442 /* Delete all bytes for this 8-bit character but the
2443 last one, and change the last one to the charcter
2444 code. */
2445 bytes--;
2446 del_range_2 (pos, pos, pos + bytes, pos + bytes, 0);
2447 p = GAP_END_ADDR;
2448 *p++ = c;
2449 pos++;
2450 if (begv > pos)
2451 begv -= bytes;
2452 if (zv > pos)
2453 zv -= bytes;
2454 stop = Z;
2456 else
2458 bytes = BYTES_BY_CHAR_HEAD (*p);
2459 p += bytes, pos += bytes;
2462 if (narrowed)
2463 Fnarrow_to_region (make_number (begv), make_number (zv));
2465 else
2467 int pt = PT;
2468 int pos, stop;
2469 unsigned char *p, *pend;
2471 /* Be sure not to have a multibyte sequence striding over the GAP.
2472 Ex: We change this: "...abc\302 _GAP_ \241def..."
2473 to: "...abc _GAP_ \302\241def..." */
2475 if (EQ (flag, Qt)
2476 && GPT_BYTE > 1 && GPT_BYTE < Z_BYTE
2477 && ! CHAR_HEAD_P (*(GAP_END_ADDR)))
2479 unsigned char *p = GPT_ADDR - 1;
2481 while (! CHAR_HEAD_P (*p) && p > BEG_ADDR) p--;
2482 if (BASE_LEADING_CODE_P (*p))
2484 int new_gpt = GPT_BYTE - (GPT_ADDR - p);
2486 move_gap_both (new_gpt, new_gpt);
2490 /* Make the buffer contents valid as multibyte by converting
2491 8-bit characters to multibyte form. */
2492 pos = BEG;
2493 stop = GPT;
2494 p = BEG_ADDR;
2495 pend = GPT_ADDR;
2496 while (1)
2498 int bytes;
2500 if (pos == stop)
2502 if (pos == Z)
2503 break;
2504 p = GAP_END_ADDR;
2505 pend = Z_ADDR;
2506 stop = Z;
2509 if (ASCII_BYTE_P (*p))
2510 p++, pos++;
2511 else if (EQ (flag, Qt)
2512 && ! CHAR_BYTE8_HEAD_P (*p)
2513 && (bytes = MULTIBYTE_LENGTH (p, pend)) > 0)
2514 p += bytes, pos += bytes;
2515 else
2517 unsigned char tmp[MAX_MULTIBYTE_LENGTH];
2518 int c;
2520 c = BYTE8_TO_CHAR (*p);
2521 bytes = CHAR_STRING (c, tmp);
2522 *p = tmp[0];
2523 TEMP_SET_PT_BOTH (pos + 1, pos + 1);
2524 bytes--;
2525 insert_1_both (tmp + 1, bytes, bytes, 1, 0, 0);
2526 /* Now the gap is after the just inserted data. */
2527 pos = GPT;
2528 p = GAP_END_ADDR;
2529 if (pos <= begv)
2530 begv += bytes;
2531 if (pos <= zv)
2532 zv += bytes;
2533 if (pos <= pt)
2534 pt += bytes;
2535 pend = Z_ADDR;
2536 stop = Z;
2540 if (pt != PT)
2541 TEMP_SET_PT (pt);
2543 if (narrowed)
2544 Fnarrow_to_region (make_number (begv), make_number (zv));
2546 /* Do this first, so that chars_in_text asks the right question.
2547 set_intervals_multibyte needs it too. */
2548 BUF_ENABLE_MULTIBYTE_CHARACTERS (current_buffer) = Qt;
2550 GPT_BYTE = advance_to_char_boundary (GPT_BYTE);
2551 GPT = chars_in_text (BEG_ADDR, GPT_BYTE - BEG_BYTE) + BEG;
2553 Z = chars_in_text (GAP_END_ADDR, Z_BYTE - GPT_BYTE) + GPT;
2555 BEGV_BYTE = advance_to_char_boundary (BEGV_BYTE);
2556 if (BEGV_BYTE > GPT_BYTE)
2557 BEGV = chars_in_text (GAP_END_ADDR, BEGV_BYTE - GPT_BYTE) + GPT;
2558 else
2559 BEGV = chars_in_text (BEG_ADDR, BEGV_BYTE - BEG_BYTE) + BEG;
2561 ZV_BYTE = advance_to_char_boundary (ZV_BYTE);
2562 if (ZV_BYTE > GPT_BYTE)
2563 ZV = chars_in_text (GAP_END_ADDR, ZV_BYTE - GPT_BYTE) + GPT;
2564 else
2565 ZV = chars_in_text (BEG_ADDR, ZV_BYTE - BEG_BYTE) + BEG;
2568 int pt_byte = advance_to_char_boundary (PT_BYTE);
2569 int pt;
2571 if (pt_byte > GPT_BYTE)
2572 pt = chars_in_text (GAP_END_ADDR, pt_byte - GPT_BYTE) + GPT;
2573 else
2574 pt = chars_in_text (BEG_ADDR, pt_byte - BEG_BYTE) + BEG;
2575 TEMP_SET_PT_BOTH (pt, pt_byte);
2578 tail = markers = BUF_MARKERS (current_buffer);
2580 /* This prevents BYTE_TO_CHAR (that is, buf_bytepos_to_charpos) from
2581 getting confused by the markers that have not yet been updated.
2582 It is also a signal that it should never create a marker. */
2583 BUF_MARKERS (current_buffer) = NULL;
2585 for (; tail; tail = tail->next)
2587 tail->bytepos = advance_to_char_boundary (tail->bytepos);
2588 tail->charpos = BYTE_TO_CHAR (tail->bytepos);
2591 /* Make sure no markers were put on the chain
2592 while the chain value was incorrect. */
2593 if (BUF_MARKERS (current_buffer))
2594 abort ();
2596 BUF_MARKERS (current_buffer) = markers;
2598 /* Do this last, so it can calculate the new correspondences
2599 between chars and bytes. */
2600 set_intervals_multibyte (1);
2603 if (!EQ (old_undo, Qt))
2605 /* Represent all the above changes by a special undo entry. */
2606 extern Lisp_Object Qapply;
2607 BUF_UNDO_LIST (current_buffer) = Fcons (list3 (Qapply,
2608 intern ("set-buffer-multibyte"),
2609 NILP (flag) ? Qt : Qnil),
2610 old_undo);
2613 UNGCPRO;
2615 /* Changing the multibyteness of a buffer means that all windows
2616 showing that buffer must be updated thoroughly. */
2617 current_buffer->prevent_redisplay_optimizations_p = 1;
2618 ++windows_or_buffers_changed;
2620 /* Copy this buffer's new multibyte status
2621 into all of its indirect buffers. */
2622 for (other = all_buffers; other; other = other->next)
2623 if (other->base_buffer == current_buffer && !NILP (BUF_NAME (other)))
2625 BUF_ENABLE_MULTIBYTE_CHARACTERS (other)
2626 = BUF_ENABLE_MULTIBYTE_CHARACTERS (current_buffer);
2627 other->prevent_redisplay_optimizations_p = 1;
2630 /* Restore the modifiedness of the buffer. */
2631 if (!modified_p && !NILP (Fbuffer_modified_p (Qnil)))
2632 Fset_buffer_modified_p (Qnil);
2634 #ifdef subprocesses
2635 /* Update coding systems of this buffer's process (if any). */
2637 Lisp_Object process;
2639 process = Fget_buffer_process (Fcurrent_buffer ());
2640 if (PROCESSP (process))
2641 setup_process_coding_systems (process);
2643 #endif /* subprocesses */
2645 return flag;
2648 DEFUN ("kill-all-local-variables", Fkill_all_local_variables, Skill_all_local_variables,
2649 0, 0, 0,
2650 doc: /* Switch to Fundamental mode by killing current buffer's local variables.
2651 Most local variable bindings are eliminated so that the default values
2652 become effective once more. Also, the syntax table is set from
2653 `standard-syntax-table', the local keymap is set to nil,
2654 and the abbrev table from `fundamental-mode-abbrev-table'.
2655 This function also forces redisplay of the mode line.
2657 Every function to select a new major mode starts by
2658 calling this function.
2660 As a special exception, local variables whose names have
2661 a non-nil `permanent-local' property are not eliminated by this function.
2663 The first thing this function does is run
2664 the normal hook `change-major-mode-hook'. */)
2667 if (!NILP (Vrun_hooks))
2668 call1 (Vrun_hooks, Qchange_major_mode_hook);
2670 /* Make sure none of the bindings in local_var_alist
2671 remain swapped in, in their symbols. */
2673 swap_out_buffer_local_variables (current_buffer);
2675 /* Actually eliminate all local bindings of this buffer. */
2677 reset_buffer_local_variables (current_buffer, 0);
2679 /* Force mode-line redisplay. Useful here because all major mode
2680 commands call this function. */
2681 update_mode_lines++;
2683 return Qnil;
2686 /* Make sure no local variables remain set up with buffer B
2687 for their current values. */
2689 static void
2690 swap_out_buffer_local_variables (b)
2691 struct buffer *b;
2693 Lisp_Object oalist, alist, sym, buffer;
2695 XSETBUFFER (buffer, b);
2696 oalist = BUF_LOCAL_VAR_ALIST (b);
2698 for (alist = oalist; CONSP (alist); alist = XCDR (alist))
2700 if (CONSP (XCAR (alist))
2701 && (sym = XCAR (XCAR (alist)), SYMBOLP (sym))
2702 /* Need not do anything if some other buffer's binding is
2703 now encached. */
2704 && EQ (XBUFFER_LOCAL_VALUE (SYMBOL_VALUE (sym))->buffer,
2705 buffer))
2707 /* Symbol is set up for this buffer's old local value:
2708 swap it out! */
2709 swap_in_global_binding (sym);
2714 /* Find all the overlays in the current buffer that contain position POS.
2715 Return the number found, and store them in a vector in *VEC_PTR.
2716 Store in *LEN_PTR the size allocated for the vector.
2717 Store in *NEXT_PTR the next position after POS where an overlay starts,
2718 or ZV if there are no more overlays between POS and ZV.
2719 Store in *PREV_PTR the previous position before POS where an overlay ends,
2720 or where an overlay starts which ends at or after POS;
2721 or BEGV if there are no such overlays from BEGV to POS.
2722 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
2724 *VEC_PTR and *LEN_PTR should contain a valid vector and size
2725 when this function is called.
2727 If EXTEND is non-zero, we make the vector bigger if necessary.
2728 If EXTEND is zero, we never extend the vector,
2729 and we store only as many overlays as will fit.
2730 But we still return the total number of overlays.
2732 If CHANGE_REQ is true, then any position written into *PREV_PTR or
2733 *NEXT_PTR is guaranteed to be not equal to POS, unless it is the
2734 default (BEGV or ZV). */
2737 overlays_at (pos, extend, vec_ptr, len_ptr, next_ptr, prev_ptr, change_req)
2738 EMACS_INT pos;
2739 int extend;
2740 Lisp_Object **vec_ptr;
2741 int *len_ptr;
2742 EMACS_INT *next_ptr;
2743 EMACS_INT *prev_ptr;
2744 int change_req;
2746 Lisp_Object overlay, start, end;
2747 struct Lisp_Overlay *tail;
2748 int idx = 0;
2749 int len = *len_ptr;
2750 Lisp_Object *vec = *vec_ptr;
2751 int next = ZV;
2752 int prev = BEGV;
2753 int inhibit_storing = 0;
2755 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
2757 int startpos, endpos;
2759 XSETMISC (overlay, tail);
2761 start = OVERLAY_START (overlay);
2762 end = OVERLAY_END (overlay);
2763 endpos = OVERLAY_POSITION (end);
2764 if (endpos < pos)
2766 if (prev < endpos)
2767 prev = endpos;
2768 break;
2770 startpos = OVERLAY_POSITION (start);
2771 /* This one ends at or after POS
2772 so its start counts for PREV_PTR if it's before POS. */
2773 if (prev < startpos && startpos < pos)
2774 prev = startpos;
2775 if (endpos == pos)
2776 continue;
2777 if (startpos <= pos)
2779 if (idx == len)
2781 /* The supplied vector is full.
2782 Either make it bigger, or don't store any more in it. */
2783 if (extend)
2785 /* Make it work with an initial len == 0. */
2786 len *= 2;
2787 if (len == 0)
2788 len = 4;
2789 *len_ptr = len;
2790 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2791 *vec_ptr = vec;
2793 else
2794 inhibit_storing = 1;
2797 if (!inhibit_storing)
2798 vec[idx] = overlay;
2799 /* Keep counting overlays even if we can't return them all. */
2800 idx++;
2802 else if (startpos < next)
2803 next = startpos;
2806 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
2808 int startpos, endpos;
2810 XSETMISC (overlay, tail);
2812 start = OVERLAY_START (overlay);
2813 end = OVERLAY_END (overlay);
2814 startpos = OVERLAY_POSITION (start);
2815 if (pos < startpos)
2817 if (startpos < next)
2818 next = startpos;
2819 break;
2821 endpos = OVERLAY_POSITION (end);
2822 if (pos < endpos)
2824 if (idx == len)
2826 if (extend)
2828 /* Make it work with an initial len == 0. */
2829 len *= 2;
2830 if (len == 0)
2831 len = 4;
2832 *len_ptr = len;
2833 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2834 *vec_ptr = vec;
2836 else
2837 inhibit_storing = 1;
2840 if (!inhibit_storing)
2841 vec[idx] = overlay;
2842 idx++;
2844 if (startpos < pos && startpos > prev)
2845 prev = startpos;
2847 else if (endpos < pos && endpos > prev)
2848 prev = endpos;
2849 else if (endpos == pos && startpos > prev
2850 && (!change_req || startpos < pos))
2851 prev = startpos;
2854 if (next_ptr)
2855 *next_ptr = next;
2856 if (prev_ptr)
2857 *prev_ptr = prev;
2858 return idx;
2861 /* Find all the overlays in the current buffer that overlap the range
2862 BEG-END, or are empty at BEG, or are empty at END provided END
2863 denotes the position at the end of the current buffer.
2865 Return the number found, and store them in a vector in *VEC_PTR.
2866 Store in *LEN_PTR the size allocated for the vector.
2867 Store in *NEXT_PTR the next position after POS where an overlay starts,
2868 or ZV if there are no more overlays.
2869 Store in *PREV_PTR the previous position before POS where an overlay ends,
2870 or BEGV if there are no previous overlays.
2871 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
2873 *VEC_PTR and *LEN_PTR should contain a valid vector and size
2874 when this function is called.
2876 If EXTEND is non-zero, we make the vector bigger if necessary.
2877 If EXTEND is zero, we never extend the vector,
2878 and we store only as many overlays as will fit.
2879 But we still return the total number of overlays. */
2881 static int
2882 overlays_in (beg, end, extend, vec_ptr, len_ptr, next_ptr, prev_ptr)
2883 int beg, end;
2884 int extend;
2885 Lisp_Object **vec_ptr;
2886 int *len_ptr;
2887 int *next_ptr;
2888 int *prev_ptr;
2890 Lisp_Object overlay, ostart, oend;
2891 struct Lisp_Overlay *tail;
2892 int idx = 0;
2893 int len = *len_ptr;
2894 Lisp_Object *vec = *vec_ptr;
2895 int next = ZV;
2896 int prev = BEGV;
2897 int inhibit_storing = 0;
2898 int end_is_Z = end == Z;
2900 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
2902 int startpos, endpos;
2904 XSETMISC (overlay, tail);
2906 ostart = OVERLAY_START (overlay);
2907 oend = OVERLAY_END (overlay);
2908 endpos = OVERLAY_POSITION (oend);
2909 if (endpos < beg)
2911 if (prev < endpos)
2912 prev = endpos;
2913 break;
2915 startpos = OVERLAY_POSITION (ostart);
2916 /* Count an interval if it overlaps the range, is empty at the
2917 start of the range, or is empty at END provided END denotes the
2918 end of the buffer. */
2919 if ((beg < endpos && startpos < end)
2920 || (startpos == endpos
2921 && (beg == endpos || (end_is_Z && endpos == end))))
2923 if (idx == len)
2925 /* The supplied vector is full.
2926 Either make it bigger, or don't store any more in it. */
2927 if (extend)
2929 /* Make it work with an initial len == 0. */
2930 len *= 2;
2931 if (len == 0)
2932 len = 4;
2933 *len_ptr = len;
2934 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2935 *vec_ptr = vec;
2937 else
2938 inhibit_storing = 1;
2941 if (!inhibit_storing)
2942 vec[idx] = overlay;
2943 /* Keep counting overlays even if we can't return them all. */
2944 idx++;
2946 else if (startpos < next)
2947 next = startpos;
2950 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
2952 int startpos, endpos;
2954 XSETMISC (overlay, tail);
2956 ostart = OVERLAY_START (overlay);
2957 oend = OVERLAY_END (overlay);
2958 startpos = OVERLAY_POSITION (ostart);
2959 if (end < startpos)
2961 if (startpos < next)
2962 next = startpos;
2963 break;
2965 endpos = OVERLAY_POSITION (oend);
2966 /* Count an interval if it overlaps the range, is empty at the
2967 start of the range, or is empty at END provided END denotes the
2968 end of the buffer. */
2969 if ((beg < endpos && startpos < end)
2970 || (startpos == endpos
2971 && (beg == endpos || (end_is_Z && endpos == end))))
2973 if (idx == len)
2975 if (extend)
2977 /* Make it work with an initial len == 0. */
2978 len *= 2;
2979 if (len == 0)
2980 len = 4;
2981 *len_ptr = len;
2982 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2983 *vec_ptr = vec;
2985 else
2986 inhibit_storing = 1;
2989 if (!inhibit_storing)
2990 vec[idx] = overlay;
2991 idx++;
2993 else if (endpos < beg && endpos > prev)
2994 prev = endpos;
2997 if (next_ptr)
2998 *next_ptr = next;
2999 if (prev_ptr)
3000 *prev_ptr = prev;
3001 return idx;
3005 /* Return non-zero if there exists an overlay with a non-nil
3006 `mouse-face' property overlapping OVERLAY. */
3009 mouse_face_overlay_overlaps (overlay)
3010 Lisp_Object overlay;
3012 int start = OVERLAY_POSITION (OVERLAY_START (overlay));
3013 int end = OVERLAY_POSITION (OVERLAY_END (overlay));
3014 int n, i, size;
3015 Lisp_Object *v, tem;
3017 size = 10;
3018 v = (Lisp_Object *) alloca (size * sizeof *v);
3019 n = overlays_in (start, end, 0, &v, &size, NULL, NULL);
3020 if (n > size)
3022 v = (Lisp_Object *) alloca (n * sizeof *v);
3023 overlays_in (start, end, 0, &v, &n, NULL, NULL);
3026 for (i = 0; i < n; ++i)
3027 if (!EQ (v[i], overlay)
3028 && (tem = Foverlay_get (overlay, Qmouse_face),
3029 !NILP (tem)))
3030 break;
3032 return i < n;
3037 /* Fast function to just test if we're at an overlay boundary. */
3039 overlay_touches_p (pos)
3040 int pos;
3042 Lisp_Object overlay;
3043 struct Lisp_Overlay *tail;
3045 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
3047 int endpos;
3049 XSETMISC (overlay ,tail);
3050 if (!OVERLAYP (overlay))
3051 abort ();
3053 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3054 if (endpos < pos)
3055 break;
3056 if (endpos == pos || OVERLAY_POSITION (OVERLAY_START (overlay)) == pos)
3057 return 1;
3060 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
3062 int startpos;
3064 XSETMISC (overlay, tail);
3065 if (!OVERLAYP (overlay))
3066 abort ();
3068 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3069 if (pos < startpos)
3070 break;
3071 if (startpos == pos || OVERLAY_POSITION (OVERLAY_END (overlay)) == pos)
3072 return 1;
3074 return 0;
3077 struct sortvec
3079 Lisp_Object overlay;
3080 int beg, end;
3081 int priority;
3084 static int
3085 compare_overlays (v1, v2)
3086 const void *v1, *v2;
3088 const struct sortvec *s1 = (const struct sortvec *) v1;
3089 const struct sortvec *s2 = (const struct sortvec *) v2;
3090 if (s1->priority != s2->priority)
3091 return s1->priority - s2->priority;
3092 if (s1->beg != s2->beg)
3093 return s1->beg - s2->beg;
3094 if (s1->end != s2->end)
3095 return s2->end - s1->end;
3096 return 0;
3099 /* Sort an array of overlays by priority. The array is modified in place.
3100 The return value is the new size; this may be smaller than the original
3101 size if some of the overlays were invalid or were window-specific. */
3103 sort_overlays (overlay_vec, noverlays, w)
3104 Lisp_Object *overlay_vec;
3105 int noverlays;
3106 struct window *w;
3108 int i, j;
3109 struct sortvec *sortvec;
3110 sortvec = (struct sortvec *) alloca (noverlays * sizeof (struct sortvec));
3112 /* Put the valid and relevant overlays into sortvec. */
3114 for (i = 0, j = 0; i < noverlays; i++)
3116 Lisp_Object tem;
3117 Lisp_Object overlay;
3119 overlay = overlay_vec[i];
3120 if (OVERLAY_VALID (overlay)
3121 && OVERLAY_POSITION (OVERLAY_START (overlay)) > 0
3122 && OVERLAY_POSITION (OVERLAY_END (overlay)) > 0)
3124 /* If we're interested in a specific window, then ignore
3125 overlays that are limited to some other window. */
3126 if (w)
3128 Lisp_Object window;
3130 window = Foverlay_get (overlay, Qwindow);
3131 if (WINDOWP (window) && XWINDOW (window) != w)
3132 continue;
3135 /* This overlay is good and counts: put it into sortvec. */
3136 sortvec[j].overlay = overlay;
3137 sortvec[j].beg = OVERLAY_POSITION (OVERLAY_START (overlay));
3138 sortvec[j].end = OVERLAY_POSITION (OVERLAY_END (overlay));
3139 tem = Foverlay_get (overlay, Qpriority);
3140 if (INTEGERP (tem))
3141 sortvec[j].priority = XINT (tem);
3142 else
3143 sortvec[j].priority = 0;
3144 j++;
3147 noverlays = j;
3149 /* Sort the overlays into the proper order: increasing priority. */
3151 if (noverlays > 1)
3152 qsort (sortvec, noverlays, sizeof (struct sortvec), compare_overlays);
3154 for (i = 0; i < noverlays; i++)
3155 overlay_vec[i] = sortvec[i].overlay;
3156 return (noverlays);
3159 struct sortstr
3161 Lisp_Object string, string2;
3162 int size;
3163 int priority;
3166 struct sortstrlist
3168 struct sortstr *buf; /* An array that expands as needed; never freed. */
3169 int size; /* Allocated length of that array. */
3170 int used; /* How much of the array is currently in use. */
3171 int bytes; /* Total length of the strings in buf. */
3174 /* Buffers for storing information about the overlays touching a given
3175 position. These could be automatic variables in overlay_strings, but
3176 it's more efficient to hold onto the memory instead of repeatedly
3177 allocating and freeing it. */
3178 static struct sortstrlist overlay_heads, overlay_tails;
3179 static unsigned char *overlay_str_buf;
3181 /* Allocated length of overlay_str_buf. */
3182 static int overlay_str_len;
3184 /* A comparison function suitable for passing to qsort. */
3185 static int
3186 cmp_for_strings (as1, as2)
3187 char *as1, *as2;
3189 struct sortstr *s1 = (struct sortstr *)as1;
3190 struct sortstr *s2 = (struct sortstr *)as2;
3191 if (s1->size != s2->size)
3192 return s2->size - s1->size;
3193 if (s1->priority != s2->priority)
3194 return s1->priority - s2->priority;
3195 return 0;
3198 static void
3199 record_overlay_string (ssl, str, str2, pri, size)
3200 struct sortstrlist *ssl;
3201 Lisp_Object str, str2, pri;
3202 int size;
3204 int nbytes;
3206 if (ssl->used == ssl->size)
3208 if (ssl->buf)
3209 ssl->size *= 2;
3210 else
3211 ssl->size = 5;
3212 ssl->buf = ((struct sortstr *)
3213 xrealloc (ssl->buf, ssl->size * sizeof (struct sortstr)));
3215 ssl->buf[ssl->used].string = str;
3216 ssl->buf[ssl->used].string2 = str2;
3217 ssl->buf[ssl->used].size = size;
3218 ssl->buf[ssl->used].priority = (INTEGERP (pri) ? XINT (pri) : 0);
3219 ssl->used++;
3221 if (NILP (BUF_ENABLE_MULTIBYTE_CHARACTERS (current_buffer)))
3222 nbytes = SCHARS (str);
3223 else if (! STRING_MULTIBYTE (str))
3224 nbytes = count_size_as_multibyte (SDATA (str),
3225 SBYTES (str));
3226 else
3227 nbytes = SBYTES (str);
3229 ssl->bytes += nbytes;
3231 if (STRINGP (str2))
3233 if (NILP (BUF_ENABLE_MULTIBYTE_CHARACTERS (current_buffer)))
3234 nbytes = SCHARS (str2);
3235 else if (! STRING_MULTIBYTE (str2))
3236 nbytes = count_size_as_multibyte (SDATA (str2),
3237 SBYTES (str2));
3238 else
3239 nbytes = SBYTES (str2);
3241 ssl->bytes += nbytes;
3245 /* Return the concatenation of the strings associated with overlays that
3246 begin or end at POS, ignoring overlays that are specific to a window
3247 other than W. The strings are concatenated in the appropriate order:
3248 shorter overlays nest inside longer ones, and higher priority inside
3249 lower. Normally all of the after-strings come first, but zero-sized
3250 overlays have their after-strings ride along with the before-strings
3251 because it would look strange to print them inside-out.
3253 Returns the string length, and stores the contents indirectly through
3254 PSTR, if that variable is non-null. The string may be overwritten by
3255 subsequent calls. */
3258 overlay_strings (pos, w, pstr)
3259 EMACS_INT pos;
3260 struct window *w;
3261 unsigned char **pstr;
3263 Lisp_Object overlay, window, str;
3264 struct Lisp_Overlay *ov;
3265 int startpos, endpos;
3266 int multibyte = ! NILP (BUF_ENABLE_MULTIBYTE_CHARACTERS (current_buffer));
3268 overlay_heads.used = overlay_heads.bytes = 0;
3269 overlay_tails.used = overlay_tails.bytes = 0;
3270 for (ov = current_buffer->overlays_before; ov; ov = ov->next)
3272 XSETMISC (overlay, ov);
3273 eassert (OVERLAYP (overlay));
3275 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3276 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3277 if (endpos < pos)
3278 break;
3279 if (endpos != pos && startpos != pos)
3280 continue;
3281 window = Foverlay_get (overlay, Qwindow);
3282 if (WINDOWP (window) && XWINDOW (window) != w)
3283 continue;
3284 if (startpos == pos
3285 && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
3286 record_overlay_string (&overlay_heads, str,
3287 (startpos == endpos
3288 ? Foverlay_get (overlay, Qafter_string)
3289 : Qnil),
3290 Foverlay_get (overlay, Qpriority),
3291 endpos - startpos);
3292 else if (endpos == pos
3293 && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
3294 record_overlay_string (&overlay_tails, str, Qnil,
3295 Foverlay_get (overlay, Qpriority),
3296 endpos - startpos);
3298 for (ov = current_buffer->overlays_after; ov; ov = ov->next)
3300 XSETMISC (overlay, ov);
3301 eassert (OVERLAYP (overlay));
3303 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3304 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3305 if (startpos > pos)
3306 break;
3307 if (endpos != pos && startpos != pos)
3308 continue;
3309 window = Foverlay_get (overlay, Qwindow);
3310 if (WINDOWP (window) && XWINDOW (window) != w)
3311 continue;
3312 if (startpos == pos
3313 && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
3314 record_overlay_string (&overlay_heads, str,
3315 (startpos == endpos
3316 ? Foverlay_get (overlay, Qafter_string)
3317 : Qnil),
3318 Foverlay_get (overlay, Qpriority),
3319 endpos - startpos);
3320 else if (endpos == pos
3321 && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
3322 record_overlay_string (&overlay_tails, str, Qnil,
3323 Foverlay_get (overlay, Qpriority),
3324 endpos - startpos);
3326 if (overlay_tails.used > 1)
3327 qsort (overlay_tails.buf, overlay_tails.used, sizeof (struct sortstr),
3328 cmp_for_strings);
3329 if (overlay_heads.used > 1)
3330 qsort (overlay_heads.buf, overlay_heads.used, sizeof (struct sortstr),
3331 cmp_for_strings);
3332 if (overlay_heads.bytes || overlay_tails.bytes)
3334 Lisp_Object tem;
3335 int i;
3336 unsigned char *p;
3337 int total = overlay_heads.bytes + overlay_tails.bytes;
3339 if (total > overlay_str_len)
3341 overlay_str_len = total;
3342 overlay_str_buf = (unsigned char *)xrealloc (overlay_str_buf,
3343 total);
3345 p = overlay_str_buf;
3346 for (i = overlay_tails.used; --i >= 0;)
3348 int nbytes;
3349 tem = overlay_tails.buf[i].string;
3350 nbytes = copy_text (SDATA (tem), p,
3351 SBYTES (tem),
3352 STRING_MULTIBYTE (tem), multibyte);
3353 p += nbytes;
3355 for (i = 0; i < overlay_heads.used; ++i)
3357 int nbytes;
3358 tem = overlay_heads.buf[i].string;
3359 nbytes = copy_text (SDATA (tem), p,
3360 SBYTES (tem),
3361 STRING_MULTIBYTE (tem), multibyte);
3362 p += nbytes;
3363 tem = overlay_heads.buf[i].string2;
3364 if (STRINGP (tem))
3366 nbytes = copy_text (SDATA (tem), p,
3367 SBYTES (tem),
3368 STRING_MULTIBYTE (tem), multibyte);
3369 p += nbytes;
3372 if (p != overlay_str_buf + total)
3373 abort ();
3374 if (pstr)
3375 *pstr = overlay_str_buf;
3376 return total;
3378 return 0;
3381 /* Shift overlays in BUF's overlay lists, to center the lists at POS. */
3383 void
3384 recenter_overlay_lists (buf, pos)
3385 struct buffer *buf;
3386 EMACS_INT pos;
3388 Lisp_Object overlay, beg, end;
3389 struct Lisp_Overlay *prev, *tail, *next;
3391 /* See if anything in overlays_before should move to overlays_after. */
3393 /* We don't strictly need prev in this loop; it should always be nil.
3394 But we use it for symmetry and in case that should cease to be true
3395 with some future change. */
3396 prev = NULL;
3397 for (tail = buf->overlays_before; tail; prev = tail, tail = next)
3399 next = tail->next;
3400 XSETMISC (overlay, tail);
3402 /* If the overlay is not valid, get rid of it. */
3403 if (!OVERLAY_VALID (overlay))
3404 #if 1
3405 abort ();
3406 #else
3408 /* Splice the cons cell TAIL out of overlays_before. */
3409 if (!NILP (prev))
3410 XCDR (prev) = next;
3411 else
3412 buf->overlays_before = next;
3413 tail = prev;
3414 continue;
3416 #endif
3418 beg = OVERLAY_START (overlay);
3419 end = OVERLAY_END (overlay);
3421 if (OVERLAY_POSITION (end) > pos)
3423 /* OVERLAY needs to be moved. */
3424 int where = OVERLAY_POSITION (beg);
3425 struct Lisp_Overlay *other, *other_prev;
3427 /* Splice the cons cell TAIL out of overlays_before. */
3428 if (prev)
3429 prev->next = next;
3430 else
3431 buf->overlays_before = next;
3433 /* Search thru overlays_after for where to put it. */
3434 other_prev = NULL;
3435 for (other = buf->overlays_after; other;
3436 other_prev = other, other = other->next)
3438 Lisp_Object otherbeg, otheroverlay;
3440 XSETMISC (otheroverlay, other);
3441 eassert (OVERLAY_VALID (otheroverlay));
3443 otherbeg = OVERLAY_START (otheroverlay);
3444 if (OVERLAY_POSITION (otherbeg) >= where)
3445 break;
3448 /* Add TAIL to overlays_after before OTHER. */
3449 tail->next = other;
3450 if (other_prev)
3451 other_prev->next = tail;
3452 else
3453 buf->overlays_after = tail;
3454 tail = prev;
3456 else
3457 /* We've reached the things that should stay in overlays_before.
3458 All the rest of overlays_before must end even earlier,
3459 so stop now. */
3460 break;
3463 /* See if anything in overlays_after should be in overlays_before. */
3464 prev = NULL;
3465 for (tail = buf->overlays_after; tail; prev = tail, tail = next)
3467 next = tail->next;
3468 XSETMISC (overlay, tail);
3470 /* If the overlay is not valid, get rid of it. */
3471 if (!OVERLAY_VALID (overlay))
3472 #if 1
3473 abort ();
3474 #else
3476 /* Splice the cons cell TAIL out of overlays_after. */
3477 if (!NILP (prev))
3478 XCDR (prev) = next;
3479 else
3480 buf->overlays_after = next;
3481 tail = prev;
3482 continue;
3484 #endif
3486 beg = OVERLAY_START (overlay);
3487 end = OVERLAY_END (overlay);
3489 /* Stop looking, when we know that nothing further
3490 can possibly end before POS. */
3491 if (OVERLAY_POSITION (beg) > pos)
3492 break;
3494 if (OVERLAY_POSITION (end) <= pos)
3496 /* OVERLAY needs to be moved. */
3497 int where = OVERLAY_POSITION (end);
3498 struct Lisp_Overlay *other, *other_prev;
3500 /* Splice the cons cell TAIL out of overlays_after. */
3501 if (prev)
3502 prev->next = next;
3503 else
3504 buf->overlays_after = next;
3506 /* Search thru overlays_before for where to put it. */
3507 other_prev = NULL;
3508 for (other = buf->overlays_before; other;
3509 other_prev = other, other = other->next)
3511 Lisp_Object otherend, otheroverlay;
3513 XSETMISC (otheroverlay, other);
3514 eassert (OVERLAY_VALID (otheroverlay));
3516 otherend = OVERLAY_END (otheroverlay);
3517 if (OVERLAY_POSITION (otherend) <= where)
3518 break;
3521 /* Add TAIL to overlays_before before OTHER. */
3522 tail->next = other;
3523 if (other_prev)
3524 other_prev->next = tail;
3525 else
3526 buf->overlays_before = tail;
3527 tail = prev;
3531 buf->overlay_center = pos;
3534 void
3535 adjust_overlays_for_insert (pos, length)
3536 EMACS_INT pos;
3537 EMACS_INT length;
3539 /* After an insertion, the lists are still sorted properly,
3540 but we may need to update the value of the overlay center. */
3541 if (current_buffer->overlay_center >= pos)
3542 current_buffer->overlay_center += length;
3545 void
3546 adjust_overlays_for_delete (pos, length)
3547 EMACS_INT pos;
3548 EMACS_INT length;
3550 if (current_buffer->overlay_center < pos)
3551 /* The deletion was to our right. No change needed; the before- and
3552 after-lists are still consistent. */
3554 else if (current_buffer->overlay_center > pos + length)
3555 /* The deletion was to our left. We need to adjust the center value
3556 to account for the change in position, but the lists are consistent
3557 given the new value. */
3558 current_buffer->overlay_center -= length;
3559 else
3560 /* We're right in the middle. There might be things on the after-list
3561 that now belong on the before-list. Recentering will move them,
3562 and also update the center point. */
3563 recenter_overlay_lists (current_buffer, pos);
3566 /* Fix up overlays that were garbled as a result of permuting markers
3567 in the range START through END. Any overlay with at least one
3568 endpoint in this range will need to be unlinked from the overlay
3569 list and reinserted in its proper place.
3570 Such an overlay might even have negative size at this point.
3571 If so, we'll make the overlay empty. */
3572 void
3573 fix_start_end_in_overlays (start, end)
3574 register int start, end;
3576 Lisp_Object overlay;
3577 struct Lisp_Overlay *before_list, *after_list;
3578 /* These are either nil, indicating that before_list or after_list
3579 should be assigned, or the cons cell the cdr of which should be
3580 assigned. */
3581 struct Lisp_Overlay *beforep = NULL, *afterp = NULL;
3582 /* 'Parent', likewise, indicates a cons cell or
3583 current_buffer->overlays_before or overlays_after, depending
3584 which loop we're in. */
3585 struct Lisp_Overlay *tail, *parent;
3586 int startpos, endpos;
3588 /* This algorithm shifts links around instead of consing and GCing.
3589 The loop invariant is that before_list (resp. after_list) is a
3590 well-formed list except that its last element, the CDR of beforep
3591 (resp. afterp) if beforep (afterp) isn't nil or before_list
3592 (after_list) if it is, is still uninitialized. So it's not a bug
3593 that before_list isn't initialized, although it may look
3594 strange. */
3595 for (parent = NULL, tail = current_buffer->overlays_before; tail;)
3597 XSETMISC (overlay, tail);
3599 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3600 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3602 /* If the overlay is backwards, make it empty. */
3603 if (endpos < startpos)
3605 startpos = endpos;
3606 Fset_marker (OVERLAY_START (overlay), make_number (startpos),
3607 Qnil);
3610 if (endpos < start)
3611 break;
3613 if (endpos < end
3614 || (startpos >= start && startpos < end))
3616 /* Add it to the end of the wrong list. Later on,
3617 recenter_overlay_lists will move it to the right place. */
3618 if (endpos < current_buffer->overlay_center)
3620 if (!afterp)
3621 after_list = tail;
3622 else
3623 afterp->next = tail;
3624 afterp = tail;
3626 else
3628 if (!beforep)
3629 before_list = tail;
3630 else
3631 beforep->next = tail;
3632 beforep = tail;
3634 if (!parent)
3635 current_buffer->overlays_before = tail->next;
3636 else
3637 parent->next = tail->next;
3638 tail = tail->next;
3640 else
3641 parent = tail, tail = parent->next;
3643 for (parent = NULL, tail = current_buffer->overlays_after; tail;)
3645 XSETMISC (overlay, tail);
3647 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3648 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3650 /* If the overlay is backwards, make it empty. */
3651 if (endpos < startpos)
3653 startpos = endpos;
3654 Fset_marker (OVERLAY_START (overlay), make_number (startpos),
3655 Qnil);
3658 if (startpos >= end)
3659 break;
3661 if (startpos >= start
3662 || (endpos >= start && endpos < end))
3664 if (endpos < current_buffer->overlay_center)
3666 if (!afterp)
3667 after_list = tail;
3668 else
3669 afterp->next = tail;
3670 afterp = tail;
3672 else
3674 if (!beforep)
3675 before_list = tail;
3676 else
3677 beforep->next = tail;
3678 beforep = tail;
3680 if (!parent)
3681 current_buffer->overlays_after = tail->next;
3682 else
3683 parent->next = tail->next;
3684 tail = tail->next;
3686 else
3687 parent = tail, tail = parent->next;
3690 /* Splice the constructed (wrong) lists into the buffer's lists,
3691 and let the recenter function make it sane again. */
3692 if (beforep)
3694 beforep->next = current_buffer->overlays_before;
3695 current_buffer->overlays_before = before_list;
3697 recenter_overlay_lists (current_buffer, current_buffer->overlay_center);
3699 if (afterp)
3701 afterp->next = current_buffer->overlays_after;
3702 current_buffer->overlays_after = after_list;
3704 recenter_overlay_lists (current_buffer, current_buffer->overlay_center);
3707 /* We have two types of overlay: the one whose ending marker is
3708 after-insertion-marker (this is the usual case) and the one whose
3709 ending marker is before-insertion-marker. When `overlays_before'
3710 contains overlays of the latter type and the former type in this
3711 order and both overlays end at inserting position, inserting a text
3712 increases only the ending marker of the latter type, which results
3713 in incorrect ordering of `overlays_before'.
3715 This function fixes ordering of overlays in the slot
3716 `overlays_before' of the buffer *BP. Before the insertion, `point'
3717 was at PREV, and now is at POS. */
3719 void
3720 fix_overlays_before (bp, prev, pos)
3721 struct buffer *bp;
3722 EMACS_INT prev, pos;
3724 /* If parent is nil, replace overlays_before; otherwise, parent->next. */
3725 struct Lisp_Overlay *tail = bp->overlays_before, *parent = NULL, *right_pair;
3726 Lisp_Object tem;
3727 EMACS_INT end;
3729 /* After the insertion, the several overlays may be in incorrect
3730 order. The possibility is that, in the list `overlays_before',
3731 an overlay which ends at POS appears after an overlay which ends
3732 at PREV. Since POS is greater than PREV, we must fix the
3733 ordering of these overlays, by moving overlays ends at POS before
3734 the overlays ends at PREV. */
3736 /* At first, find a place where disordered overlays should be linked
3737 in. It is where an overlay which end before POS exists. (i.e. an
3738 overlay whose ending marker is after-insertion-marker if disorder
3739 exists). */
3740 while (tail
3741 && (XSETMISC (tem, tail),
3742 (end = OVERLAY_POSITION (OVERLAY_END (tem))) >= pos))
3744 parent = tail;
3745 tail = tail->next;
3748 /* If we don't find such an overlay,
3749 or the found one ends before PREV,
3750 or the found one is the last one in the list,
3751 we don't have to fix anything. */
3752 if (!tail || end < prev || !tail->next)
3753 return;
3755 right_pair = parent;
3756 parent = tail;
3757 tail = tail->next;
3759 /* Now, end position of overlays in the list TAIL should be before
3760 or equal to PREV. In the loop, an overlay which ends at POS is
3761 moved ahead to the place indicated by the CDR of RIGHT_PAIR. If
3762 we found an overlay which ends before PREV, the remaining
3763 overlays are in correct order. */
3764 while (tail)
3766 XSETMISC (tem, tail);
3767 end = OVERLAY_POSITION (OVERLAY_END (tem));
3769 if (end == pos)
3770 { /* This overlay is disordered. */
3771 struct Lisp_Overlay *found = tail;
3773 /* Unlink the found overlay. */
3774 tail = found->next;
3775 parent->next = tail;
3776 /* Move an overlay at RIGHT_PLACE to the next of the found one,
3777 and link it into the right place. */
3778 if (!right_pair)
3780 found->next = bp->overlays_before;
3781 bp->overlays_before = found;
3783 else
3785 found->next = right_pair->next;
3786 right_pair->next = found;
3789 else if (end == prev)
3791 parent = tail;
3792 tail = tail->next;
3794 else /* No more disordered overlay. */
3795 break;
3799 DEFUN ("overlayp", Foverlayp, Soverlayp, 1, 1, 0,
3800 doc: /* Return t if OBJECT is an overlay. */)
3801 (object)
3802 Lisp_Object object;
3804 return (OVERLAYP (object) ? Qt : Qnil);
3807 DEFUN ("make-overlay", Fmake_overlay, Smake_overlay, 2, 5, 0,
3808 doc: /* Create a new overlay with range BEG to END in BUFFER.
3809 If omitted, BUFFER defaults to the current buffer.
3810 BEG and END may be integers or markers.
3811 The fourth arg FRONT-ADVANCE, if non-nil, makes the marker
3812 for the front of the overlay advance when text is inserted there
3813 \(which means the text *is not* included in the overlay).
3814 The fifth arg REAR-ADVANCE, if non-nil, makes the marker
3815 for the rear of the overlay advance when text is inserted there
3816 \(which means the text *is* included in the overlay). */)
3817 (beg, end, buffer, front_advance, rear_advance)
3818 Lisp_Object beg, end, buffer;
3819 Lisp_Object front_advance, rear_advance;
3821 Lisp_Object overlay;
3822 struct buffer *b;
3824 if (NILP (buffer))
3825 XSETBUFFER (buffer, current_buffer);
3826 else
3827 CHECK_BUFFER (buffer);
3828 if (MARKERP (beg)
3829 && ! EQ (Fmarker_buffer (beg), buffer))
3830 error ("Marker points into wrong buffer");
3831 if (MARKERP (end)
3832 && ! EQ (Fmarker_buffer (end), buffer))
3833 error ("Marker points into wrong buffer");
3835 CHECK_NUMBER_COERCE_MARKER (beg);
3836 CHECK_NUMBER_COERCE_MARKER (end);
3838 if (XINT (beg) > XINT (end))
3840 Lisp_Object temp;
3841 temp = beg; beg = end; end = temp;
3844 b = XBUFFER (buffer);
3846 beg = Fset_marker (Fmake_marker (), beg, buffer);
3847 end = Fset_marker (Fmake_marker (), end, buffer);
3849 if (!NILP (front_advance))
3850 XMARKER (beg)->insertion_type = 1;
3851 if (!NILP (rear_advance))
3852 XMARKER (end)->insertion_type = 1;
3854 overlay = allocate_misc ();
3855 XMISCTYPE (overlay) = Lisp_Misc_Overlay;
3856 XOVERLAY (overlay)->start = beg;
3857 XOVERLAY (overlay)->end = end;
3858 XOVERLAY (overlay)->plist = Qnil;
3859 XOVERLAY (overlay)->next = NULL;
3861 /* Put the new overlay on the wrong list. */
3862 end = OVERLAY_END (overlay);
3863 if (OVERLAY_POSITION (end) < b->overlay_center)
3865 if (b->overlays_after)
3866 XOVERLAY (overlay)->next = b->overlays_after;
3867 b->overlays_after = XOVERLAY (overlay);
3869 else
3871 if (b->overlays_before)
3872 XOVERLAY (overlay)->next = b->overlays_before;
3873 b->overlays_before = XOVERLAY (overlay);
3876 /* This puts it in the right list, and in the right order. */
3877 recenter_overlay_lists (b, b->overlay_center);
3879 /* We don't need to redisplay the region covered by the overlay, because
3880 the overlay has no properties at the moment. */
3882 return overlay;
3885 /* Mark a section of BUF as needing redisplay because of overlays changes. */
3887 static void
3888 modify_overlay (buf, start, end)
3889 struct buffer *buf;
3890 EMACS_INT start, end;
3892 if (start > end)
3894 int temp = start;
3895 start = end;
3896 end = temp;
3899 BUF_COMPUTE_UNCHANGED (buf, start, end);
3901 /* If this is a buffer not in the selected window,
3902 we must do other windows. */
3903 if (buf != XBUFFER (XWINDOW (selected_window)->buffer))
3904 windows_or_buffers_changed = 1;
3905 /* If multiple windows show this buffer, we must do other windows. */
3906 else if (buffer_shared > 1)
3907 windows_or_buffers_changed = 1;
3908 /* If we modify an overlay at the end of the buffer, we cannot
3909 be sure that window end is still valid. */
3910 else if (end >= ZV && start <= ZV)
3911 windows_or_buffers_changed = 1;
3913 ++BUF_OVERLAY_MODIFF (buf);
3917 Lisp_Object Fdelete_overlay ();
3919 static struct Lisp_Overlay *
3920 unchain_overlay (list, overlay)
3921 struct Lisp_Overlay *list, *overlay;
3923 struct Lisp_Overlay *tmp, *prev;
3924 for (tmp = list, prev = NULL; tmp; prev = tmp, tmp = tmp->next)
3925 if (tmp == overlay)
3927 if (prev)
3928 prev->next = tmp->next;
3929 else
3930 list = tmp->next;
3931 overlay->next = NULL;
3932 break;
3934 return list;
3937 DEFUN ("move-overlay", Fmove_overlay, Smove_overlay, 3, 4, 0,
3938 doc: /* Set the endpoints of OVERLAY to BEG and END in BUFFER.
3939 If BUFFER is omitted, leave OVERLAY in the same buffer it inhabits now.
3940 If BUFFER is omitted, and OVERLAY is in no buffer, put it in the current
3941 buffer. */)
3942 (overlay, beg, end, buffer)
3943 Lisp_Object overlay, beg, end, buffer;
3945 struct buffer *b, *ob;
3946 Lisp_Object obuffer;
3947 int count = SPECPDL_INDEX ();
3949 CHECK_OVERLAY (overlay);
3950 if (NILP (buffer))
3951 buffer = Fmarker_buffer (OVERLAY_START (overlay));
3952 if (NILP (buffer))
3953 XSETBUFFER (buffer, current_buffer);
3954 CHECK_BUFFER (buffer);
3956 if (MARKERP (beg)
3957 && ! EQ (Fmarker_buffer (beg), buffer))
3958 error ("Marker points into wrong buffer");
3959 if (MARKERP (end)
3960 && ! EQ (Fmarker_buffer (end), buffer))
3961 error ("Marker points into wrong buffer");
3963 CHECK_NUMBER_COERCE_MARKER (beg);
3964 CHECK_NUMBER_COERCE_MARKER (end);
3966 if (XINT (beg) == XINT (end) && ! NILP (Foverlay_get (overlay, Qevaporate)))
3967 return Fdelete_overlay (overlay);
3969 if (XINT (beg) > XINT (end))
3971 Lisp_Object temp;
3972 temp = beg; beg = end; end = temp;
3975 specbind (Qinhibit_quit, Qt);
3977 obuffer = Fmarker_buffer (OVERLAY_START (overlay));
3978 b = XBUFFER (buffer);
3979 ob = BUFFERP (obuffer) ? XBUFFER (obuffer) : (struct buffer *) 0;
3981 /* If the overlay has changed buffers, do a thorough redisplay. */
3982 if (!EQ (buffer, obuffer))
3984 /* Redisplay where the overlay was. */
3985 if (!NILP (obuffer))
3987 int o_beg;
3988 int o_end;
3990 o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
3991 o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
3993 modify_overlay (ob, o_beg, o_end);
3996 /* Redisplay where the overlay is going to be. */
3997 modify_overlay (b, XINT (beg), XINT (end));
3999 else
4000 /* Redisplay the area the overlay has just left, or just enclosed. */
4002 int o_beg, o_end;
4004 o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
4005 o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
4007 if (o_beg == XINT (beg))
4008 modify_overlay (b, o_end, XINT (end));
4009 else if (o_end == XINT (end))
4010 modify_overlay (b, o_beg, XINT (beg));
4011 else
4013 if (XINT (beg) < o_beg) o_beg = XINT (beg);
4014 if (XINT (end) > o_end) o_end = XINT (end);
4015 modify_overlay (b, o_beg, o_end);
4019 if (!NILP (obuffer))
4021 ob->overlays_before
4022 = unchain_overlay (ob->overlays_before, XOVERLAY (overlay));
4023 ob->overlays_after
4024 = unchain_overlay (ob->overlays_after, XOVERLAY (overlay));
4025 eassert (XOVERLAY (overlay)->next == NULL);
4028 Fset_marker (OVERLAY_START (overlay), beg, buffer);
4029 Fset_marker (OVERLAY_END (overlay), end, buffer);
4031 /* Put the overlay on the wrong list. */
4032 end = OVERLAY_END (overlay);
4033 if (OVERLAY_POSITION (end) < b->overlay_center)
4035 XOVERLAY (overlay)->next = b->overlays_after;
4036 b->overlays_after = XOVERLAY (overlay);
4038 else
4040 XOVERLAY (overlay)->next = b->overlays_before;
4041 b->overlays_before = XOVERLAY (overlay);
4044 /* This puts it in the right list, and in the right order. */
4045 recenter_overlay_lists (b, b->overlay_center);
4047 return unbind_to (count, overlay);
4050 DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0,
4051 doc: /* Delete the overlay OVERLAY from its buffer. */)
4052 (overlay)
4053 Lisp_Object overlay;
4055 Lisp_Object buffer;
4056 struct buffer *b;
4057 int count = SPECPDL_INDEX ();
4059 CHECK_OVERLAY (overlay);
4061 buffer = Fmarker_buffer (OVERLAY_START (overlay));
4062 if (NILP (buffer))
4063 return Qnil;
4065 b = XBUFFER (buffer);
4066 specbind (Qinhibit_quit, Qt);
4068 b->overlays_before = unchain_overlay (b->overlays_before,XOVERLAY (overlay));
4069 b->overlays_after = unchain_overlay (b->overlays_after, XOVERLAY (overlay));
4070 eassert (XOVERLAY (overlay)->next == NULL);
4071 modify_overlay (b,
4072 marker_position (OVERLAY_START (overlay)),
4073 marker_position (OVERLAY_END (overlay)));
4074 Fset_marker (OVERLAY_START (overlay), Qnil, Qnil);
4075 Fset_marker (OVERLAY_END (overlay), Qnil, Qnil);
4077 /* When deleting an overlay with before or after strings, turn off
4078 display optimizations for the affected buffer, on the basis that
4079 these strings may contain newlines. This is easier to do than to
4080 check for that situation during redisplay. */
4081 if (!windows_or_buffers_changed
4082 && (!NILP (Foverlay_get (overlay, Qbefore_string))
4083 || !NILP (Foverlay_get (overlay, Qafter_string))))
4084 b->prevent_redisplay_optimizations_p = 1;
4086 return unbind_to (count, Qnil);
4089 /* Overlay dissection functions. */
4091 DEFUN ("overlay-start", Foverlay_start, Soverlay_start, 1, 1, 0,
4092 doc: /* Return the position at which OVERLAY starts. */)
4093 (overlay)
4094 Lisp_Object overlay;
4096 CHECK_OVERLAY (overlay);
4098 return (Fmarker_position (OVERLAY_START (overlay)));
4101 DEFUN ("overlay-end", Foverlay_end, Soverlay_end, 1, 1, 0,
4102 doc: /* Return the position at which OVERLAY ends. */)
4103 (overlay)
4104 Lisp_Object overlay;
4106 CHECK_OVERLAY (overlay);
4108 return (Fmarker_position (OVERLAY_END (overlay)));
4111 DEFUN ("overlay-buffer", Foverlay_buffer, Soverlay_buffer, 1, 1, 0,
4112 doc: /* Return the buffer OVERLAY belongs to.
4113 Return nil if OVERLAY has been deleted. */)
4114 (overlay)
4115 Lisp_Object overlay;
4117 CHECK_OVERLAY (overlay);
4119 return Fmarker_buffer (OVERLAY_START (overlay));
4122 DEFUN ("overlay-properties", Foverlay_properties, Soverlay_properties, 1, 1, 0,
4123 doc: /* Return a list of the properties on OVERLAY.
4124 This is a copy of OVERLAY's plist; modifying its conses has no effect on
4125 OVERLAY. */)
4126 (overlay)
4127 Lisp_Object overlay;
4129 CHECK_OVERLAY (overlay);
4131 return Fcopy_sequence (XOVERLAY (overlay)->plist);
4135 DEFUN ("overlays-at", Foverlays_at, Soverlays_at, 1, 1, 0,
4136 doc: /* Return a list of the overlays that contain the character at POS. */)
4137 (pos)
4138 Lisp_Object pos;
4140 int noverlays;
4141 Lisp_Object *overlay_vec;
4142 int len;
4143 Lisp_Object result;
4145 CHECK_NUMBER_COERCE_MARKER (pos);
4147 len = 10;
4148 /* We can't use alloca here because overlays_at can call xrealloc. */
4149 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
4151 /* Put all the overlays we want in a vector in overlay_vec.
4152 Store the length in len. */
4153 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
4154 (EMACS_INT *) 0, (EMACS_INT *) 0, 0);
4156 /* Make a list of them all. */
4157 result = Flist (noverlays, overlay_vec);
4159 xfree (overlay_vec);
4160 return result;
4163 DEFUN ("overlays-in", Foverlays_in, Soverlays_in, 2, 2, 0,
4164 doc: /* Return a list of the overlays that overlap the region BEG ... END.
4165 Overlap means that at least one character is contained within the overlay
4166 and also contained within the specified region.
4167 Empty overlays are included in the result if they are located at BEG,
4168 between BEG and END, or at END provided END denotes the position at the
4169 end of the buffer. */)
4170 (beg, end)
4171 Lisp_Object beg, end;
4173 int noverlays;
4174 Lisp_Object *overlay_vec;
4175 int len;
4176 Lisp_Object result;
4178 CHECK_NUMBER_COERCE_MARKER (beg);
4179 CHECK_NUMBER_COERCE_MARKER (end);
4181 len = 10;
4182 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
4184 /* Put all the overlays we want in a vector in overlay_vec.
4185 Store the length in len. */
4186 noverlays = overlays_in (XINT (beg), XINT (end), 1, &overlay_vec, &len,
4187 (int *) 0, (int *) 0);
4189 /* Make a list of them all. */
4190 result = Flist (noverlays, overlay_vec);
4192 xfree (overlay_vec);
4193 return result;
4196 DEFUN ("next-overlay-change", Fnext_overlay_change, Snext_overlay_change,
4197 1, 1, 0,
4198 doc: /* Return the next position after POS where an overlay starts or ends.
4199 If there are no overlay boundaries from POS to (point-max),
4200 the value is (point-max). */)
4201 (pos)
4202 Lisp_Object pos;
4204 int noverlays;
4205 EMACS_INT endpos;
4206 Lisp_Object *overlay_vec;
4207 int len;
4208 int i;
4210 CHECK_NUMBER_COERCE_MARKER (pos);
4212 len = 10;
4213 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
4215 /* Put all the overlays we want in a vector in overlay_vec.
4216 Store the length in len.
4217 endpos gets the position where the next overlay starts. */
4218 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
4219 &endpos, (EMACS_INT *) 0, 1);
4221 /* If any of these overlays ends before endpos,
4222 use its ending point instead. */
4223 for (i = 0; i < noverlays; i++)
4225 Lisp_Object oend;
4226 EMACS_INT oendpos;
4228 oend = OVERLAY_END (overlay_vec[i]);
4229 oendpos = OVERLAY_POSITION (oend);
4230 if (oendpos < endpos)
4231 endpos = oendpos;
4234 xfree (overlay_vec);
4235 return make_number (endpos);
4238 DEFUN ("previous-overlay-change", Fprevious_overlay_change,
4239 Sprevious_overlay_change, 1, 1, 0,
4240 doc: /* Return the previous position before POS where an overlay starts or ends.
4241 If there are no overlay boundaries from (point-min) to POS,
4242 the value is (point-min). */)
4243 (pos)
4244 Lisp_Object pos;
4246 int noverlays;
4247 EMACS_INT prevpos;
4248 Lisp_Object *overlay_vec;
4249 int len;
4251 CHECK_NUMBER_COERCE_MARKER (pos);
4253 /* At beginning of buffer, we know the answer;
4254 avoid bug subtracting 1 below. */
4255 if (XINT (pos) == BEGV)
4256 return pos;
4258 len = 10;
4259 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
4261 /* Put all the overlays we want in a vector in overlay_vec.
4262 Store the length in len.
4263 prevpos gets the position of the previous change. */
4264 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
4265 (EMACS_INT *) 0, &prevpos, 1);
4267 xfree (overlay_vec);
4268 return make_number (prevpos);
4271 /* These functions are for debugging overlays. */
4273 DEFUN ("overlay-lists", Foverlay_lists, Soverlay_lists, 0, 0, 0,
4274 doc: /* Return a pair of lists giving all the overlays of the current buffer.
4275 The car has all the overlays before the overlay center;
4276 the cdr has all the overlays after the overlay center.
4277 Recentering overlays moves overlays between these lists.
4278 The lists you get are copies, so that changing them has no effect.
4279 However, the overlays you get are the real objects that the buffer uses. */)
4282 struct Lisp_Overlay *ol;
4283 Lisp_Object before = Qnil, after = Qnil, tmp;
4284 for (ol = current_buffer->overlays_before; ol; ol = ol->next)
4286 XSETMISC (tmp, ol);
4287 before = Fcons (tmp, before);
4289 for (ol = current_buffer->overlays_after; ol; ol = ol->next)
4291 XSETMISC (tmp, ol);
4292 after = Fcons (tmp, after);
4294 return Fcons (Fnreverse (before), Fnreverse (after));
4297 DEFUN ("overlay-recenter", Foverlay_recenter, Soverlay_recenter, 1, 1, 0,
4298 doc: /* Recenter the overlays of the current buffer around position POS.
4299 That makes overlay lookup faster for positions near POS (but perhaps slower
4300 for positions far away from POS). */)
4301 (pos)
4302 Lisp_Object pos;
4304 CHECK_NUMBER_COERCE_MARKER (pos);
4306 recenter_overlay_lists (current_buffer, XINT (pos));
4307 return Qnil;
4310 DEFUN ("overlay-get", Foverlay_get, Soverlay_get, 2, 2, 0,
4311 doc: /* Get the property of overlay OVERLAY with property name PROP. */)
4312 (overlay, prop)
4313 Lisp_Object overlay, prop;
4315 CHECK_OVERLAY (overlay);
4316 return lookup_char_property (XOVERLAY (overlay)->plist, prop, 0);
4319 DEFUN ("overlay-put", Foverlay_put, Soverlay_put, 3, 3, 0,
4320 doc: /* Set one property of overlay OVERLAY: give property PROP value VALUE. */)
4321 (overlay, prop, value)
4322 Lisp_Object overlay, prop, value;
4324 Lisp_Object tail, buffer;
4325 int changed;
4327 CHECK_OVERLAY (overlay);
4329 buffer = Fmarker_buffer (OVERLAY_START (overlay));
4331 for (tail = XOVERLAY (overlay)->plist;
4332 CONSP (tail) && CONSP (XCDR (tail));
4333 tail = XCDR (XCDR (tail)))
4334 if (EQ (XCAR (tail), prop))
4336 changed = !EQ (XCAR (XCDR (tail)), value);
4337 XSETCAR (XCDR (tail), value);
4338 goto found;
4340 /* It wasn't in the list, so add it to the front. */
4341 changed = !NILP (value);
4342 XOVERLAY (overlay)->plist
4343 = Fcons (prop, Fcons (value, XOVERLAY (overlay)->plist));
4344 found:
4345 if (! NILP (buffer))
4347 if (changed)
4348 modify_overlay (XBUFFER (buffer),
4349 marker_position (OVERLAY_START (overlay)),
4350 marker_position (OVERLAY_END (overlay)));
4351 if (EQ (prop, Qevaporate) && ! NILP (value)
4352 && (OVERLAY_POSITION (OVERLAY_START (overlay))
4353 == OVERLAY_POSITION (OVERLAY_END (overlay))))
4354 Fdelete_overlay (overlay);
4357 return value;
4360 /* Subroutine of report_overlay_modification. */
4362 /* Lisp vector holding overlay hook functions to call.
4363 Vector elements come in pairs.
4364 Each even-index element is a list of hook functions.
4365 The following odd-index element is the overlay they came from.
4367 Before the buffer change, we fill in this vector
4368 as we call overlay hook functions.
4369 After the buffer change, we get the functions to call from this vector.
4370 This way we always call the same functions before and after the change. */
4371 static Lisp_Object last_overlay_modification_hooks;
4373 /* Number of elements actually used in last_overlay_modification_hooks. */
4374 static int last_overlay_modification_hooks_used;
4376 /* Add one functionlist/overlay pair
4377 to the end of last_overlay_modification_hooks. */
4379 static void
4380 add_overlay_mod_hooklist (functionlist, overlay)
4381 Lisp_Object functionlist, overlay;
4383 int oldsize = XVECTOR (last_overlay_modification_hooks)->size;
4385 if (last_overlay_modification_hooks_used == oldsize)
4386 last_overlay_modification_hooks = larger_vector
4387 (last_overlay_modification_hooks, oldsize * 2, Qnil);
4388 ASET (last_overlay_modification_hooks, last_overlay_modification_hooks_used,
4389 functionlist); last_overlay_modification_hooks_used++;
4390 ASET (last_overlay_modification_hooks, last_overlay_modification_hooks_used,
4391 overlay); last_overlay_modification_hooks_used++;
4394 /* Run the modification-hooks of overlays that include
4395 any part of the text in START to END.
4396 If this change is an insertion, also
4397 run the insert-before-hooks of overlay starting at END,
4398 and the insert-after-hooks of overlay ending at START.
4400 This is called both before and after the modification.
4401 AFTER is nonzero when we call after the modification.
4403 ARG1, ARG2, ARG3 are arguments to pass to the hook functions.
4404 When AFTER is nonzero, they are the start position,
4405 the position after the inserted new text,
4406 and the length of deleted or replaced old text. */
4408 void
4409 report_overlay_modification (start, end, after, arg1, arg2, arg3)
4410 Lisp_Object start, end;
4411 int after;
4412 Lisp_Object arg1, arg2, arg3;
4414 Lisp_Object prop, overlay;
4415 struct Lisp_Overlay *tail;
4416 /* 1 if this change is an insertion. */
4417 int insertion = (after ? XFASTINT (arg3) == 0 : EQ (start, end));
4418 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4420 overlay = Qnil;
4421 tail = NULL;
4423 /* We used to run the functions as soon as we found them and only register
4424 them in last_overlay_modification_hooks for the purpose of the `after'
4425 case. But running elisp code as we traverse the list of overlays is
4426 painful because the list can be modified by the elisp code so we had to
4427 copy at several places. We now simply do a read-only traversal that
4428 only collects the functions to run and we run them afterwards. It's
4429 simpler, especially since all the code was already there. -stef */
4431 if (!after)
4433 /* We are being called before a change.
4434 Scan the overlays to find the functions to call. */
4435 last_overlay_modification_hooks_used = 0;
4436 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
4438 int startpos, endpos;
4439 Lisp_Object ostart, oend;
4441 XSETMISC (overlay, tail);
4443 ostart = OVERLAY_START (overlay);
4444 oend = OVERLAY_END (overlay);
4445 endpos = OVERLAY_POSITION (oend);
4446 if (XFASTINT (start) > endpos)
4447 break;
4448 startpos = OVERLAY_POSITION (ostart);
4449 if (insertion && (XFASTINT (start) == startpos
4450 || XFASTINT (end) == startpos))
4452 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
4453 if (!NILP (prop))
4454 add_overlay_mod_hooklist (prop, overlay);
4456 if (insertion && (XFASTINT (start) == endpos
4457 || XFASTINT (end) == endpos))
4459 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
4460 if (!NILP (prop))
4461 add_overlay_mod_hooklist (prop, overlay);
4463 /* Test for intersecting intervals. This does the right thing
4464 for both insertion and deletion. */
4465 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
4467 prop = Foverlay_get (overlay, Qmodification_hooks);
4468 if (!NILP (prop))
4469 add_overlay_mod_hooklist (prop, overlay);
4473 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
4475 int startpos, endpos;
4476 Lisp_Object ostart, oend;
4478 XSETMISC (overlay, tail);
4480 ostart = OVERLAY_START (overlay);
4481 oend = OVERLAY_END (overlay);
4482 startpos = OVERLAY_POSITION (ostart);
4483 endpos = OVERLAY_POSITION (oend);
4484 if (XFASTINT (end) < startpos)
4485 break;
4486 if (insertion && (XFASTINT (start) == startpos
4487 || XFASTINT (end) == startpos))
4489 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
4490 if (!NILP (prop))
4491 add_overlay_mod_hooklist (prop, overlay);
4493 if (insertion && (XFASTINT (start) == endpos
4494 || XFASTINT (end) == endpos))
4496 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
4497 if (!NILP (prop))
4498 add_overlay_mod_hooklist (prop, overlay);
4500 /* Test for intersecting intervals. This does the right thing
4501 for both insertion and deletion. */
4502 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
4504 prop = Foverlay_get (overlay, Qmodification_hooks);
4505 if (!NILP (prop))
4506 add_overlay_mod_hooklist (prop, overlay);
4511 GCPRO4 (overlay, arg1, arg2, arg3);
4513 /* Call the functions recorded in last_overlay_modification_hooks.
4514 First copy the vector contents, in case some of these hooks
4515 do subsequent modification of the buffer. */
4516 int size = last_overlay_modification_hooks_used;
4517 Lisp_Object *copy = (Lisp_Object *) alloca (size * sizeof (Lisp_Object));
4518 int i;
4520 bcopy (XVECTOR (last_overlay_modification_hooks)->contents,
4521 copy, size * sizeof (Lisp_Object));
4522 gcpro1.var = copy;
4523 gcpro1.nvars = size;
4525 for (i = 0; i < size;)
4527 Lisp_Object prop, overlay;
4528 prop = copy[i++];
4529 overlay = copy[i++];
4530 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
4533 UNGCPRO;
4536 static void
4537 call_overlay_mod_hooks (list, overlay, after, arg1, arg2, arg3)
4538 Lisp_Object list, overlay;
4539 int after;
4540 Lisp_Object arg1, arg2, arg3;
4542 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4544 GCPRO4 (list, arg1, arg2, arg3);
4546 while (CONSP (list))
4548 if (NILP (arg3))
4549 call4 (XCAR (list), overlay, after ? Qt : Qnil, arg1, arg2);
4550 else
4551 call5 (XCAR (list), overlay, after ? Qt : Qnil, arg1, arg2, arg3);
4552 list = XCDR (list);
4554 UNGCPRO;
4557 /* Delete any zero-sized overlays at position POS, if the `evaporate'
4558 property is set. */
4559 void
4560 evaporate_overlays (pos)
4561 EMACS_INT pos;
4563 Lisp_Object overlay, hit_list;
4564 struct Lisp_Overlay *tail;
4566 hit_list = Qnil;
4567 if (pos <= current_buffer->overlay_center)
4568 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
4570 int endpos;
4571 XSETMISC (overlay, tail);
4572 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
4573 if (endpos < pos)
4574 break;
4575 if (endpos == pos && OVERLAY_POSITION (OVERLAY_START (overlay)) == pos
4576 && ! NILP (Foverlay_get (overlay, Qevaporate)))
4577 hit_list = Fcons (overlay, hit_list);
4579 else
4580 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
4582 int startpos;
4583 XSETMISC (overlay, tail);
4584 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
4585 if (startpos > pos)
4586 break;
4587 if (startpos == pos && OVERLAY_POSITION (OVERLAY_END (overlay)) == pos
4588 && ! NILP (Foverlay_get (overlay, Qevaporate)))
4589 hit_list = Fcons (overlay, hit_list);
4591 for (; CONSP (hit_list); hit_list = XCDR (hit_list))
4592 Fdelete_overlay (XCAR (hit_list));
4595 /* Somebody has tried to store a value with an unacceptable type
4596 in the slot with offset OFFSET. */
4598 void
4599 buffer_slot_type_mismatch (newval, type)
4600 Lisp_Object newval;
4601 int type;
4603 Lisp_Object predicate;
4605 switch (type)
4607 case_Lisp_Int: predicate = Qintegerp; break;
4608 case Lisp_String: predicate = Qstringp; break;
4609 case Lisp_Symbol: predicate = Qsymbolp; break;
4610 default: abort ();
4613 wrong_type_argument (predicate, newval);
4617 /***********************************************************************
4618 Allocation with mmap
4619 ***********************************************************************/
4621 #ifdef USE_MMAP_FOR_BUFFERS
4623 #include <sys/types.h>
4624 #include <sys/mman.h>
4626 #ifndef MAP_ANON
4627 #ifdef MAP_ANONYMOUS
4628 #define MAP_ANON MAP_ANONYMOUS
4629 #else
4630 #define MAP_ANON 0
4631 #endif
4632 #endif
4634 #ifndef MAP_FAILED
4635 #define MAP_FAILED ((void *) -1)
4636 #endif
4638 #include <stdio.h>
4639 #include <errno.h>
4641 #if MAP_ANON == 0
4642 #include <fcntl.h>
4643 #endif
4645 #include "coding.h"
4648 /* Memory is allocated in regions which are mapped using mmap(2).
4649 The current implementation lets the system select mapped
4650 addresses; we're not using MAP_FIXED in general, except when
4651 trying to enlarge regions.
4653 Each mapped region starts with a mmap_region structure, the user
4654 area starts after that structure, aligned to MEM_ALIGN.
4656 +-----------------------+
4657 | struct mmap_info + |
4658 | padding |
4659 +-----------------------+
4660 | user data |
4663 +-----------------------+ */
4665 struct mmap_region
4667 /* User-specified size. */
4668 size_t nbytes_specified;
4670 /* Number of bytes mapped */
4671 size_t nbytes_mapped;
4673 /* Pointer to the location holding the address of the memory
4674 allocated with the mmap'd block. The variable actually points
4675 after this structure. */
4676 POINTER_TYPE **var;
4678 /* Next and previous in list of all mmap'd regions. */
4679 struct mmap_region *next, *prev;
4682 /* Doubly-linked list of mmap'd regions. */
4684 static struct mmap_region *mmap_regions;
4686 /* File descriptor for mmap. If we don't have anonymous mapping,
4687 /dev/zero will be opened on it. */
4689 static int mmap_fd;
4691 /* Temporary storage for mmap_set_vars, see there. */
4693 static struct mmap_region *mmap_regions_1;
4694 static int mmap_fd_1;
4696 /* Page size on this system. */
4698 static int mmap_page_size;
4700 /* 1 means mmap has been intialized. */
4702 static int mmap_initialized_p;
4704 /* Value is X rounded up to the next multiple of N. */
4706 #define ROUND(X, N) (((X) + (N) - 1) / (N) * (N))
4708 /* Size of mmap_region structure plus padding. */
4710 #define MMAP_REGION_STRUCT_SIZE \
4711 ROUND (sizeof (struct mmap_region), MEM_ALIGN)
4713 /* Given a pointer P to the start of the user-visible part of a mapped
4714 region, return a pointer to the start of the region. */
4716 #define MMAP_REGION(P) \
4717 ((struct mmap_region *) ((char *) (P) - MMAP_REGION_STRUCT_SIZE))
4719 /* Given a pointer P to the start of a mapped region, return a pointer
4720 to the start of the user-visible part of the region. */
4722 #define MMAP_USER_AREA(P) \
4723 ((POINTER_TYPE *) ((char *) (P) + MMAP_REGION_STRUCT_SIZE))
4725 #define MEM_ALIGN sizeof (double)
4727 /* Predicate returning true if part of the address range [START .. END]
4728 is currently mapped. Used to prevent overwriting an existing
4729 memory mapping.
4731 Default is to conservativly assume the address range is occupied by
4732 something else. This can be overridden by system configuration
4733 files if system-specific means to determine this exists. */
4735 #ifndef MMAP_ALLOCATED_P
4736 #define MMAP_ALLOCATED_P(start, end) 1
4737 #endif
4739 /* Function prototypes. */
4741 static int mmap_free_1 P_ ((struct mmap_region *));
4742 static int mmap_enlarge P_ ((struct mmap_region *, int));
4743 static struct mmap_region *mmap_find P_ ((POINTER_TYPE *, POINTER_TYPE *));
4744 static POINTER_TYPE *mmap_alloc P_ ((POINTER_TYPE **, size_t));
4745 static POINTER_TYPE *mmap_realloc P_ ((POINTER_TYPE **, size_t));
4746 static void mmap_free P_ ((POINTER_TYPE **ptr));
4747 static void mmap_init P_ ((void));
4750 /* Return a region overlapping address range START...END, or null if
4751 none. END is not including, i.e. the last byte in the range
4752 is at END - 1. */
4754 static struct mmap_region *
4755 mmap_find (start, end)
4756 POINTER_TYPE *start, *end;
4758 struct mmap_region *r;
4759 char *s = (char *) start, *e = (char *) end;
4761 for (r = mmap_regions; r; r = r->next)
4763 char *rstart = (char *) r;
4764 char *rend = rstart + r->nbytes_mapped;
4766 if (/* First byte of range, i.e. START, in this region? */
4767 (s >= rstart && s < rend)
4768 /* Last byte of range, i.e. END - 1, in this region? */
4769 || (e > rstart && e <= rend)
4770 /* First byte of this region in the range? */
4771 || (rstart >= s && rstart < e)
4772 /* Last byte of this region in the range? */
4773 || (rend > s && rend <= e))
4774 break;
4777 return r;
4781 /* Unmap a region. P is a pointer to the start of the user-araa of
4782 the region. Value is non-zero if successful. */
4784 static int
4785 mmap_free_1 (r)
4786 struct mmap_region *r;
4788 if (r->next)
4789 r->next->prev = r->prev;
4790 if (r->prev)
4791 r->prev->next = r->next;
4792 else
4793 mmap_regions = r->next;
4795 if (munmap ((POINTER_TYPE *) r, r->nbytes_mapped) == -1)
4797 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4798 return 0;
4801 return 1;
4805 /* Enlarge region R by NPAGES pages. NPAGES < 0 means shrink R.
4806 Value is non-zero if successful. */
4808 static int
4809 mmap_enlarge (r, npages)
4810 struct mmap_region *r;
4811 int npages;
4813 char *region_end = (char *) r + r->nbytes_mapped;
4814 size_t nbytes;
4815 int success = 0;
4817 if (npages < 0)
4819 /* Unmap pages at the end of the region. */
4820 nbytes = - npages * mmap_page_size;
4821 if (munmap (region_end - nbytes, nbytes) == -1)
4822 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4823 else
4825 r->nbytes_mapped -= nbytes;
4826 success = 1;
4829 else if (npages > 0)
4831 nbytes = npages * mmap_page_size;
4833 /* Try to map additional pages at the end of the region. We
4834 cannot do this if the address range is already occupied by
4835 something else because mmap deletes any previous mapping.
4836 I'm not sure this is worth doing, let's see. */
4837 if (!MMAP_ALLOCATED_P (region_end, region_end + nbytes))
4839 POINTER_TYPE *p;
4841 p = mmap (region_end, nbytes, PROT_READ | PROT_WRITE,
4842 MAP_ANON | MAP_PRIVATE | MAP_FIXED, mmap_fd, 0);
4843 if (p == MAP_FAILED)
4844 ; /* fprintf (stderr, "mmap: %s\n", emacs_strerror (errno)); */
4845 else if (p != (POINTER_TYPE *) region_end)
4847 /* Kernels are free to choose a different address. In
4848 that case, unmap what we've mapped above; we have
4849 no use for it. */
4850 if (munmap (p, nbytes) == -1)
4851 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4853 else
4855 r->nbytes_mapped += nbytes;
4856 success = 1;
4861 return success;
4865 /* Set or reset variables holding references to mapped regions. If
4866 RESTORE_P is zero, set all variables to null. If RESTORE_P is
4867 non-zero, set all variables to the start of the user-areas
4868 of mapped regions.
4870 This function is called from Fdump_emacs to ensure that the dumped
4871 Emacs doesn't contain references to memory that won't be mapped
4872 when Emacs starts. */
4874 void
4875 mmap_set_vars (restore_p)
4876 int restore_p;
4878 struct mmap_region *r;
4880 if (restore_p)
4882 mmap_regions = mmap_regions_1;
4883 mmap_fd = mmap_fd_1;
4884 for (r = mmap_regions; r; r = r->next)
4885 *r->var = MMAP_USER_AREA (r);
4887 else
4889 for (r = mmap_regions; r; r = r->next)
4890 *r->var = NULL;
4891 mmap_regions_1 = mmap_regions;
4892 mmap_regions = NULL;
4893 mmap_fd_1 = mmap_fd;
4894 mmap_fd = -1;
4899 /* Allocate a block of storage large enough to hold NBYTES bytes of
4900 data. A pointer to the data is returned in *VAR. VAR is thus the
4901 address of some variable which will use the data area.
4903 The allocation of 0 bytes is valid.
4905 If we can't allocate the necessary memory, set *VAR to null, and
4906 return null. */
4908 static POINTER_TYPE *
4909 mmap_alloc (var, nbytes)
4910 POINTER_TYPE **var;
4911 size_t nbytes;
4913 void *p;
4914 size_t map;
4916 mmap_init ();
4918 map = ROUND (nbytes + MMAP_REGION_STRUCT_SIZE, mmap_page_size);
4919 p = mmap (NULL, map, PROT_READ | PROT_WRITE, MAP_ANON | MAP_PRIVATE,
4920 mmap_fd, 0);
4922 if (p == MAP_FAILED)
4924 if (errno != ENOMEM)
4925 fprintf (stderr, "mmap: %s\n", emacs_strerror (errno));
4926 p = NULL;
4928 else
4930 struct mmap_region *r = (struct mmap_region *) p;
4932 r->nbytes_specified = nbytes;
4933 r->nbytes_mapped = map;
4934 r->var = var;
4935 r->prev = NULL;
4936 r->next = mmap_regions;
4937 if (r->next)
4938 r->next->prev = r;
4939 mmap_regions = r;
4941 p = MMAP_USER_AREA (p);
4944 return *var = p;
4948 /* Given a pointer at address VAR to data allocated with mmap_alloc,
4949 resize it to size NBYTES. Change *VAR to reflect the new block,
4950 and return this value. If more memory cannot be allocated, then
4951 leave *VAR unchanged, and return null. */
4953 static POINTER_TYPE *
4954 mmap_realloc (var, nbytes)
4955 POINTER_TYPE **var;
4956 size_t nbytes;
4958 POINTER_TYPE *result;
4960 mmap_init ();
4962 if (*var == NULL)
4963 result = mmap_alloc (var, nbytes);
4964 else if (nbytes == 0)
4966 mmap_free (var);
4967 result = mmap_alloc (var, nbytes);
4969 else
4971 struct mmap_region *r = MMAP_REGION (*var);
4972 size_t room = r->nbytes_mapped - MMAP_REGION_STRUCT_SIZE;
4974 if (room < nbytes)
4976 /* Must enlarge. */
4977 POINTER_TYPE *old_ptr = *var;
4979 /* Try to map additional pages at the end of the region.
4980 If that fails, allocate a new region, copy data
4981 from the old region, then free it. */
4982 if (mmap_enlarge (r, (ROUND (nbytes - room, mmap_page_size)
4983 / mmap_page_size)))
4985 r->nbytes_specified = nbytes;
4986 *var = result = old_ptr;
4988 else if (mmap_alloc (var, nbytes))
4990 bcopy (old_ptr, *var, r->nbytes_specified);
4991 mmap_free_1 (MMAP_REGION (old_ptr));
4992 result = *var;
4993 r = MMAP_REGION (result);
4994 r->nbytes_specified = nbytes;
4996 else
4998 *var = old_ptr;
4999 result = NULL;
5002 else if (room - nbytes >= mmap_page_size)
5004 /* Shrinking by at least a page. Let's give some
5005 memory back to the system.
5007 The extra parens are to make the division happens first,
5008 on positive values, so we know it will round towards
5009 zero. */
5010 mmap_enlarge (r, - ((room - nbytes) / mmap_page_size));
5011 result = *var;
5012 r->nbytes_specified = nbytes;
5014 else
5016 /* Leave it alone. */
5017 result = *var;
5018 r->nbytes_specified = nbytes;
5022 return result;
5026 /* Free a block of relocatable storage whose data is pointed to by
5027 PTR. Store 0 in *PTR to show there's no block allocated. */
5029 static void
5030 mmap_free (var)
5031 POINTER_TYPE **var;
5033 mmap_init ();
5035 if (*var)
5037 mmap_free_1 (MMAP_REGION (*var));
5038 *var = NULL;
5043 /* Perform necessary intializations for the use of mmap. */
5045 static void
5046 mmap_init ()
5048 #if MAP_ANON == 0
5049 /* The value of mmap_fd is initially 0 in temacs, and -1
5050 in a dumped Emacs. */
5051 if (mmap_fd <= 0)
5053 /* No anonymous mmap -- we need the file descriptor. */
5054 mmap_fd = open ("/dev/zero", O_RDONLY);
5055 if (mmap_fd == -1)
5056 fatal ("Cannot open /dev/zero: %s", emacs_strerror (errno));
5058 #endif /* MAP_ANON == 0 */
5060 if (mmap_initialized_p)
5061 return;
5062 mmap_initialized_p = 1;
5064 #if MAP_ANON != 0
5065 mmap_fd = -1;
5066 #endif
5068 mmap_page_size = getpagesize ();
5071 #endif /* USE_MMAP_FOR_BUFFERS */
5075 /***********************************************************************
5076 Buffer-text Allocation
5077 ***********************************************************************/
5079 #ifdef REL_ALLOC
5080 extern POINTER_TYPE *r_alloc P_ ((POINTER_TYPE **, size_t));
5081 extern POINTER_TYPE *r_re_alloc P_ ((POINTER_TYPE **, size_t));
5082 extern void r_alloc_free P_ ((POINTER_TYPE **ptr));
5083 #endif /* REL_ALLOC */
5086 /* Allocate NBYTES bytes for buffer B's text buffer. */
5088 static void
5089 alloc_buffer_text (b, nbytes)
5090 struct buffer *b;
5091 size_t nbytes;
5093 POINTER_TYPE *p;
5095 BLOCK_INPUT;
5096 #if defined USE_MMAP_FOR_BUFFERS
5097 p = mmap_alloc ((POINTER_TYPE **) &b->text->beg, nbytes);
5098 #elif defined REL_ALLOC
5099 p = r_alloc ((POINTER_TYPE **) &b->text->beg, nbytes);
5100 #else
5101 p = xmalloc (nbytes);
5102 #endif
5104 if (p == NULL)
5106 UNBLOCK_INPUT;
5107 memory_full ();
5110 b->text->beg = (unsigned char *) p;
5111 UNBLOCK_INPUT;
5114 /* Enlarge buffer B's text buffer by DELTA bytes. DELTA < 0 means
5115 shrink it. */
5117 void
5118 enlarge_buffer_text (struct buffer *b, EMACS_INT delta)
5120 POINTER_TYPE *p;
5121 size_t nbytes = (BUF_Z_BYTE (b) - BUF_BEG_BYTE (b) + BUF_GAP_SIZE (b) + 1
5122 + delta);
5123 BLOCK_INPUT;
5124 #if defined USE_MMAP_FOR_BUFFERS
5125 p = mmap_realloc ((POINTER_TYPE **) &b->text->beg, nbytes);
5126 #elif defined REL_ALLOC
5127 p = r_re_alloc ((POINTER_TYPE **) &b->text->beg, nbytes);
5128 #else
5129 p = xrealloc (b->text->beg, nbytes);
5130 #endif
5132 if (p == NULL)
5134 UNBLOCK_INPUT;
5135 memory_full ();
5138 BUF_BEG_ADDR (b) = (unsigned char *) p;
5139 UNBLOCK_INPUT;
5143 /* Free buffer B's text buffer. */
5145 static void
5146 free_buffer_text (b)
5147 struct buffer *b;
5149 BLOCK_INPUT;
5151 #if defined USE_MMAP_FOR_BUFFERS
5152 mmap_free ((POINTER_TYPE **) &b->text->beg);
5153 #elif defined REL_ALLOC
5154 r_alloc_free ((POINTER_TYPE **) &b->text->beg);
5155 #else
5156 xfree (b->text->beg);
5157 #endif
5159 BUF_BEG_ADDR (b) = NULL;
5160 UNBLOCK_INPUT;
5165 /***********************************************************************
5166 Initialization
5167 ***********************************************************************/
5169 void
5170 init_buffer_once ()
5172 int idx;
5174 bzero (buffer_permanent_local_flags, sizeof buffer_permanent_local_flags);
5176 /* Make sure all markable slots in buffer_defaults
5177 are initialized reasonably, so mark_buffer won't choke. */
5178 reset_buffer (&buffer_defaults);
5179 reset_buffer_local_variables (&buffer_defaults, 1);
5180 reset_buffer (&buffer_local_symbols);
5181 reset_buffer_local_variables (&buffer_local_symbols, 1);
5182 /* Prevent GC from getting confused. */
5183 buffer_defaults.text = &buffer_defaults.own_text;
5184 buffer_local_symbols.text = &buffer_local_symbols.own_text;
5185 BUF_INTERVALS (&buffer_defaults) = 0;
5186 BUF_INTERVALS (&buffer_local_symbols) = 0;
5187 XSETPVECTYPE (&buffer_defaults, PVEC_BUFFER);
5188 XSETBUFFER (Vbuffer_defaults, &buffer_defaults);
5189 XSETPVECTYPE (&buffer_local_symbols, PVEC_BUFFER);
5190 XSETBUFFER (Vbuffer_local_symbols, &buffer_local_symbols);
5192 /* Set up the default values of various buffer slots. */
5193 /* Must do these before making the first buffer! */
5195 /* real setup is done in bindings.el */
5196 BUF_MODE_LINE_FORMAT (&buffer_defaults) = build_string ("%-");
5197 BUF_HEADER_LINE_FORMAT (&buffer_defaults) = Qnil;
5198 BUF_ABBREV_MODE (&buffer_defaults) = Qnil;
5199 BUF_OVERWRITE_MODE (&buffer_defaults) = Qnil;
5200 BUF_CASE_FOLD_SEARCH (&buffer_defaults) = Qt;
5201 BUF_AUTO_FILL_FUNCTION (&buffer_defaults) = Qnil;
5202 BUF_SELECTIVE_DISPLAY (&buffer_defaults) = Qnil;
5203 #ifndef old
5204 BUF_SELECTIVE_DISPLAY_ELLIPSES (&buffer_defaults) = Qt;
5205 #endif
5206 BUF_ABBREV_TABLE (&buffer_defaults) = Qnil;
5207 BUF_DISPLAY_TABLE (&buffer_defaults) = Qnil;
5208 BUF_UNDO_LIST (&buffer_defaults) = Qnil;
5209 BUF_MARK_ACTIVE (&buffer_defaults) = Qnil;
5210 BUF_FILE_FORMAT (&buffer_defaults) = Qnil;
5211 BUF_AUTO_SAVE_FILE_FORMAT (&buffer_defaults) = Qt;
5212 buffer_defaults.overlays_before = NULL;
5213 buffer_defaults.overlays_after = NULL;
5214 buffer_defaults.overlay_center = BEG;
5216 XSETFASTINT (BUF_TAB_WIDTH (&buffer_defaults), 8);
5217 BUF_TRUNCATE_LINES (&buffer_defaults) = Qnil;
5218 BUF_WORD_WRAP (&buffer_defaults) = Qnil;
5219 BUF_CTL_ARROW (&buffer_defaults) = Qt;
5220 BUF_DIRECTION_REVERSED (&buffer_defaults) = Qnil;
5221 BUF_CURSOR_TYPE (&buffer_defaults) = Qt;
5222 BUF_EXTRA_LINE_SPACING (&buffer_defaults) = Qnil;
5223 BUF_CURSOR_IN_NON_SELECTED_WINDOWS (&buffer_defaults) = Qt;
5224 buffer_defaults.owner = Qnil;
5225 buffer_defaults.prev_owner = Qnil;
5227 #ifdef DOS_NT
5228 buffer_defaults.buffer_file_type = Qnil; /* TEXT */
5229 #endif
5230 BUF_ENABLE_MULTIBYTE_CHARACTERS (&buffer_defaults) = Qt;
5231 BUF_BUFFER_FILE_CODING_SYSTEM (&buffer_defaults) = Qnil;
5232 XSETFASTINT (BUF_FILL_COLUMN (&buffer_defaults), 70);
5233 XSETFASTINT (BUF_LEFT_MARGIN (&buffer_defaults), 0);
5234 BUF_CACHE_LONG_LINE_SCANS (&buffer_defaults) = Qnil;
5235 BUF_FILE_TRUENAME (&buffer_defaults) = Qnil;
5236 XSETFASTINT (BUF_DISPLAY_COUNT (&buffer_defaults), 0);
5237 XSETFASTINT (BUF_LEFT_MARGIN_COLS (&buffer_defaults), 0);
5238 XSETFASTINT (BUF_RIGHT_MARGIN_COLS (&buffer_defaults), 0);
5239 BUF_LEFT_FRINGE_WIDTH (&buffer_defaults) = Qnil;
5240 BUF_RIGHT_FRINGE_WIDTH (&buffer_defaults) = Qnil;
5241 BUF_FRINGES_OUTSIDE_MARGINS (&buffer_defaults) = Qnil;
5242 BUF_SCROLL_BAR_WIDTH (&buffer_defaults) = Qnil;
5243 BUF_VERTICAL_SCROLL_BAR_TYPE (&buffer_defaults) = Qt;
5244 BUF_INDICATE_EMPTY_LINES (&buffer_defaults) = Qnil;
5245 BUF_INDICATE_BUFFER_BOUNDARIES (&buffer_defaults) = Qnil;
5246 BUF_FRINGE_INDICATOR_ALIST (&buffer_defaults) = Qnil;
5247 BUF_FRINGE_CURSOR_ALIST (&buffer_defaults) = Qnil;
5248 BUF_SCROLL_UP_AGGRESSIVELY (&buffer_defaults) = Qnil;
5249 BUF_SCROLL_DOWN_AGGRESSIVELY (&buffer_defaults) = Qnil;
5250 BUF_DISPLAY_TIME (&buffer_defaults) = Qnil;
5252 /* Assign the local-flags to the slots that have default values.
5253 The local flag is a bit that is used in the buffer
5254 to say that it has its own local value for the slot.
5255 The local flag bits are in the local_var_flags slot of the buffer. */
5257 /* Nothing can work if this isn't true */
5258 if (sizeof (EMACS_INT) != sizeof (Lisp_Object)) abort ();
5260 /* 0 means not a lisp var, -1 means always local, else mask */
5261 bzero (&buffer_local_flags, sizeof buffer_local_flags);
5262 XSETINT (BUF_FILENAME (&buffer_local_flags), -1);
5263 XSETINT (BUF_DIRECTORY (&buffer_local_flags), -1);
5264 XSETINT (BUF_BACKED_UP (&buffer_local_flags), -1);
5265 XSETINT (BUF_SAVE_LENGTH (&buffer_local_flags), -1);
5266 XSETINT (BUF_AUTO_SAVE_FILE_NAME (&buffer_local_flags), -1);
5267 XSETINT (BUF_READ_ONLY (&buffer_local_flags), -1);
5268 XSETINT (BUF_MAJOR_MODE (&buffer_local_flags), -1);
5269 XSETINT (BUF_MODE_NAME (&buffer_local_flags), -1);
5270 XSETINT (BUF_UNDO_LIST (&buffer_local_flags), -1);
5271 XSETINT (BUF_MARK_ACTIVE (&buffer_local_flags), -1);
5272 XSETINT (BUF_POINT_BEFORE_SCROLL (&buffer_local_flags), -1);
5273 XSETINT (BUF_FILE_TRUENAME (&buffer_local_flags), -1);
5274 XSETINT (BUF_INVISIBILITY_SPEC (&buffer_local_flags), -1);
5275 XSETINT (BUF_FILE_FORMAT (&buffer_local_flags), -1);
5276 XSETINT (BUF_AUTO_SAVE_FILE_FORMAT (&buffer_local_flags), -1);
5277 XSETINT (BUF_DISPLAY_COUNT (&buffer_local_flags), -1);
5278 XSETINT (BUF_DISPLAY_TIME (&buffer_local_flags), -1);
5279 XSETINT (BUF_ENABLE_MULTIBYTE_CHARACTERS (&buffer_local_flags), -1);
5281 idx = 1;
5282 XSETFASTINT (BUF_MODE_LINE_FORMAT (&buffer_local_flags), idx); ++idx;
5283 XSETFASTINT (BUF_ABBREV_MODE (&buffer_local_flags), idx); ++idx;
5284 XSETFASTINT (BUF_OVERWRITE_MODE (&buffer_local_flags), idx); ++idx;
5285 XSETFASTINT (BUF_CASE_FOLD_SEARCH (&buffer_local_flags), idx); ++idx;
5286 XSETFASTINT (BUF_AUTO_FILL_FUNCTION (&buffer_local_flags), idx); ++idx;
5287 XSETFASTINT (BUF_SELECTIVE_DISPLAY (&buffer_local_flags), idx); ++idx;
5288 #ifndef old
5289 XSETFASTINT (BUF_SELECTIVE_DISPLAY_ELLIPSES (&buffer_local_flags), idx); ++idx;
5290 #endif
5291 XSETFASTINT (BUF_TAB_WIDTH (&buffer_local_flags), idx); ++idx;
5292 XSETFASTINT (BUF_TRUNCATE_LINES (&buffer_local_flags), idx); ++idx;
5293 XSETFASTINT (BUF_WORD_WRAP (&buffer_local_flags), idx); ++idx;
5294 XSETFASTINT (BUF_CTL_ARROW (&buffer_local_flags), idx); ++idx;
5295 XSETFASTINT (BUF_FILL_COLUMN (&buffer_local_flags), idx); ++idx;
5296 XSETFASTINT (BUF_LEFT_MARGIN (&buffer_local_flags), idx); ++idx;
5297 XSETFASTINT (BUF_ABBREV_TABLE (&buffer_local_flags), idx); ++idx;
5298 XSETFASTINT (BUF_DISPLAY_TABLE (&buffer_local_flags), idx); ++idx;
5299 #ifdef DOS_NT
5300 XSETFASTINT (buffer_local_flags.buffer_file_type, idx);
5301 /* Make this one a permanent local. */
5302 buffer_permanent_local_flags[idx++] = 1;
5303 #endif
5304 XSETFASTINT (BUF_SYNTAX_TABLE (&buffer_local_flags), idx); ++idx;
5305 XSETFASTINT (BUF_CACHE_LONG_LINE_SCANS (&buffer_local_flags), idx); ++idx;
5306 XSETFASTINT (BUF_CATEGORY_TABLE (&buffer_local_flags), idx); ++idx;
5307 XSETFASTINT (BUF_DIRECTION_REVERSED (&buffer_local_flags), idx); ++idx;
5308 XSETFASTINT (BUF_BUFFER_FILE_CODING_SYSTEM (&buffer_local_flags), idx);
5309 /* Make this one a permanent local. */
5310 buffer_permanent_local_flags[idx++] = 1;
5311 XSETFASTINT (BUF_LEFT_MARGIN_COLS (&buffer_local_flags), idx); ++idx;
5312 XSETFASTINT (BUF_RIGHT_MARGIN_COLS (&buffer_local_flags), idx); ++idx;
5313 XSETFASTINT (BUF_LEFT_FRINGE_WIDTH (&buffer_local_flags), idx); ++idx;
5314 XSETFASTINT (BUF_RIGHT_FRINGE_WIDTH (&buffer_local_flags), idx); ++idx;
5315 XSETFASTINT (BUF_FRINGES_OUTSIDE_MARGINS (&buffer_local_flags), idx); ++idx;
5316 XSETFASTINT (BUF_SCROLL_BAR_WIDTH (&buffer_local_flags), idx); ++idx;
5317 XSETFASTINT (BUF_VERTICAL_SCROLL_BAR_TYPE (&buffer_local_flags), idx); ++idx;
5318 XSETFASTINT (BUF_INDICATE_EMPTY_LINES (&buffer_local_flags), idx); ++idx;
5319 XSETFASTINT (BUF_INDICATE_BUFFER_BOUNDARIES (&buffer_local_flags), idx); ++idx;
5320 XSETFASTINT (BUF_FRINGE_INDICATOR_ALIST (&buffer_local_flags), idx); ++idx;
5321 XSETFASTINT (BUF_FRINGE_CURSOR_ALIST (&buffer_local_flags), idx); ++idx;
5322 XSETFASTINT (BUF_SCROLL_UP_AGGRESSIVELY (&buffer_local_flags), idx); ++idx;
5323 XSETFASTINT (BUF_SCROLL_DOWN_AGGRESSIVELY (&buffer_local_flags), idx); ++idx;
5324 XSETFASTINT (BUF_HEADER_LINE_FORMAT (&buffer_local_flags), idx); ++idx;
5325 XSETFASTINT (BUF_CURSOR_TYPE (&buffer_local_flags), idx); ++idx;
5326 XSETFASTINT (BUF_EXTRA_LINE_SPACING (&buffer_local_flags), idx); ++idx;
5327 XSETFASTINT (BUF_CURSOR_IN_NON_SELECTED_WINDOWS (&buffer_local_flags), idx); ++idx;
5329 /* Need more room? */
5330 if (idx >= MAX_PER_BUFFER_VARS)
5331 abort ();
5332 last_per_buffer_idx = idx;
5334 Vbuffer_alist = Qnil;
5335 current_buffer = 0;
5336 all_buffers = 0;
5338 QSFundamental = make_pure_c_string ("Fundamental");
5340 Qfundamental_mode = intern ("fundamental-mode");
5341 BUF_MAJOR_MODE (&buffer_defaults) = Qfundamental_mode;
5343 Qmode_class = intern_c_string ("mode-class");
5345 Qprotected_field = intern_c_string ("protected-field");
5347 Qpermanent_local = intern_c_string ("permanent-local");
5349 Qkill_buffer_hook = intern_c_string ("kill-buffer-hook");
5350 Fput (Qkill_buffer_hook, Qpermanent_local, Qt);
5352 Qucs_set_table_for_input = intern_c_string ("ucs-set-table-for-input");
5354 /* super-magic invisible buffer */
5355 Vprin1_to_string_buffer = Fget_buffer_create (make_pure_c_string (" prin1"));
5356 Vbuffer_alist = Qnil;
5358 Fset_buffer (Fget_buffer_create (make_pure_c_string ("*scratch*")));
5360 inhibit_modification_hooks = 0;
5363 void
5364 init_buffer ()
5366 char *pwd;
5367 Lisp_Object temp;
5368 int len;
5370 #ifdef USE_MMAP_FOR_BUFFERS
5372 /* When using the ralloc implementation based on mmap(2), buffer
5373 text pointers will have been set to null in the dumped Emacs.
5374 Map new memory. */
5375 struct buffer *b;
5377 for (b = all_buffers; b; b = b->next)
5378 if (b->text->beg == NULL)
5379 enlarge_buffer_text (b, 0);
5381 #endif /* USE_MMAP_FOR_BUFFERS */
5383 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
5384 if (NILP (BUF_ENABLE_MULTIBYTE_CHARACTERS (&buffer_defaults)))
5385 Fset_buffer_multibyte (Qnil);
5387 pwd = get_current_dir_name ();
5389 if (!pwd)
5390 fatal ("`get_current_dir_name' failed: %s\n", strerror (errno));
5392 /* Maybe this should really use some standard subroutine
5393 whose definition is filename syntax dependent. */
5394 len = strlen (pwd);
5395 if (!(IS_DIRECTORY_SEP (pwd[len - 1])))
5397 /* Grow buffer to add directory separator and '\0'. */
5398 pwd = (char *) realloc (pwd, len + 2);
5399 if (!pwd)
5400 fatal ("`get_current_dir_name' failed: %s\n", strerror (errno));
5401 pwd[len] = DIRECTORY_SEP;
5402 pwd[len + 1] = '\0';
5405 BUF_DIRECTORY (current_buffer) = make_unibyte_string (pwd, strlen (pwd));
5406 if (! NILP (BUF_ENABLE_MULTIBYTE_CHARACTERS (&buffer_defaults)))
5407 /* At this moment, we still don't know how to decode the
5408 directory name. So, we keep the bytes in multibyte form so
5409 that ENCODE_FILE correctly gets the original bytes. */
5410 BUF_DIRECTORY (current_buffer)
5411 = string_to_multibyte (BUF_DIRECTORY (current_buffer));
5413 /* Add /: to the front of the name
5414 if it would otherwise be treated as magic. */
5415 temp = Ffind_file_name_handler (BUF_DIRECTORY (current_buffer), Qt);
5416 if (! NILP (temp)
5417 /* If the default dir is just /, TEMP is non-nil
5418 because of the ange-ftp completion handler.
5419 However, it is not necessary to turn / into /:/.
5420 So avoid doing that. */
5421 && strcmp ("/", SDATA (BUF_DIRECTORY (current_buffer))))
5422 BUF_DIRECTORY (current_buffer)
5423 = concat2 (build_string ("/:"), BUF_DIRECTORY (current_buffer));
5425 temp = get_minibuffer (0);
5426 BUF_DIRECTORY (XBUFFER (temp)) = BUF_DIRECTORY (current_buffer);
5428 free (pwd);
5431 /* Similar to defvar_lisp but define a variable whose value is the Lisp
5432 Object stored in the current buffer. address is the address of the slot
5433 in the buffer that is current now. */
5435 /* TYPE is nil for a general Lisp variable.
5436 An integer specifies a type; then only LIsp values
5437 with that type code are allowed (except that nil is allowed too).
5438 LNAME is the LIsp-level variable name.
5439 VNAME is the name of the buffer slot.
5440 DOC is a dummy where you write the doc string as a comment. */
5441 #define DEFVAR_PER_BUFFER(lname, vname, type, doc) \
5442 defvar_per_buffer (lname, vname, type, 0)
5444 static void
5445 defvar_per_buffer (namestring, address, type, doc)
5446 char *namestring;
5447 Lisp_Object *address;
5448 Lisp_Object type;
5449 char *doc;
5451 Lisp_Object sym, val;
5452 int offset;
5454 sym = intern (namestring);
5455 val = allocate_misc ();
5456 offset = (char *)address - (char *)current_buffer;
5458 XMISCTYPE (val) = Lisp_Misc_Buffer_Objfwd;
5459 XBUFFER_OBJFWD (val)->offset = offset;
5460 XBUFFER_OBJFWD (val)->slottype = type;
5461 SET_SYMBOL_VALUE (sym, val);
5462 PER_BUFFER_SYMBOL (offset) = sym;
5464 if (PER_BUFFER_IDX (offset) == 0)
5465 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
5466 slot of buffer_local_flags */
5467 abort ();
5471 /* initialize the buffer routines */
5472 void
5473 syms_of_buffer ()
5475 staticpro (&last_overlay_modification_hooks);
5476 last_overlay_modification_hooks
5477 = Fmake_vector (make_number (10), Qnil);
5479 staticpro (&Vbuffer_defaults);
5480 staticpro (&Vbuffer_local_symbols);
5481 staticpro (&Qfundamental_mode);
5482 staticpro (&Qmode_class);
5483 staticpro (&QSFundamental);
5484 staticpro (&Vbuffer_alist);
5485 staticpro (&Qprotected_field);
5486 staticpro (&Qpermanent_local);
5487 Qpermanent_local_hook = intern_c_string ("permanent-local-hook");
5488 staticpro (&Qpermanent_local_hook);
5489 staticpro (&Qkill_buffer_hook);
5490 Qoverlayp = intern_c_string ("overlayp");
5491 staticpro (&Qoverlayp);
5492 Qevaporate = intern_c_string ("evaporate");
5493 staticpro (&Qevaporate);
5494 Qmodification_hooks = intern_c_string ("modification-hooks");
5495 staticpro (&Qmodification_hooks);
5496 Qinsert_in_front_hooks = intern_c_string ("insert-in-front-hooks");
5497 staticpro (&Qinsert_in_front_hooks);
5498 Qinsert_behind_hooks = intern_c_string ("insert-behind-hooks");
5499 staticpro (&Qinsert_behind_hooks);
5500 Qget_file_buffer = intern_c_string ("get-file-buffer");
5501 staticpro (&Qget_file_buffer);
5502 Qpriority = intern_c_string ("priority");
5503 staticpro (&Qpriority);
5504 Qwindow = intern_c_string ("window");
5505 staticpro (&Qwindow);
5506 Qbefore_string = intern_c_string ("before-string");
5507 staticpro (&Qbefore_string);
5508 Qafter_string = intern_c_string ("after-string");
5509 staticpro (&Qafter_string);
5510 Qfirst_change_hook = intern_c_string ("first-change-hook");
5511 staticpro (&Qfirst_change_hook);
5512 Qbefore_change_functions = intern_c_string ("before-change-functions");
5513 staticpro (&Qbefore_change_functions);
5514 Qafter_change_functions = intern_c_string ("after-change-functions");
5515 staticpro (&Qafter_change_functions);
5516 /* The next one is initialized in init_buffer_once. */
5517 staticpro (&Qucs_set_table_for_input);
5519 Qkill_buffer_query_functions = intern_c_string ("kill-buffer-query-functions");
5520 staticpro (&Qkill_buffer_query_functions);
5522 Fput (Qprotected_field, Qerror_conditions,
5523 pure_cons (Qprotected_field, pure_cons (Qerror, Qnil)));
5524 Fput (Qprotected_field, Qerror_message,
5525 make_pure_c_string ("Attempt to modify a protected field"));
5527 /* All these use DEFVAR_LISP_NOPRO because the slots in
5528 buffer_defaults will all be marked via Vbuffer_defaults. */
5530 DEFVAR_LISP_NOPRO ("default-mode-line-format",
5531 &buffer_defaults.mode_line_format_,
5532 doc: /* Default value of `mode-line-format' for buffers that don't override it.
5533 This is the same as (default-value 'mode-line-format). */);
5535 DEFVAR_LISP_NOPRO ("default-header-line-format",
5536 &buffer_defaults.header_line_format_,
5537 doc: /* Default value of `header-line-format' for buffers that don't override it.
5538 This is the same as (default-value 'header-line-format). */);
5540 DEFVAR_LISP_NOPRO ("default-cursor-type", &buffer_defaults.cursor_type_,
5541 doc: /* Default value of `cursor-type' for buffers that don't override it.
5542 This is the same as (default-value 'cursor-type). */);
5544 DEFVAR_LISP_NOPRO ("default-line-spacing",
5545 &buffer_defaults.extra_line_spacing_,
5546 doc: /* Default value of `line-spacing' for buffers that don't override it.
5547 This is the same as (default-value 'line-spacing). */);
5549 DEFVAR_LISP_NOPRO ("default-cursor-in-non-selected-windows",
5550 &buffer_defaults.cursor_in_non_selected_windows_,
5551 doc: /* Default value of `cursor-in-non-selected-windows'.
5552 This is the same as (default-value 'cursor-in-non-selected-windows). */);
5554 DEFVAR_LISP_NOPRO ("default-abbrev-mode",
5555 &buffer_defaults.abbrev_mode_,
5556 doc: /* Default value of `abbrev-mode' for buffers that do not override it.
5557 This is the same as (default-value 'abbrev-mode). */);
5559 DEFVAR_LISP_NOPRO ("default-ctl-arrow",
5560 &buffer_defaults.ctl_arrow_,
5561 doc: /* Default value of `ctl-arrow' for buffers that do not override it.
5562 This is the same as (default-value 'ctl-arrow). */);
5564 DEFVAR_LISP_NOPRO ("default-direction-reversed",
5565 &buffer_defaults.direction_reversed_,
5566 doc: /* Default value of `direction-reversed' for buffers that do not override it.
5567 This is the same as (default-value 'direction-reversed). */);
5569 DEFVAR_LISP_NOPRO ("default-enable-multibyte-characters",
5570 &buffer_defaults.enable_multibyte_characters_,
5571 doc: /* *Default value of `enable-multibyte-characters' for buffers not overriding it.
5572 This is the same as (default-value 'enable-multibyte-characters). */);
5574 DEFVAR_LISP_NOPRO ("default-buffer-file-coding-system",
5575 &buffer_defaults.buffer_file_coding_system_,
5576 doc: /* Default value of `buffer-file-coding-system' for buffers not overriding it.
5577 This is the same as (default-value 'buffer-file-coding-system). */);
5579 DEFVAR_LISP_NOPRO ("default-truncate-lines",
5580 &buffer_defaults.truncate_lines_,
5581 doc: /* Default value of `truncate-lines' for buffers that do not override it.
5582 This is the same as (default-value 'truncate-lines). */);
5584 DEFVAR_LISP_NOPRO ("default-fill-column",
5585 &buffer_defaults.fill_column_,
5586 doc: /* Default value of `fill-column' for buffers that do not override it.
5587 This is the same as (default-value 'fill-column). */);
5589 DEFVAR_LISP_NOPRO ("default-left-margin",
5590 &buffer_defaults.left_margin_,
5591 doc: /* Default value of `left-margin' for buffers that do not override it.
5592 This is the same as (default-value 'left-margin). */);
5594 DEFVAR_LISP_NOPRO ("default-tab-width",
5595 &buffer_defaults.tab_width_,
5596 doc: /* Default value of `tab-width' for buffers that do not override it.
5597 This is the same as (default-value 'tab-width). */);
5599 DEFVAR_LISP_NOPRO ("default-case-fold-search",
5600 &buffer_defaults.case_fold_search_,
5601 doc: /* Default value of `case-fold-search' for buffers that don't override it.
5602 This is the same as (default-value 'case-fold-search). */);
5604 #ifdef DOS_NT
5605 DEFVAR_LISP_NOPRO ("default-buffer-file-type",
5606 &buffer_defaults.buffer_file_type,
5607 doc: /* Default file type for buffers that do not override it.
5608 This is the same as (default-value 'buffer-file-type).
5609 The file type is nil for text, t for binary. */);
5610 #endif
5612 DEFVAR_LISP_NOPRO ("default-left-margin-width",
5613 &buffer_defaults.left_margin_cols_,
5614 doc: /* Default value of `left-margin-width' for buffers that don't override it.
5615 This is the same as (default-value 'left-margin-width). */);
5617 DEFVAR_LISP_NOPRO ("default-right-margin-width",
5618 &buffer_defaults.right_margin_cols_,
5619 doc: /* Default value of `right-margin-width' for buffers that don't override it.
5620 This is the same as (default-value 'right-margin-width). */);
5622 DEFVAR_LISP_NOPRO ("default-left-fringe-width",
5623 &buffer_defaults.left_fringe_width_,
5624 doc: /* Default value of `left-fringe-width' for buffers that don't override it.
5625 This is the same as (default-value 'left-fringe-width). */);
5627 DEFVAR_LISP_NOPRO ("default-right-fringe-width",
5628 &buffer_defaults.right_fringe_width_,
5629 doc: /* Default value of `right-fringe-width' for buffers that don't override it.
5630 This is the same as (default-value 'right-fringe-width). */);
5632 DEFVAR_LISP_NOPRO ("default-fringes-outside-margins",
5633 &buffer_defaults.fringes_outside_margins_,
5634 doc: /* Default value of `fringes-outside-margins' for buffers that don't override it.
5635 This is the same as (default-value 'fringes-outside-margins). */);
5637 DEFVAR_LISP_NOPRO ("default-scroll-bar-width",
5638 &buffer_defaults.scroll_bar_width_,
5639 doc: /* Default value of `scroll-bar-width' for buffers that don't override it.
5640 This is the same as (default-value 'scroll-bar-width). */);
5642 DEFVAR_LISP_NOPRO ("default-vertical-scroll-bar",
5643 &buffer_defaults.vertical_scroll_bar_type_,
5644 doc: /* Default value of `vertical-scroll-bar' for buffers that don't override it.
5645 This is the same as (default-value 'vertical-scroll-bar). */);
5647 DEFVAR_LISP_NOPRO ("default-indicate-empty-lines",
5648 &buffer_defaults.indicate_empty_lines_,
5649 doc: /* Default value of `indicate-empty-lines' for buffers that don't override it.
5650 This is the same as (default-value 'indicate-empty-lines). */);
5652 DEFVAR_LISP_NOPRO ("default-indicate-buffer-boundaries",
5653 &buffer_defaults.indicate_buffer_boundaries_,
5654 doc: /* Default value of `indicate-buffer-boundaries' for buffers that don't override it.
5655 This is the same as (default-value 'indicate-buffer-boundaries). */);
5657 DEFVAR_LISP_NOPRO ("default-fringe-indicator-alist",
5658 &buffer_defaults.fringe_indicator_alist_,
5659 doc: /* Default value of `fringe-indicator-alist' for buffers that don't override it.
5660 This is the same as (default-value 'fringe-indicator-alist'). */);
5662 DEFVAR_LISP_NOPRO ("default-fringe-cursor-alist",
5663 &buffer_defaults.fringe_cursor_alist_,
5664 doc: /* Default value of `fringe-cursor-alist' for buffers that don't override it.
5665 This is the same as (default-value 'fringe-cursor-alist'). */);
5667 DEFVAR_LISP_NOPRO ("default-scroll-up-aggressively",
5668 &buffer_defaults.scroll_up_aggressively_,
5669 doc: /* Default value of `scroll-up-aggressively'.
5670 This value applies in buffers that don't have their own local values.
5671 This is the same as (default-value 'scroll-up-aggressively). */);
5673 DEFVAR_LISP_NOPRO ("default-scroll-down-aggressively",
5674 &buffer_defaults.scroll_down_aggressively_,
5675 doc: /* Default value of `scroll-down-aggressively'.
5676 This value applies in buffers that don't have their own local values.
5677 This is the same as (default-value 'scroll-down-aggressively). */);
5679 DEFVAR_PER_BUFFER ("header-line-format",
5680 &current_buffer->header_line_format_,
5681 Qnil,
5682 doc: /* Analogous to `mode-line-format', but controls the header line.
5683 The header line appears, optionally, at the top of a window;
5684 the mode line appears at the bottom. */);
5686 DEFVAR_PER_BUFFER ("mode-line-format", &current_buffer->mode_line_format_,
5687 Qnil,
5688 doc: /* Template for displaying mode line for current buffer.
5689 Each buffer has its own value of this variable.
5690 Value may be nil, a string, a symbol or a list or cons cell.
5691 A value of nil means don't display a mode line.
5692 For a symbol, its value is used (but it is ignored if t or nil).
5693 A string appearing directly as the value of a symbol is processed verbatim
5694 in that the %-constructs below are not recognized.
5695 Note that unless the symbol is marked as a `risky-local-variable', all
5696 properties in any strings, as well as all :eval and :propertize forms
5697 in the value of that symbol will be ignored.
5698 For a list of the form `(:eval FORM)', FORM is evaluated and the result
5699 is used as a mode line element. Be careful--FORM should not load any files,
5700 because that can cause an infinite recursion.
5701 For a list of the form `(:propertize ELT PROPS...)', ELT is displayed
5702 with the specified properties PROPS applied.
5703 For a list whose car is a symbol, the symbol's value is taken,
5704 and if that is non-nil, the cadr of the list is processed recursively.
5705 Otherwise, the caddr of the list (if there is one) is processed.
5706 For a list whose car is a string or list, each element is processed
5707 recursively and the results are effectively concatenated.
5708 For a list whose car is an integer, the cdr of the list is processed
5709 and padded (if the number is positive) or truncated (if negative)
5710 to the width specified by that number.
5711 A string is printed verbatim in the mode line except for %-constructs:
5712 (%-constructs are allowed when the string is the entire mode-line-format
5713 or when it is found in a cons-cell or a list)
5714 %b -- print buffer name. %f -- print visited file name.
5715 %F -- print frame name.
5716 %* -- print %, * or hyphen. %+ -- print *, % or hyphen.
5717 %& is like %*, but ignore read-only-ness.
5718 % means buffer is read-only and * means it is modified.
5719 For a modified read-only buffer, %* gives % and %+ gives *.
5720 %s -- print process status. %l -- print the current line number.
5721 %c -- print the current column number (this makes editing slower).
5722 To make the column number update correctly in all cases,
5723 `column-number-mode' must be non-nil.
5724 %i -- print the size of the buffer.
5725 %I -- like %i, but use k, M, G, etc., to abbreviate.
5726 %p -- print percent of buffer above top of window, or Top, Bot or All.
5727 %P -- print percent of buffer above bottom of window, perhaps plus Top,
5728 or print Bottom or All.
5729 %n -- print Narrow if appropriate.
5730 %t -- visited file is text or binary (if OS supports this distinction).
5731 %z -- print mnemonics of keyboard, terminal, and buffer coding systems.
5732 %Z -- like %z, but including the end-of-line format.
5733 %e -- print error message about full memory.
5734 %@ -- print @ or hyphen. @ means that default-directory is on a
5735 remote machine.
5736 %[ -- print one [ for each recursive editing level. %] similar.
5737 %% -- print %. %- -- print infinitely many dashes.
5738 Decimal digits after the % specify field width to which to pad. */);
5740 DEFVAR_LISP_NOPRO ("default-major-mode", &buffer_defaults.major_mode_,
5741 doc: /* *Value of `major-mode' for new buffers. */);
5743 DEFVAR_PER_BUFFER ("major-mode", &current_buffer->major_mode_,
5744 make_number (Lisp_Symbol),
5745 doc: /* Symbol for current buffer's major mode.
5746 The default value (normally `fundamental-mode') affects new buffers.
5747 A value of nil means to use the current buffer's major mode, provided
5748 it is not marked as "special".
5750 When a mode is used by default, `find-file' switches to it before it
5751 reads the contents into the buffer and before it finishes setting up
5752 the buffer. Thus, the mode and its hooks should not expect certain
5753 variables such as `buffer-read-only' and `buffer-file-coding-system'
5754 to be set up. */);
5756 DEFVAR_PER_BUFFER ("mode-name", &current_buffer->mode_name_,
5757 Qnil,
5758 doc: /* Pretty name of current buffer's major mode.
5759 Usually a string, but can use any of the constructs for `mode-line-format',
5760 which see.
5761 Format with `format-mode-line' to produce a string value. */);
5763 DEFVAR_PER_BUFFER ("local-abbrev-table", &current_buffer->abbrev_table_, Qnil,
5764 doc: /* Local (mode-specific) abbrev table of current buffer. */);
5766 DEFVAR_PER_BUFFER ("abbrev-mode", &current_buffer->abbrev_mode_, Qnil,
5767 doc: /* Non-nil turns on automatic expansion of abbrevs as they are inserted. */);
5769 DEFVAR_PER_BUFFER ("case-fold-search", &current_buffer->case_fold_search_,
5770 Qnil,
5771 doc: /* *Non-nil if searches and matches should ignore case. */);
5773 DEFVAR_PER_BUFFER ("fill-column", &current_buffer->fill_column_,
5774 make_number (Lisp_Int),
5775 doc: /* *Column beyond which automatic line-wrapping should happen.
5776 Interactively, you can set the buffer local value using \\[set-fill-column]. */);
5778 DEFVAR_PER_BUFFER ("left-margin", &current_buffer->left_margin_,
5779 make_number (Lisp_Int),
5780 doc: /* *Column for the default `indent-line-function' to indent to.
5781 Linefeed indents to this column in Fundamental mode. */);
5783 DEFVAR_PER_BUFFER ("tab-width", &current_buffer->tab_width_,
5784 make_number (Lisp_Int),
5785 doc: /* *Distance between tab stops (for display of tab characters), in columns. */);
5787 DEFVAR_PER_BUFFER ("ctl-arrow", &current_buffer->ctl_arrow_, Qnil,
5788 doc: /* *Non-nil means display control chars with uparrow.
5789 A value of nil means use backslash and octal digits.
5790 This variable does not apply to characters whose display is specified
5791 in the current display table (if there is one). */);
5793 DEFVAR_PER_BUFFER ("enable-multibyte-characters",
5794 &current_buffer->enable_multibyte_characters_,
5795 Qnil,
5796 doc: /* Non-nil means the buffer contents are regarded as multi-byte characters.
5797 Otherwise they are regarded as unibyte. This affects the display,
5798 file I/O and the behavior of various editing commands.
5800 This variable is buffer-local but you cannot set it directly;
5801 use the function `set-buffer-multibyte' to change a buffer's representation.
5802 Changing its default value with `setq-default' is supported.
5803 See also variable `default-enable-multibyte-characters' and Info node
5804 `(elisp)Text Representations'. */);
5805 XSYMBOL (intern_c_string ("enable-multibyte-characters"))->constant = 1;
5807 DEFVAR_PER_BUFFER ("buffer-file-coding-system",
5808 &current_buffer->buffer_file_coding_system_, Qnil,
5809 doc: /* Coding system to be used for encoding the buffer contents on saving.
5810 This variable applies to saving the buffer, and also to `write-region'
5811 and other functions that use `write-region'.
5812 It does not apply to sending output to subprocesses, however.
5814 If this is nil, the buffer is saved without any code conversion
5815 unless some coding system is specified in `file-coding-system-alist'
5816 for the buffer file.
5818 If the text to be saved cannot be encoded as specified by this variable,
5819 an alternative encoding is selected by `select-safe-coding-system', which see.
5821 The variable `coding-system-for-write', if non-nil, overrides this variable.
5823 This variable is never applied to a way of decoding a file while reading it. */);
5825 DEFVAR_PER_BUFFER ("direction-reversed", &current_buffer->direction_reversed_,
5826 Qnil,
5827 doc: /* *Non-nil means lines in the buffer are displayed right to left. */);
5829 DEFVAR_PER_BUFFER ("truncate-lines", &current_buffer->truncate_lines_, Qnil,
5830 doc: /* *Non-nil means do not display continuation lines.
5831 Instead, give each line of text just one screen line.
5833 Note that this is overridden by the variable
5834 `truncate-partial-width-windows' if that variable is non-nil
5835 and this buffer is not full-frame width. */);
5837 DEFVAR_PER_BUFFER ("word-wrap", &current_buffer->word_wrap_, Qnil,
5838 doc: /* *Non-nil means to use word-wrapping for continuation lines.
5839 When word-wrapping is on, continuation lines are wrapped at the space
5840 or tab character nearest to the right window edge.
5841 If nil, continuation lines are wrapped at the right screen edge.
5843 This variable has no effect if long lines are truncated (see
5844 `truncate-lines' and `truncate-partial-width-windows'). If you use
5845 word-wrapping, you might want to reduce the value of
5846 `truncate-partial-width-windows', since wrapping can make text readable
5847 in narrower windows. */);
5849 #ifdef DOS_NT
5850 DEFVAR_PER_BUFFER ("buffer-file-type", &current_buffer->buffer_file_type,
5851 Qnil,
5852 doc: /* Non-nil if the visited file is a binary file.
5853 This variable is meaningful on MS-DOG and Windows NT.
5854 On those systems, it is automatically local in every buffer.
5855 On other systems, this variable is normally always nil. */);
5856 #endif
5858 DEFVAR_PER_BUFFER ("default-directory", &current_buffer->directory_,
5859 make_number (Lisp_String),
5860 doc: /* Name of default directory of current buffer. Should end with slash.
5861 To interactively change the default directory, use command `cd'. */);
5863 DEFVAR_PER_BUFFER ("auto-fill-function", &current_buffer->auto_fill_function_,
5864 Qnil,
5865 doc: /* Function called (if non-nil) to perform auto-fill.
5866 It is called after self-inserting any character specified in
5867 the `auto-fill-chars' table.
5868 NOTE: This variable is not a hook;
5869 its value may not be a list of functions. */);
5871 DEFVAR_PER_BUFFER ("buffer-file-name", &current_buffer->filename_,
5872 make_number (Lisp_String),
5873 doc: /* Name of file visited in current buffer, or nil if not visiting a file. */);
5875 DEFVAR_PER_BUFFER ("buffer-file-truename", &current_buffer->file_truename_,
5876 make_number (Lisp_String),
5877 doc: /* Abbreviated truename of file visited in current buffer, or nil if none.
5878 The truename of a file is calculated by `file-truename'
5879 and then abbreviated with `abbreviate-file-name'. */);
5881 DEFVAR_PER_BUFFER ("buffer-auto-save-file-name",
5882 &current_buffer->auto_save_file_name_,
5883 make_number (Lisp_String),
5884 doc: /* Name of file for auto-saving current buffer.
5885 If it is nil, that means don't auto-save this buffer. */);
5887 DEFVAR_PER_BUFFER ("buffer-read-only", &current_buffer->read_only_, Qnil,
5888 doc: /* Non-nil if this buffer is read-only. */);
5890 DEFVAR_PER_BUFFER ("buffer-backed-up", &current_buffer->backed_up_, Qnil,
5891 doc: /* Non-nil if this buffer's file has been backed up.
5892 Backing up is done before the first time the file is saved. */);
5894 DEFVAR_PER_BUFFER ("buffer-saved-size", &current_buffer->save_length_,
5895 make_number (Lisp_Int),
5896 doc: /* Length of current buffer when last read in, saved or auto-saved.
5897 0 initially.
5898 -1 means auto-saving turned off until next real save.
5900 If you set this to -2, that means don't turn off auto-saving in this buffer
5901 if its text size shrinks. If you use `buffer-swap-text' on a buffer,
5902 you probably should set this to -2 in that buffer. */);
5904 DEFVAR_PER_BUFFER ("selective-display", &current_buffer->selective_display_,
5905 Qnil,
5906 doc: /* Non-nil enables selective display.
5907 An integer N as value means display only lines
5908 that start with less than N columns of space.
5909 A value of t means that the character ^M makes itself and
5910 all the rest of the line invisible; also, when saving the buffer
5911 in a file, save the ^M as a newline. */);
5913 #ifndef old
5914 DEFVAR_PER_BUFFER ("selective-display-ellipses",
5915 &current_buffer->selective_display_ellipses_,
5916 Qnil,
5917 doc: /* Non-nil means display ... on previous line when a line is invisible. */);
5918 #endif
5920 DEFVAR_PER_BUFFER ("overwrite-mode", &current_buffer->overwrite_mode_, Qnil,
5921 doc: /* Non-nil if self-insertion should replace existing text.
5922 The value should be one of `overwrite-mode-textual',
5923 `overwrite-mode-binary', or nil.
5924 If it is `overwrite-mode-textual', self-insertion still
5925 inserts at the end of a line, and inserts when point is before a tab,
5926 until the tab is filled in.
5927 If `overwrite-mode-binary', self-insertion replaces newlines and tabs too. */);
5929 DEFVAR_PER_BUFFER ("buffer-display-table", &current_buffer->display_table_,
5930 Qnil,
5931 doc: /* Display table that controls display of the contents of current buffer.
5933 If this variable is nil, the value of `standard-display-table' is used.
5934 Each window can have its own, overriding display table, see
5935 `set-window-display-table' and `window-display-table'.
5937 The display table is a char-table created with `make-display-table'.
5938 A char-table is an array indexed by character codes. Normal array
5939 primitives `aref' and `aset' can be used to access elements of a char-table.
5941 Each of the char-table elements control how to display the corresponding
5942 text character: the element at index C in the table says how to display
5943 the character whose code is C. Each element should be a vector of
5944 characters or nil. The value nil means display the character in the
5945 default fashion; otherwise, the characters from the vector are delivered
5946 to the screen instead of the original character.
5948 For example, (aset buffer-display-table ?X [?Y]) tells Emacs
5949 to display a capital Y instead of each X character.
5951 In addition, a char-table has six extra slots to control the display of:
5953 the end of a truncated screen line (extra-slot 0, a single character);
5954 the end of a continued line (extra-slot 1, a single character);
5955 the escape character used to display character codes in octal
5956 (extra-slot 2, a single character);
5957 the character used as an arrow for control characters (extra-slot 3,
5958 a single character);
5959 the decoration indicating the presence of invisible lines (extra-slot 4,
5960 a vector of characters);
5961 the character used to draw the border between side-by-side windows
5962 (extra-slot 5, a single character).
5964 See also the functions `display-table-slot' and `set-display-table-slot'. */);
5966 DEFVAR_PER_BUFFER ("left-margin-width", &current_buffer->left_margin_cols_,
5967 Qnil,
5968 doc: /* *Width of left marginal area for display of a buffer.
5969 A value of nil means no marginal area. */);
5971 DEFVAR_PER_BUFFER ("right-margin-width", &current_buffer->right_margin_cols_,
5972 Qnil,
5973 doc: /* *Width of right marginal area for display of a buffer.
5974 A value of nil means no marginal area. */);
5976 DEFVAR_PER_BUFFER ("left-fringe-width", &current_buffer->left_fringe_width_,
5977 Qnil,
5978 doc: /* *Width of this buffer's left fringe (in pixels).
5979 A value of 0 means no left fringe is shown in this buffer's window.
5980 A value of nil means to use the left fringe width from the window's frame. */);
5982 DEFVAR_PER_BUFFER ("right-fringe-width", &current_buffer->right_fringe_width_,
5983 Qnil,
5984 doc: /* *Width of this buffer's right fringe (in pixels).
5985 A value of 0 means no right fringe is shown in this buffer's window.
5986 A value of nil means to use the right fringe width from the window's frame. */);
5988 DEFVAR_PER_BUFFER ("fringes-outside-margins", &current_buffer->fringes_outside_margins_,
5989 Qnil,
5990 doc: /* *Non-nil means to display fringes outside display margins.
5991 A value of nil means to display fringes between margins and buffer text. */);
5993 DEFVAR_PER_BUFFER ("scroll-bar-width", &current_buffer->scroll_bar_width_,
5994 Qnil,
5995 doc: /* *Width of this buffer's scroll bars in pixels.
5996 A value of nil means to use the scroll bar width from the window's frame. */);
5998 DEFVAR_PER_BUFFER ("vertical-scroll-bar", &current_buffer->vertical_scroll_bar_type_,
5999 Qnil,
6000 doc: /* *Position of this buffer's vertical scroll bar.
6001 The value takes effect whenever you tell a window to display this buffer;
6002 for instance, with `set-window-buffer' or when `display-buffer' displays it.
6004 A value of `left' or `right' means put the vertical scroll bar at that side
6005 of the window; a value of nil means don't show any vertical scroll bars.
6006 A value of t (the default) means do whatever the window's frame specifies. */);
6008 DEFVAR_PER_BUFFER ("indicate-empty-lines",
6009 &current_buffer->indicate_empty_lines_, Qnil,
6010 doc: /* *Visually indicate empty lines after the buffer end.
6011 If non-nil, a bitmap is displayed in the left fringe of a window on
6012 window-systems. */);
6014 DEFVAR_PER_BUFFER ("indicate-buffer-boundaries",
6015 &current_buffer->indicate_buffer_boundaries_, Qnil,
6016 doc: /* *Visually indicate buffer boundaries and scrolling.
6017 If non-nil, the first and last line of the buffer are marked in the fringe
6018 of a window on window-systems with angle bitmaps, or if the window can be
6019 scrolled, the top and bottom line of the window are marked with up and down
6020 arrow bitmaps.
6022 If value is a symbol `left' or `right', both angle and arrow bitmaps
6023 are displayed in the left or right fringe, resp. Any other value
6024 that doesn't look like an alist means display the angle bitmaps in
6025 the left fringe but no arrows.
6027 You can exercise more precise control by using an alist as the
6028 value. Each alist element (INDICATOR . POSITION) specifies
6029 where to show one of the indicators. INDICATOR is one of `top',
6030 `bottom', `up', `down', or t, which specifies the default position,
6031 and POSITION is one of `left', `right', or nil, meaning do not show
6032 this indicator.
6034 For example, ((top . left) (t . right)) places the top angle bitmap in
6035 left fringe, the bottom angle bitmap in right fringe, and both arrow
6036 bitmaps in right fringe. To show just the angle bitmaps in the left
6037 fringe, but no arrow bitmaps, use ((top . left) (bottom . left)). */);
6039 DEFVAR_PER_BUFFER ("fringe-indicator-alist",
6040 &current_buffer->fringe_indicator_alist_, Qnil,
6041 doc: /* *Mapping from logical to physical fringe indicator bitmaps.
6042 The value is an alist where each element (INDICATOR . BITMAPS)
6043 specifies the fringe bitmaps used to display a specific logical
6044 fringe indicator.
6046 INDICATOR specifies the logical indicator type which is one of the
6047 following symbols: `truncation' , `continuation', `overlay-arrow',
6048 `top', `bottom', `up', `down', `one-line', `empty-line', or `unknown'.
6050 BITMAPS is list of symbols (LEFT RIGHT [LEFT1 RIGHT1]) which specifies
6051 the actual bitmap shown in the left or right fringe for the logical
6052 indicator. LEFT and RIGHT are the bitmaps shown in the left and/or
6053 right fringe for the specific indicator. The LEFT1 or RIGHT1 bitmaps
6054 are used only for the `bottom' and `one-line' indicators when the last
6055 \(only) line in has no final newline. BITMAPS may also be a single
6056 symbol which is used in both left and right fringes. */);
6058 DEFVAR_PER_BUFFER ("fringe-cursor-alist",
6059 &current_buffer->fringe_cursor_alist_, Qnil,
6060 doc: /* *Mapping from logical to physical fringe cursor bitmaps.
6061 The value is an alist where each element (CURSOR . BITMAP)
6062 specifies the fringe bitmaps used to display a specific logical
6063 cursor type in the fringe.
6065 CURSOR specifies the logical cursor type which is one of the following
6066 symbols: `box' , `hollow', `bar', `hbar', or `hollow-small'. The last
6067 one is used to show a hollow cursor on narrow lines display lines
6068 where the normal hollow cursor will not fit.
6070 BITMAP is the corresponding fringe bitmap shown for the logical
6071 cursor type. */);
6073 DEFVAR_PER_BUFFER ("scroll-up-aggressively",
6074 &current_buffer->scroll_up_aggressively_, Qnil,
6075 doc: /* How far to scroll windows upward.
6076 If you move point off the bottom, the window scrolls automatically.
6077 This variable controls how far it scrolls. The value nil, the default,
6078 means scroll to center point. A fraction means scroll to put point
6079 that fraction of the window's height from the bottom of the window.
6080 When the value is 0.0, point goes at the bottom line, which in the
6081 simple case that you moved off with C-f means scrolling just one line.
6082 1.0 means point goes at the top, so that in that simple case, the
6083 window scrolls by a full window height. Meaningful values are
6084 between 0.0 and 1.0, inclusive. */);
6086 DEFVAR_PER_BUFFER ("scroll-down-aggressively",
6087 &current_buffer->scroll_down_aggressively_, Qnil,
6088 doc: /* How far to scroll windows downward.
6089 If you move point off the top, the window scrolls automatically.
6090 This variable controls how far it scrolls. The value nil, the default,
6091 means scroll to center point. A fraction means scroll to put point
6092 that fraction of the window's height from the top of the window.
6093 When the value is 0.0, point goes at the top line, which in the
6094 simple case that you moved off with C-b means scrolling just one line.
6095 1.0 means point goes at the bottom, so that in that simple case, the
6096 window scrolls by a full window height. Meaningful values are
6097 between 0.0 and 1.0, inclusive. */);
6099 /*DEFVAR_LISP ("debug-check-symbol", &Vcheck_symbol,
6100 "Don't ask.");
6103 DEFVAR_LISP ("before-change-functions", &Vbefore_change_functions,
6104 doc: /* List of functions to call before each text change.
6105 Two arguments are passed to each function: the positions of
6106 the beginning and end of the range of old text to be changed.
6107 \(For an insertion, the beginning and end are at the same place.)
6108 No information is given about the length of the text after the change.
6110 Buffer changes made while executing the `before-change-functions'
6111 don't call any before-change or after-change functions.
6112 That's because these variables are temporarily set to nil.
6113 As a result, a hook function cannot straightforwardly alter the
6114 value of these variables. See the Emacs Lisp manual for a way of
6115 accomplishing an equivalent result by using other variables.
6117 If an unhandled error happens in running these functions,
6118 the variable's value remains nil. That prevents the error
6119 from happening repeatedly and making Emacs nonfunctional. */);
6120 Vbefore_change_functions = Qnil;
6122 DEFVAR_LISP ("after-change-functions", &Vafter_change_functions,
6123 doc: /* List of functions to call after each text change.
6124 Three arguments are passed to each function: the positions of
6125 the beginning and end of the range of changed text,
6126 and the length in bytes of the pre-change text replaced by that range.
6127 \(For an insertion, the pre-change length is zero;
6128 for a deletion, that length is the number of bytes deleted,
6129 and the post-change beginning and end are at the same place.)
6131 Buffer changes made while executing the `after-change-functions'
6132 don't call any before-change or after-change functions.
6133 That's because these variables are temporarily set to nil.
6134 As a result, a hook function cannot straightforwardly alter the
6135 value of these variables. See the Emacs Lisp manual for a way of
6136 accomplishing an equivalent result by using other variables.
6138 If an unhandled error happens in running these functions,
6139 the variable's value remains nil. That prevents the error
6140 from happening repeatedly and making Emacs nonfunctional. */);
6141 Vafter_change_functions = Qnil;
6143 DEFVAR_LISP ("first-change-hook", &Vfirst_change_hook,
6144 doc: /* A list of functions to call before changing a buffer which is unmodified.
6145 The functions are run using the `run-hooks' function. */);
6146 Vfirst_change_hook = Qnil;
6148 DEFVAR_PER_BUFFER ("buffer-undo-list", &current_buffer->undo_list_, Qnil,
6149 doc: /* List of undo entries in current buffer.
6150 Recent changes come first; older changes follow newer.
6152 An entry (BEG . END) represents an insertion which begins at
6153 position BEG and ends at position END.
6155 An entry (TEXT . POSITION) represents the deletion of the string TEXT
6156 from (abs POSITION). If POSITION is positive, point was at the front
6157 of the text being deleted; if negative, point was at the end.
6159 An entry (t HIGH . LOW) indicates that the buffer previously had
6160 \"unmodified\" status. HIGH and LOW are the high and low 16-bit portions
6161 of the visited file's modification time, as of that time. If the
6162 modification time of the most recent save is different, this entry is
6163 obsolete.
6165 An entry (nil PROPERTY VALUE BEG . END) indicates that a text property
6166 was modified between BEG and END. PROPERTY is the property name,
6167 and VALUE is the old value.
6169 An entry (apply FUN-NAME . ARGS) means undo the change with
6170 \(apply FUN-NAME ARGS).
6172 An entry (apply DELTA BEG END FUN-NAME . ARGS) supports selective undo
6173 in the active region. BEG and END is the range affected by this entry
6174 and DELTA is the number of bytes added or deleted in that range by
6175 this change.
6177 An entry (MARKER . DISTANCE) indicates that the marker MARKER
6178 was adjusted in position by the offset DISTANCE (an integer).
6180 An entry of the form POSITION indicates that point was at the buffer
6181 location given by the integer. Undoing an entry of this form places
6182 point at POSITION.
6184 Entries with value `nil' mark undo boundaries. The undo command treats
6185 the changes between two undo boundaries as a single step to be undone.
6187 If the value of the variable is t, undo information is not recorded. */);
6189 DEFVAR_PER_BUFFER ("mark-active", &current_buffer->mark_active_, Qnil,
6190 doc: /* Non-nil means the mark and region are currently active in this buffer. */);
6192 DEFVAR_PER_BUFFER ("cache-long-line-scans", &current_buffer->cache_long_line_scans_, Qnil,
6193 doc: /* Non-nil means that Emacs should use caches to handle long lines more quickly.
6195 Normally, the line-motion functions work by scanning the buffer for
6196 newlines. Columnar operations (like `move-to-column' and
6197 `compute-motion') also work by scanning the buffer, summing character
6198 widths as they go. This works well for ordinary text, but if the
6199 buffer's lines are very long (say, more than 500 characters), these
6200 motion functions will take longer to execute. Emacs may also take
6201 longer to update the display.
6203 If `cache-long-line-scans' is non-nil, these motion functions cache the
6204 results of their scans, and consult the cache to avoid rescanning
6205 regions of the buffer until the text is modified. The caches are most
6206 beneficial when they prevent the most searching---that is, when the
6207 buffer contains long lines and large regions of characters with the
6208 same, fixed screen width.
6210 When `cache-long-line-scans' is non-nil, processing short lines will
6211 become slightly slower (because of the overhead of consulting the
6212 cache), and the caches will use memory roughly proportional to the
6213 number of newlines and characters whose screen width varies.
6215 The caches require no explicit maintenance; their accuracy is
6216 maintained internally by the Emacs primitives. Enabling or disabling
6217 the cache should not affect the behavior of any of the motion
6218 functions; it should only affect their performance. */);
6220 DEFVAR_PER_BUFFER ("point-before-scroll", &current_buffer->point_before_scroll_, Qnil,
6221 doc: /* Value of point before the last series of scroll operations, or nil. */);
6223 DEFVAR_PER_BUFFER ("buffer-file-format", &current_buffer->file_format_, Qnil,
6224 doc: /* List of formats to use when saving this buffer.
6225 Formats are defined by `format-alist'. This variable is
6226 set when a file is visited. */);
6228 DEFVAR_PER_BUFFER ("buffer-auto-save-file-format",
6229 &current_buffer->auto_save_file_format_, Qnil,
6230 doc: /* *Format in which to write auto-save files.
6231 Should be a list of symbols naming formats that are defined in `format-alist'.
6232 If it is t, which is the default, auto-save files are written in the
6233 same format as a regular save would use. */);
6235 DEFVAR_PER_BUFFER ("buffer-invisibility-spec",
6236 &current_buffer->invisibility_spec_, Qnil,
6237 doc: /* Invisibility spec of this buffer.
6238 The default is t, which means that text is invisible
6239 if it has a non-nil `invisible' property.
6240 If the value is a list, a text character is invisible if its `invisible'
6241 property is an element in that list (or is a list with members in common).
6242 If an element is a cons cell of the form (PROP . ELLIPSIS),
6243 then characters with property value PROP are invisible,
6244 and they have an ellipsis as well if ELLIPSIS is non-nil. */);
6246 DEFVAR_PER_BUFFER ("buffer-display-count",
6247 &current_buffer->display_count_, Qnil,
6248 doc: /* A number incremented each time this buffer is displayed in a window.
6249 The function `set-window-buffer' increments it. */);
6251 DEFVAR_PER_BUFFER ("buffer-display-time",
6252 &current_buffer->display_time_, Qnil,
6253 doc: /* Time stamp updated each time this buffer is displayed in a window.
6254 The function `set-window-buffer' updates this variable
6255 to the value obtained by calling `current-time'.
6256 If the buffer has never been shown in a window, the value is nil. */);
6258 DEFVAR_LISP ("transient-mark-mode", &Vtransient_mark_mode,
6259 doc: /* */);
6260 Vtransient_mark_mode = Qnil;
6261 /* The docstring is in simple.el. If we put it here, it would be
6262 overwritten when transient-mark-mode is defined using
6263 define-minor-mode. */
6265 DEFVAR_LISP ("inhibit-read-only", &Vinhibit_read_only,
6266 doc: /* *Non-nil means disregard read-only status of buffers or characters.
6267 If the value is t, disregard `buffer-read-only' and all `read-only'
6268 text properties. If the value is a list, disregard `buffer-read-only'
6269 and disregard a `read-only' text property if the property value
6270 is a member of the list. */);
6271 Vinhibit_read_only = Qnil;
6273 DEFVAR_PER_BUFFER ("cursor-type", &current_buffer->cursor_type_, Qnil,
6274 doc: /* Cursor to use when this buffer is in the selected window.
6275 Values are interpreted as follows:
6277 t use the cursor specified for the frame
6278 nil don't display a cursor
6279 box display a filled box cursor
6280 hollow display a hollow box cursor
6281 bar display a vertical bar cursor with default width
6282 (bar . WIDTH) display a vertical bar cursor with width WIDTH
6283 hbar display a horizontal bar cursor with default height
6284 (hbar . HEIGHT) display a horizontal bar cursor with height HEIGHT
6285 ANYTHING ELSE display a hollow box cursor
6287 When the buffer is displayed in a non-selected window, the
6288 cursor's appearance is instead controlled by the variable
6289 `cursor-in-non-selected-windows'. */);
6291 DEFVAR_PER_BUFFER ("line-spacing",
6292 &current_buffer->extra_line_spacing_, Qnil,
6293 doc: /* Additional space to put between lines when displaying a buffer.
6294 The space is measured in pixels, and put below lines on graphic displays,
6295 see `display-graphic-p'.
6296 If value is a floating point number, it specifies the spacing relative
6297 to the default frame line height. A value of nil means add no extra space. */);
6299 DEFVAR_PER_BUFFER ("cursor-in-non-selected-windows",
6300 &current_buffer->cursor_in_non_selected_windows_, Qnil,
6301 doc: /* *Cursor type to display in non-selected windows.
6302 The value t means to use hollow box cursor. See `cursor-type' for other values. */);
6304 DEFVAR_LISP ("kill-buffer-query-functions", &Vkill_buffer_query_functions,
6305 doc: /* List of functions called with no args to query before killing a buffer.
6306 The buffer being killed will be current while the functions are running.
6307 If any of them returns nil, the buffer is not killed. */);
6308 Vkill_buffer_query_functions = Qnil;
6310 DEFVAR_LISP ("change-major-mode-hook", &Vchange_major_mode_hook,
6311 doc: /* Normal hook run before changing the major mode of a buffer.
6312 The function `kill-all-local-variables' runs this before doing anything else. */);
6313 Vchange_major_mode_hook = Qnil;
6314 Qchange_major_mode_hook = intern_c_string ("change-major-mode-hook");
6315 staticpro (&Qchange_major_mode_hook);
6317 defsubr (&Sbuffer_live_p);
6318 defsubr (&Sbuffer_list);
6319 defsubr (&Sget_buffer);
6320 defsubr (&Sget_file_buffer);
6321 defsubr (&Sget_buffer_create);
6322 defsubr (&Smake_indirect_buffer);
6323 defsubr (&Sgenerate_new_buffer_name);
6324 defsubr (&Sbuffer_name);
6325 /*defsubr (&Sbuffer_number);*/
6326 defsubr (&Sbuffer_file_name);
6327 defsubr (&Sbuffer_base_buffer);
6328 defsubr (&Sbuffer_local_value);
6329 defsubr (&Sbuffer_local_variables);
6330 defsubr (&Sbuffer_modified_p);
6331 defsubr (&Sset_buffer_modified_p);
6332 defsubr (&Sbuffer_modified_tick);
6333 defsubr (&Sbuffer_chars_modified_tick);
6334 defsubr (&Srename_buffer);
6335 defsubr (&Sother_buffer);
6336 defsubr (&Sbuffer_enable_undo);
6337 defsubr (&Skill_buffer);
6338 defsubr (&Sset_buffer_major_mode);
6339 defsubr (&Sswitch_to_buffer);
6340 defsubr (&Scurrent_buffer);
6341 defsubr (&Sset_buffer);
6342 defsubr (&Sbarf_if_buffer_read_only);
6343 defsubr (&Sbury_buffer);
6344 defsubr (&Serase_buffer);
6345 defsubr (&Sbuffer_swap_text);
6346 defsubr (&Sset_buffer_multibyte);
6347 defsubr (&Skill_all_local_variables);
6349 defsubr (&Soverlayp);
6350 defsubr (&Smake_overlay);
6351 defsubr (&Sdelete_overlay);
6352 defsubr (&Smove_overlay);
6353 defsubr (&Soverlay_start);
6354 defsubr (&Soverlay_end);
6355 defsubr (&Soverlay_buffer);
6356 defsubr (&Soverlay_properties);
6357 defsubr (&Soverlays_at);
6358 defsubr (&Soverlays_in);
6359 defsubr (&Snext_overlay_change);
6360 defsubr (&Sprevious_overlay_change);
6361 defsubr (&Soverlay_recenter);
6362 defsubr (&Soverlay_lists);
6363 defsubr (&Soverlay_get);
6364 defsubr (&Soverlay_put);
6365 defsubr (&Srestore_buffer_modified_p);
6368 void
6369 keys_of_buffer ()
6371 initial_define_key (control_x_map, 'b', "switch-to-buffer");
6372 initial_define_key (control_x_map, 'k', "kill-buffer");
6374 /* This must not be in syms_of_buffer, because Qdisabled is not
6375 initialized when that function gets called. */
6376 Fput (intern_c_string ("erase-buffer"), Qdisabled, Qt);
6379 /* arch-tag: e48569bf-69a9-4b65-a23b-8e68769436e1
6380 (do not change this comment) */