(print_load_command_name) [LC_DYLD_INFO]: Add cases
[emacs.git] / src / buffer.c
blob580d5f004cde1291cc706b8d09695c94e7a20502
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
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>
30 #ifndef USE_CRT_DLL
31 extern int errno;
32 #endif
35 #ifdef HAVE_UNISTD_H
36 #include <unistd.h>
37 #endif
39 #include "lisp.h"
40 #include "intervals.h"
41 #include "window.h"
42 #include "commands.h"
43 #include "buffer.h"
44 #include "character.h"
45 #include "region-cache.h"
46 #include "indent.h"
47 #include "blockinput.h"
48 #include "keyboard.h"
49 #include "keymap.h"
50 #include "frame.h"
52 struct buffer *current_buffer; /* the current buffer */
54 /* First buffer in chain of all buffers (in reverse order of creation).
55 Threaded through ->next. */
57 struct buffer *all_buffers;
59 /* This structure holds the default values of the buffer-local variables
60 defined with DEFVAR_PER_BUFFER, that have special slots in each buffer.
61 The default value occupies the same slot in this structure
62 as an individual buffer's value occupies in that buffer.
63 Setting the default value also goes through the alist of buffers
64 and stores into each buffer that does not say it has a local value. */
66 DECL_ALIGN (struct buffer, buffer_defaults);
68 /* A Lisp_Object pointer to the above, used for staticpro */
70 static Lisp_Object Vbuffer_defaults;
72 /* This structure marks which slots in a buffer have corresponding
73 default values in buffer_defaults.
74 Each such slot has a nonzero value in this structure.
75 The value has only one nonzero bit.
77 When a buffer has its own local value for a slot,
78 the entry for that slot (found in the same slot in this structure)
79 is turned on in the buffer's local_flags array.
81 If a slot in this structure is -1, then even though there may
82 be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
83 and the corresponding slot in buffer_defaults is not used.
85 If a slot is -2, then there is no DEFVAR_PER_BUFFER for it,
86 but there is a default value which is copied into each buffer.
88 If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is
89 zero, that is a bug */
91 struct buffer buffer_local_flags;
93 /* This structure holds the names of symbols whose values may be
94 buffer-local. It is indexed and accessed in the same way as the above. */
96 DECL_ALIGN (struct buffer, buffer_local_symbols);
98 /* A Lisp_Object pointer to the above, used for staticpro */
99 static Lisp_Object Vbuffer_local_symbols;
101 /* Flags indicating which built-in buffer-local variables
102 are permanent locals. */
103 static char buffer_permanent_local_flags[MAX_PER_BUFFER_VARS];
105 /* Number of per-buffer variables used. */
107 int last_per_buffer_idx;
109 EXFUN (Fset_buffer, 1);
110 void set_buffer_internal P_ ((struct buffer *b));
111 void set_buffer_internal_1 P_ ((struct buffer *b));
112 static void call_overlay_mod_hooks P_ ((Lisp_Object list, Lisp_Object overlay,
113 int after, Lisp_Object arg1,
114 Lisp_Object arg2, Lisp_Object arg3));
115 static void swap_out_buffer_local_variables P_ ((struct buffer *b));
116 static void reset_buffer_local_variables P_ ((struct buffer *b, int permanent_too));
118 /* Alist of all buffer names vs the buffers. */
119 /* This used to be a variable, but is no longer,
120 to prevent lossage due to user rplac'ing this alist or its elements. */
121 Lisp_Object Vbuffer_alist;
123 /* Functions to call before and after each text change. */
124 Lisp_Object Vbefore_change_functions;
125 Lisp_Object Vafter_change_functions;
127 Lisp_Object Vtransient_mark_mode;
129 /* t means ignore all read-only text properties.
130 A list means ignore such a property if its value is a member of the list.
131 Any non-nil value means ignore buffer-read-only. */
132 Lisp_Object Vinhibit_read_only;
134 /* List of functions to call that can query about killing a buffer.
135 If any of these functions returns nil, we don't kill it. */
136 Lisp_Object Vkill_buffer_query_functions;
137 Lisp_Object Qkill_buffer_query_functions;
139 /* Hook run before changing a major mode. */
140 Lisp_Object Vchange_major_mode_hook, Qchange_major_mode_hook;
142 /* List of functions to call before changing an unmodified buffer. */
143 Lisp_Object Vfirst_change_hook;
145 Lisp_Object Qfirst_change_hook;
146 Lisp_Object Qbefore_change_functions;
147 Lisp_Object Qafter_change_functions;
148 Lisp_Object Qucs_set_table_for_input;
150 /* If nonzero, all modification hooks are suppressed. */
151 int inhibit_modification_hooks;
153 Lisp_Object Qfundamental_mode, Qmode_class, Qpermanent_local;
154 Lisp_Object Qpermanent_local_hook;
156 Lisp_Object Qprotected_field;
158 Lisp_Object QSFundamental; /* A string "Fundamental" */
160 Lisp_Object Qkill_buffer_hook;
162 Lisp_Object Qget_file_buffer;
164 Lisp_Object Qoverlayp;
166 Lisp_Object Qpriority, Qwindow, Qevaporate, Qbefore_string, Qafter_string;
168 Lisp_Object Qmodification_hooks;
169 Lisp_Object Qinsert_in_front_hooks;
170 Lisp_Object Qinsert_behind_hooks;
172 static void alloc_buffer_text P_ ((struct buffer *, size_t));
173 static void free_buffer_text P_ ((struct buffer *b));
174 static struct Lisp_Overlay * copy_overlays P_ ((struct buffer *, struct Lisp_Overlay *));
175 static void modify_overlay P_ ((struct buffer *, EMACS_INT, EMACS_INT));
176 static Lisp_Object buffer_lisp_local_variables P_ ((struct buffer *));
178 extern char * emacs_strerror P_ ((int));
180 /* For debugging; temporary. See set_buffer_internal. */
181 /* Lisp_Object Qlisp_mode, Vcheck_symbol; */
183 void
184 nsberror (spec)
185 Lisp_Object spec;
187 if (STRINGP (spec))
188 error ("No buffer named %s", SDATA (spec));
189 error ("Invalid buffer argument");
192 DEFUN ("buffer-live-p", Fbuffer_live_p, Sbuffer_live_p, 1, 1, 0,
193 doc: /* Return non-nil if OBJECT is a buffer which has not been killed.
194 Value is nil if OBJECT is not a buffer or if it has been killed. */)
195 (object)
196 Lisp_Object object;
198 return ((BUFFERP (object) && ! NILP (XBUFFER (object)->name))
199 ? Qt : Qnil);
202 DEFUN ("buffer-list", Fbuffer_list, Sbuffer_list, 0, 1, 0,
203 doc: /* Return a list of all existing live buffers.
204 If the optional arg FRAME is a frame, we return the buffer list
205 in the proper order for that frame: the buffers in FRAME's `buffer-list'
206 frame parameter come first, followed by the rest of the buffers. */)
207 (frame)
208 Lisp_Object frame;
210 Lisp_Object general;
211 general = Fmapcar (Qcdr, Vbuffer_alist);
213 if (FRAMEP (frame))
215 Lisp_Object framelist, prevlist, tail;
216 Lisp_Object args[3];
218 CHECK_FRAME (frame);
220 framelist = Fcopy_sequence (XFRAME (frame)->buffer_list);
221 prevlist = Fnreverse (Fcopy_sequence (XFRAME (frame)->buried_buffer_list));
223 /* Remove from GENERAL any buffer that duplicates one in
224 FRAMELIST or PREVLIST. */
225 tail = framelist;
226 while (CONSP (tail))
228 general = Fdelq (XCAR (tail), general);
229 tail = XCDR (tail);
231 tail = prevlist;
232 while (CONSP (tail))
234 general = Fdelq (XCAR (tail), general);
235 tail = XCDR (tail);
238 args[0] = framelist;
239 args[1] = general;
240 args[2] = prevlist;
241 return Fnconc (3, args);
244 return general;
247 /* Like Fassoc, but use Fstring_equal to compare
248 (which ignores text properties),
249 and don't ever QUIT. */
251 static Lisp_Object
252 assoc_ignore_text_properties (key, list)
253 register Lisp_Object key;
254 Lisp_Object list;
256 register Lisp_Object tail;
257 for (tail = list; CONSP (tail); tail = XCDR (tail))
259 register Lisp_Object elt, tem;
260 elt = XCAR (tail);
261 tem = Fstring_equal (Fcar (elt), key);
262 if (!NILP (tem))
263 return elt;
265 return Qnil;
268 DEFUN ("get-buffer", Fget_buffer, Sget_buffer, 1, 1, 0,
269 doc: /* Return the buffer named BUFFER-OR-NAME.
270 BUFFER-OR-NAME must be either a string or a buffer. If BUFFER-OR-NAME
271 is a string and there is no buffer with that name, return nil. If
272 BUFFER-OR-NAME is a buffer, return it as given. */)
273 (buffer_or_name)
274 register Lisp_Object buffer_or_name;
276 if (BUFFERP (buffer_or_name))
277 return buffer_or_name;
278 CHECK_STRING (buffer_or_name);
280 return Fcdr (assoc_ignore_text_properties (buffer_or_name, Vbuffer_alist));
283 DEFUN ("get-file-buffer", Fget_file_buffer, Sget_file_buffer, 1, 1, 0,
284 doc: /* Return the buffer visiting file FILENAME (a string).
285 The buffer's `buffer-file-name' must match exactly the expansion of FILENAME.
286 If there is no such live buffer, return nil.
287 See also `find-buffer-visiting'. */)
288 (filename)
289 register Lisp_Object filename;
291 register Lisp_Object tail, buf, tem;
292 Lisp_Object handler;
294 CHECK_STRING (filename);
295 filename = Fexpand_file_name (filename, Qnil);
297 /* If the file name has special constructs in it,
298 call the corresponding file handler. */
299 handler = Ffind_file_name_handler (filename, Qget_file_buffer);
300 if (!NILP (handler))
301 return call2 (handler, Qget_file_buffer, filename);
303 for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
305 buf = Fcdr (XCAR (tail));
306 if (!BUFFERP (buf)) continue;
307 if (!STRINGP (XBUFFER (buf)->filename)) continue;
308 tem = Fstring_equal (XBUFFER (buf)->filename, filename);
309 if (!NILP (tem))
310 return buf;
312 return Qnil;
315 Lisp_Object
316 get_truename_buffer (filename)
317 register Lisp_Object filename;
319 register Lisp_Object tail, buf, tem;
321 for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
323 buf = Fcdr (XCAR (tail));
324 if (!BUFFERP (buf)) continue;
325 if (!STRINGP (XBUFFER (buf)->file_truename)) continue;
326 tem = Fstring_equal (XBUFFER (buf)->file_truename, filename);
327 if (!NILP (tem))
328 return buf;
330 return Qnil;
333 /* Incremented for each buffer created, to assign the buffer number. */
334 int buffer_count;
336 DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 1, 0,
337 doc: /* Return the buffer specified by BUFFER-OR-NAME, creating a new one if needed.
338 If BUFFER-OR-NAME is a string and a live buffer with that name exists,
339 return that buffer. If no such buffer exists, create a new buffer with
340 that name and return it. If BUFFER-OR-NAME starts with a space, the new
341 buffer does not keep undo information.
343 If BUFFER-OR-NAME is a buffer instead of a string, return it as given,
344 even if it is dead. The return value is never nil. */)
345 (buffer_or_name)
346 register Lisp_Object buffer_or_name;
348 register Lisp_Object buffer, name;
349 register struct buffer *b;
351 buffer = Fget_buffer (buffer_or_name);
352 if (!NILP (buffer))
353 return buffer;
355 if (SCHARS (buffer_or_name) == 0)
356 error ("Empty string for buffer name is not allowed");
358 b = allocate_buffer ();
360 /* An ordinary buffer uses its own struct buffer_text. */
361 b->text = &b->own_text;
362 b->base_buffer = 0;
364 BUF_GAP_SIZE (b) = 20;
365 BLOCK_INPUT;
366 /* We allocate extra 1-byte at the tail and keep it always '\0' for
367 anchoring a search. */
368 alloc_buffer_text (b, BUF_GAP_SIZE (b) + 1);
369 UNBLOCK_INPUT;
370 if (! BUF_BEG_ADDR (b))
371 buffer_memory_full ();
373 BUF_PT (b) = BEG;
374 BUF_GPT (b) = BEG;
375 BUF_BEGV (b) = BEG;
376 BUF_ZV (b) = BEG;
377 BUF_Z (b) = BEG;
378 BUF_PT_BYTE (b) = BEG_BYTE;
379 BUF_GPT_BYTE (b) = BEG_BYTE;
380 BUF_BEGV_BYTE (b) = BEG_BYTE;
381 BUF_ZV_BYTE (b) = BEG_BYTE;
382 BUF_Z_BYTE (b) = BEG_BYTE;
383 BUF_MODIFF (b) = 1;
384 BUF_CHARS_MODIFF (b) = 1;
385 BUF_OVERLAY_MODIFF (b) = 1;
386 BUF_SAVE_MODIFF (b) = 1;
387 BUF_INTERVALS (b) = 0;
388 BUF_UNCHANGED_MODIFIED (b) = 1;
389 BUF_OVERLAY_UNCHANGED_MODIFIED (b) = 1;
390 BUF_END_UNCHANGED (b) = 0;
391 BUF_BEG_UNCHANGED (b) = 0;
392 *(BUF_GPT_ADDR (b)) = *(BUF_Z_ADDR (b)) = 0; /* Put an anchor '\0'. */
394 b->newline_cache = 0;
395 b->width_run_cache = 0;
396 b->width_table = Qnil;
397 b->prevent_redisplay_optimizations_p = 1;
399 /* Put this on the chain of all buffers including killed ones. */
400 b->next = all_buffers;
401 all_buffers = b;
403 /* An ordinary buffer normally doesn't need markers
404 to handle BEGV and ZV. */
405 b->pt_marker = Qnil;
406 b->begv_marker = Qnil;
407 b->zv_marker = Qnil;
409 name = Fcopy_sequence (buffer_or_name);
410 STRING_SET_INTERVALS (name, NULL_INTERVAL);
411 b->name = name;
413 b->undo_list = (SREF (name, 0) != ' ') ? Qnil : Qt;
415 reset_buffer (b);
416 reset_buffer_local_variables (b, 1);
418 b->mark = Fmake_marker ();
419 BUF_MARKERS (b) = NULL;
420 b->name = name;
422 /* Put this in the alist of all live buffers. */
423 XSETBUFFER (buffer, b);
424 Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buffer), Qnil));
426 /* An error in calling the function here (should someone redefine it)
427 can lead to infinite regress until you run out of stack. rms
428 says that's not worth protecting against. */
429 if (!NILP (Ffboundp (Qucs_set_table_for_input)))
430 /* buffer is on buffer-alist, so no gcpro. */
431 call1 (Qucs_set_table_for_input, buffer);
433 return buffer;
437 /* Return a list of overlays which is a copy of the overlay list
438 LIST, but for buffer B. */
440 static struct Lisp_Overlay *
441 copy_overlays (b, list)
442 struct buffer *b;
443 struct Lisp_Overlay *list;
445 Lisp_Object buffer;
446 struct Lisp_Overlay *result = NULL, *tail = NULL;
448 XSETBUFFER (buffer, b);
450 for (; list; list = list->next)
452 Lisp_Object overlay, start, end, old_overlay;
453 EMACS_INT charpos;
455 XSETMISC (old_overlay, list);
456 charpos = marker_position (OVERLAY_START (old_overlay));
457 start = Fmake_marker ();
458 Fset_marker (start, make_number (charpos), buffer);
459 XMARKER (start)->insertion_type
460 = XMARKER (OVERLAY_START (old_overlay))->insertion_type;
462 charpos = marker_position (OVERLAY_END (old_overlay));
463 end = Fmake_marker ();
464 Fset_marker (end, make_number (charpos), buffer);
465 XMARKER (end)->insertion_type
466 = XMARKER (OVERLAY_END (old_overlay))->insertion_type;
468 overlay = allocate_misc ();
469 XMISCTYPE (overlay) = Lisp_Misc_Overlay;
470 OVERLAY_START (overlay) = start;
471 OVERLAY_END (overlay) = end;
472 OVERLAY_PLIST (overlay) = Fcopy_sequence (OVERLAY_PLIST (old_overlay));
473 XOVERLAY (overlay)->next = NULL;
475 if (tail)
476 tail = tail->next = XOVERLAY (overlay);
477 else
478 result = tail = XOVERLAY (overlay);
481 return result;
485 /* Clone per-buffer values of buffer FROM.
487 Buffer TO gets the same per-buffer values as FROM, with the
488 following exceptions: (1) TO's name is left untouched, (2) markers
489 are copied and made to refer to TO, and (3) overlay lists are
490 copied. */
492 static void
493 clone_per_buffer_values (from, to)
494 struct buffer *from, *to;
496 Lisp_Object to_buffer;
497 int offset;
499 XSETBUFFER (to_buffer, to);
501 /* buffer-local Lisp variables start at `undo_list',
502 tho only the ones from `name' on are GC'd normally. */
503 for (offset = PER_BUFFER_VAR_OFFSET (undo_list);
504 offset < sizeof *to;
505 offset += sizeof (Lisp_Object))
507 Lisp_Object obj;
509 /* Don't touch the `name' which should be unique for every buffer. */
510 if (offset == PER_BUFFER_VAR_OFFSET (name))
511 continue;
513 obj = PER_BUFFER_VALUE (from, offset);
514 if (MARKERP (obj))
516 struct Lisp_Marker *m = XMARKER (obj);
517 obj = Fmake_marker ();
518 XMARKER (obj)->insertion_type = m->insertion_type;
519 set_marker_both (obj, to_buffer, m->charpos, m->bytepos);
522 PER_BUFFER_VALUE (to, offset) = obj;
525 bcopy (from->local_flags, to->local_flags, sizeof to->local_flags);
527 to->overlays_before = copy_overlays (to, from->overlays_before);
528 to->overlays_after = copy_overlays (to, from->overlays_after);
530 /* Get (a copy of) the alist of Lisp-level local variables of FROM
531 and install that in TO. */
532 to->local_var_alist = buffer_lisp_local_variables (from);
535 DEFUN ("make-indirect-buffer", Fmake_indirect_buffer, Smake_indirect_buffer,
536 2, 3,
537 "bMake indirect buffer (to buffer): \nBName of indirect buffer: ",
538 doc: /* Create and return an indirect buffer for buffer BASE-BUFFER, named NAME.
539 BASE-BUFFER should be a live buffer, or the name of an existing buffer.
540 NAME should be a string which is not the name of an existing buffer.
541 Optional argument CLONE non-nil means preserve BASE-BUFFER's state,
542 such as major and minor modes, in the indirect buffer.
543 CLONE nil means the indirect buffer's state is reset to default values. */)
544 (base_buffer, name, clone)
545 Lisp_Object base_buffer, name, clone;
547 Lisp_Object buf, tem;
548 struct buffer *b;
550 CHECK_STRING (name);
551 buf = Fget_buffer (name);
552 if (!NILP (buf))
553 error ("Buffer name `%s' is in use", SDATA (name));
555 tem = base_buffer;
556 base_buffer = Fget_buffer (base_buffer);
557 if (NILP (base_buffer))
558 error ("No such buffer: `%s'", SDATA (tem));
559 if (NILP (XBUFFER (base_buffer)->name))
560 error ("Base buffer has been killed");
562 if (SCHARS (name) == 0)
563 error ("Empty string for buffer name is not allowed");
565 b = allocate_buffer ();
567 b->base_buffer = (XBUFFER (base_buffer)->base_buffer
568 ? XBUFFER (base_buffer)->base_buffer
569 : XBUFFER (base_buffer));
571 /* Use the base buffer's text object. */
572 b->text = b->base_buffer->text;
574 BUF_BEGV (b) = BUF_BEGV (b->base_buffer);
575 BUF_ZV (b) = BUF_ZV (b->base_buffer);
576 BUF_PT (b) = BUF_PT (b->base_buffer);
577 BUF_BEGV_BYTE (b) = BUF_BEGV_BYTE (b->base_buffer);
578 BUF_ZV_BYTE (b) = BUF_ZV_BYTE (b->base_buffer);
579 BUF_PT_BYTE (b) = BUF_PT_BYTE (b->base_buffer);
581 b->newline_cache = 0;
582 b->width_run_cache = 0;
583 b->width_table = Qnil;
585 /* Put this on the chain of all buffers including killed ones. */
586 b->next = all_buffers;
587 all_buffers = b;
589 name = Fcopy_sequence (name);
590 STRING_SET_INTERVALS (name, NULL_INTERVAL);
591 b->name = name;
593 reset_buffer (b);
594 reset_buffer_local_variables (b, 1);
596 /* Put this in the alist of all live buffers. */
597 XSETBUFFER (buf, b);
598 Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));
600 b->mark = Fmake_marker ();
601 b->name = name;
603 /* The multibyte status belongs to the base buffer. */
604 b->enable_multibyte_characters = b->base_buffer->enable_multibyte_characters;
606 /* Make sure the base buffer has markers for its narrowing. */
607 if (NILP (b->base_buffer->pt_marker))
609 b->base_buffer->pt_marker = Fmake_marker ();
610 set_marker_both (b->base_buffer->pt_marker, base_buffer,
611 BUF_PT (b->base_buffer),
612 BUF_PT_BYTE (b->base_buffer));
614 if (NILP (b->base_buffer->begv_marker))
616 b->base_buffer->begv_marker = Fmake_marker ();
617 set_marker_both (b->base_buffer->begv_marker, base_buffer,
618 BUF_BEGV (b->base_buffer),
619 BUF_BEGV_BYTE (b->base_buffer));
621 if (NILP (b->base_buffer->zv_marker))
623 b->base_buffer->zv_marker = Fmake_marker ();
624 set_marker_both (b->base_buffer->zv_marker, base_buffer,
625 BUF_ZV (b->base_buffer),
626 BUF_ZV_BYTE (b->base_buffer));
627 XMARKER (b->base_buffer->zv_marker)->insertion_type = 1;
630 if (NILP (clone))
632 /* Give the indirect buffer markers for its narrowing. */
633 b->pt_marker = Fmake_marker ();
634 set_marker_both (b->pt_marker, buf, BUF_PT (b), BUF_PT_BYTE (b));
635 b->begv_marker = Fmake_marker ();
636 set_marker_both (b->begv_marker, buf, BUF_BEGV (b), BUF_BEGV_BYTE (b));
637 b->zv_marker = Fmake_marker ();
638 set_marker_both (b->zv_marker, buf, BUF_ZV (b), BUF_ZV_BYTE (b));
639 XMARKER (b->zv_marker)->insertion_type = 1;
641 else
643 struct buffer *old_b = current_buffer;
645 clone_per_buffer_values (b->base_buffer, b);
646 b->filename = Qnil;
647 b->file_truename = Qnil;
648 b->display_count = make_number (0);
649 b->backed_up = Qnil;
650 b->auto_save_file_name = Qnil;
651 set_buffer_internal_1 (b);
652 Fset (intern ("buffer-save-without-query"), Qnil);
653 Fset (intern ("buffer-file-number"), Qnil);
654 Fset (intern ("buffer-stale-function"), Qnil);
655 set_buffer_internal_1 (old_b);
658 return buf;
661 void
662 delete_all_overlays (b)
663 struct buffer *b;
665 Lisp_Object overlay;
667 /* `reset_buffer' blindly sets the list of overlays to NULL, so we
668 have to empty the list, otherwise we end up with overlays that
669 think they belong to this buffer while the buffer doesn't know about
670 them any more. */
671 while (b->overlays_before)
673 XSETMISC (overlay, b->overlays_before);
674 Fdelete_overlay (overlay);
676 while (b->overlays_after)
678 XSETMISC (overlay, b->overlays_after);
679 Fdelete_overlay (overlay);
681 eassert (b->overlays_before == NULL);
682 eassert (b->overlays_after == NULL);
685 /* Reinitialize everything about a buffer except its name and contents
686 and local variables.
687 If called on an already-initialized buffer, the list of overlays
688 should be deleted before calling this function, otherwise we end up
689 with overlays that claim to belong to the buffer but the buffer
690 claims it doesn't belong to it. */
692 void
693 reset_buffer (b)
694 register struct buffer *b;
696 b->filename = Qnil;
697 b->file_truename = Qnil;
698 b->directory = (current_buffer) ? current_buffer->directory : Qnil;
699 b->modtime = 0;
700 XSETFASTINT (b->save_length, 0);
701 b->last_window_start = 1;
702 /* It is more conservative to start out "changed" than "unchanged". */
703 b->clip_changed = 0;
704 b->prevent_redisplay_optimizations_p = 1;
705 b->backed_up = Qnil;
706 b->auto_save_modified = 0;
707 b->auto_save_failure_time = -1;
708 b->auto_save_file_name = Qnil;
709 b->read_only = Qnil;
710 b->overlays_before = NULL;
711 b->overlays_after = NULL;
712 b->overlay_center = BEG;
713 b->mark_active = Qnil;
714 b->point_before_scroll = Qnil;
715 b->file_format = Qnil;
716 b->auto_save_file_format = Qt;
717 b->last_selected_window = Qnil;
718 XSETINT (b->display_count, 0);
719 b->display_time = Qnil;
720 b->enable_multibyte_characters = buffer_defaults.enable_multibyte_characters;
721 b->cursor_type = buffer_defaults.cursor_type;
722 b->extra_line_spacing = buffer_defaults.extra_line_spacing;
724 b->display_error_modiff = 0;
727 /* Reset buffer B's local variables info.
728 Don't use this on a buffer that has already been in use;
729 it does not treat permanent locals consistently.
730 Instead, use Fkill_all_local_variables.
732 If PERMANENT_TOO is 1, then we reset permanent
733 buffer-local variables. If PERMANENT_TOO is 0,
734 we preserve those. */
736 static void
737 reset_buffer_local_variables (b, permanent_too)
738 register struct buffer *b;
739 int permanent_too;
741 register int offset;
742 int i;
744 /* Reset the major mode to Fundamental, together with all the
745 things that depend on the major mode.
746 default-major-mode is handled at a higher level.
747 We ignore it here. */
748 b->major_mode = Qfundamental_mode;
749 b->keymap = Qnil;
750 b->mode_name = QSFundamental;
751 b->minor_modes = Qnil;
753 /* If the standard case table has been altered and invalidated,
754 fix up its insides first. */
755 if (! (CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[0])
756 && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[1])
757 && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[2])))
758 Fset_standard_case_table (Vascii_downcase_table);
760 b->downcase_table = Vascii_downcase_table;
761 b->upcase_table = XCHAR_TABLE (Vascii_downcase_table)->extras[0];
762 b->case_canon_table = XCHAR_TABLE (Vascii_downcase_table)->extras[1];
763 b->case_eqv_table = XCHAR_TABLE (Vascii_downcase_table)->extras[2];
764 b->invisibility_spec = Qt;
765 #ifndef DOS_NT
766 b->buffer_file_type = Qnil;
767 #endif
769 /* Reset all (or most) per-buffer variables to their defaults. */
770 if (permanent_too)
771 b->local_var_alist = Qnil;
772 else
774 Lisp_Object tmp, prop, last = Qnil;
775 for (tmp = b->local_var_alist; CONSP (tmp); tmp = XCDR (tmp))
776 if (CONSP (XCAR (tmp))
777 && SYMBOLP (XCAR (XCAR (tmp)))
778 && !NILP (prop = Fget (XCAR (XCAR (tmp)), Qpermanent_local)))
780 /* If permanent-local, keep it. */
781 last = tmp;
782 if (EQ (prop, Qpermanent_local_hook))
784 /* This is a partially permanent hook variable.
785 Preserve only the elements that want to be preserved. */
786 Lisp_Object list, newlist;
787 list = XCDR (XCAR (tmp));
788 if (!CONSP (list))
789 newlist = list;
790 else
791 for (newlist = Qnil; CONSP (list); list = XCDR (list))
793 Lisp_Object elt = XCAR (list);
794 /* Preserve element ELT if it's t,
795 if it is a function with a `permanent-local-hook' property,
796 or if it's not a symbol. */
797 if (! SYMBOLP (elt)
798 || EQ (elt, Qt)
799 || !NILP (Fget (elt, Qpermanent_local_hook)))
800 newlist = Fcons (elt, newlist);
802 XSETCDR (XCAR (tmp), Fnreverse (newlist));
805 /* Delete this local variable. */
806 else if (NILP (last))
807 b->local_var_alist = XCDR (tmp);
808 else
809 XSETCDR (last, XCDR (tmp));
812 for (i = 0; i < last_per_buffer_idx; ++i)
813 if (permanent_too || buffer_permanent_local_flags[i] == 0)
814 SET_PER_BUFFER_VALUE_P (b, i, 0);
816 /* For each slot that has a default value,
817 copy that into the slot. */
819 /* buffer-local Lisp variables start at `undo_list',
820 tho only the ones from `name' on are GC'd normally. */
821 for (offset = PER_BUFFER_VAR_OFFSET (undo_list);
822 offset < sizeof *b;
823 offset += sizeof (Lisp_Object))
825 int idx = PER_BUFFER_IDX (offset);
826 if ((idx > 0
827 && (permanent_too
828 || buffer_permanent_local_flags[idx] == 0))
829 /* Is -2 used anywhere? */
830 || idx == -2)
831 PER_BUFFER_VALUE (b, offset) = PER_BUFFER_DEFAULT (offset);
835 /* We split this away from generate-new-buffer, because rename-buffer
836 and set-visited-file-name ought to be able to use this to really
837 rename the buffer properly. */
839 DEFUN ("generate-new-buffer-name", Fgenerate_new_buffer_name, Sgenerate_new_buffer_name,
840 1, 2, 0,
841 doc: /* Return a string that is the name of no existing buffer based on NAME.
842 If there is no live buffer named NAME, then return NAME.
843 Otherwise modify name by appending `<NUMBER>', incrementing NUMBER
844 \(starting at 2) until an unused name is found, and then return that name.
845 Optional second argument IGNORE specifies a name that is okay to use (if
846 it is in the sequence to be tried) even if a buffer with that name exists. */)
847 (name, ignore)
848 register Lisp_Object name, ignore;
850 register Lisp_Object gentemp, tem;
851 int count;
852 char number[10];
854 CHECK_STRING (name);
856 tem = Fstring_equal (name, ignore);
857 if (!NILP (tem))
858 return name;
859 tem = Fget_buffer (name);
860 if (NILP (tem))
861 return name;
863 count = 1;
864 while (1)
866 sprintf (number, "<%d>", ++count);
867 gentemp = concat2 (name, build_string (number));
868 tem = Fstring_equal (gentemp, ignore);
869 if (!NILP (tem))
870 return gentemp;
871 tem = Fget_buffer (gentemp);
872 if (NILP (tem))
873 return gentemp;
878 DEFUN ("buffer-name", Fbuffer_name, Sbuffer_name, 0, 1, 0,
879 doc: /* Return the name of BUFFER, as a string.
880 With no argument or nil as argument, return the name of the current buffer. */)
881 (buffer)
882 register Lisp_Object buffer;
884 if (NILP (buffer))
885 return current_buffer->name;
886 CHECK_BUFFER (buffer);
887 return XBUFFER (buffer)->name;
890 DEFUN ("buffer-file-name", Fbuffer_file_name, Sbuffer_file_name, 0, 1, 0,
891 doc: /* Return name of file BUFFER is visiting, or nil if none.
892 No argument or nil as argument means use the current buffer. */)
893 (buffer)
894 register Lisp_Object buffer;
896 if (NILP (buffer))
897 return current_buffer->filename;
898 CHECK_BUFFER (buffer);
899 return XBUFFER (buffer)->filename;
902 DEFUN ("buffer-base-buffer", Fbuffer_base_buffer, Sbuffer_base_buffer,
903 0, 1, 0,
904 doc: /* Return the base buffer of indirect buffer BUFFER.
905 If BUFFER is not indirect, return nil.
906 BUFFER defaults to the current buffer. */)
907 (buffer)
908 register Lisp_Object buffer;
910 struct buffer *base;
911 Lisp_Object base_buffer;
913 if (NILP (buffer))
914 base = current_buffer->base_buffer;
915 else
917 CHECK_BUFFER (buffer);
918 base = XBUFFER (buffer)->base_buffer;
921 if (! base)
922 return Qnil;
923 XSETBUFFER (base_buffer, base);
924 return base_buffer;
927 DEFUN ("buffer-local-value", Fbuffer_local_value,
928 Sbuffer_local_value, 2, 2, 0,
929 doc: /* Return the value of VARIABLE in BUFFER.
930 If VARIABLE does not have a buffer-local binding in BUFFER, the value
931 is the default binding of the variable. */)
932 (variable, buffer)
933 register Lisp_Object variable;
934 register Lisp_Object buffer;
936 register struct buffer *buf;
937 register Lisp_Object result;
938 struct Lisp_Symbol *sym;
940 CHECK_SYMBOL (variable);
941 CHECK_BUFFER (buffer);
942 buf = XBUFFER (buffer);
944 sym = indirect_variable (XSYMBOL (variable));
945 XSETSYMBOL (variable, sym);
947 /* Look in local_var_list */
948 result = Fassoc (variable, buf->local_var_alist);
949 if (NILP (result))
951 int offset, idx;
952 int found = 0;
954 /* Look in special slots */
955 /* buffer-local Lisp variables start at `undo_list',
956 tho only the ones from `name' on are GC'd normally. */
957 for (offset = PER_BUFFER_VAR_OFFSET (undo_list);
958 offset < sizeof (struct buffer);
959 /* sizeof EMACS_INT == sizeof Lisp_Object */
960 offset += (sizeof (EMACS_INT)))
962 idx = PER_BUFFER_IDX (offset);
963 if ((idx == -1 || PER_BUFFER_VALUE_P (buf, idx))
964 && SYMBOLP (PER_BUFFER_SYMBOL (offset))
965 && EQ (PER_BUFFER_SYMBOL (offset), variable))
967 result = PER_BUFFER_VALUE (buf, offset);
968 found = 1;
969 break;
973 if (!found)
974 result = Fdefault_value (variable);
976 else
978 Lisp_Object valcontents;
979 Lisp_Object current_alist_element;
981 /* What binding is loaded right now? */
982 valcontents = sym->value;
983 current_alist_element
984 = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr);
986 /* The value of the currently loaded binding is not
987 stored in it, but rather in the realvalue slot.
988 Store that value into the binding it belongs to
989 in case that is the one we are about to use. */
991 Fsetcdr (current_alist_element,
992 do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue));
994 /* Now get the (perhaps updated) value out of the binding. */
995 result = XCDR (result);
998 if (!EQ (result, Qunbound))
999 return result;
1001 xsignal1 (Qvoid_variable, variable);
1004 /* Return an alist of the Lisp-level buffer-local bindings of
1005 buffer BUF. That is, don't include the variables maintained
1006 in special slots in the buffer object. */
1008 static Lisp_Object
1009 buffer_lisp_local_variables (buf)
1010 struct buffer *buf;
1012 Lisp_Object result = Qnil;
1013 register Lisp_Object tail;
1014 for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail))
1016 Lisp_Object val, elt;
1018 elt = XCAR (tail);
1020 /* Reference each variable in the alist in buf.
1021 If inquiring about the current buffer, this gets the current values,
1022 so store them into the alist so the alist is up to date.
1023 If inquiring about some other buffer, this swaps out any values
1024 for that buffer, making the alist up to date automatically. */
1025 val = find_symbol_value (XCAR (elt));
1026 /* Use the current buffer value only if buf is the current buffer. */
1027 if (buf != current_buffer)
1028 val = XCDR (elt);
1030 /* If symbol is unbound, put just the symbol in the list. */
1031 if (EQ (val, Qunbound))
1032 result = Fcons (XCAR (elt), result);
1033 /* Otherwise, put (symbol . value) in the list. */
1034 else
1035 result = Fcons (Fcons (XCAR (elt), val), result);
1038 return result;
1041 DEFUN ("buffer-local-variables", Fbuffer_local_variables,
1042 Sbuffer_local_variables, 0, 1, 0,
1043 doc: /* Return an alist of variables that are buffer-local in BUFFER.
1044 Most elements look like (SYMBOL . VALUE), describing one variable.
1045 For a symbol that is locally unbound, just the symbol appears in the value.
1046 Note that storing new VALUEs in these elements doesn't change the variables.
1047 No argument or nil as argument means use current buffer as BUFFER. */)
1048 (buffer)
1049 register Lisp_Object buffer;
1051 register struct buffer *buf;
1052 register Lisp_Object result;
1054 if (NILP (buffer))
1055 buf = current_buffer;
1056 else
1058 CHECK_BUFFER (buffer);
1059 buf = XBUFFER (buffer);
1062 result = buffer_lisp_local_variables (buf);
1064 /* Add on all the variables stored in special slots. */
1066 int offset, idx;
1068 /* buffer-local Lisp variables start at `undo_list',
1069 tho only the ones from `name' on are GC'd normally. */
1070 for (offset = PER_BUFFER_VAR_OFFSET (undo_list);
1071 offset < sizeof (struct buffer);
1072 /* sizeof EMACS_INT == sizeof Lisp_Object */
1073 offset += (sizeof (EMACS_INT)))
1075 idx = PER_BUFFER_IDX (offset);
1076 if ((idx == -1 || PER_BUFFER_VALUE_P (buf, idx))
1077 && SYMBOLP (PER_BUFFER_SYMBOL (offset)))
1078 result = Fcons (Fcons (PER_BUFFER_SYMBOL (offset),
1079 PER_BUFFER_VALUE (buf, offset)),
1080 result);
1084 return result;
1087 DEFUN ("buffer-modified-p", Fbuffer_modified_p, Sbuffer_modified_p,
1088 0, 1, 0,
1089 doc: /* Return t if BUFFER was modified since its file was last read or saved.
1090 No argument or nil as argument means use current buffer as BUFFER. */)
1091 (buffer)
1092 register Lisp_Object buffer;
1094 register struct buffer *buf;
1095 if (NILP (buffer))
1096 buf = current_buffer;
1097 else
1099 CHECK_BUFFER (buffer);
1100 buf = XBUFFER (buffer);
1103 return BUF_SAVE_MODIFF (buf) < BUF_MODIFF (buf) ? Qt : Qnil;
1106 DEFUN ("set-buffer-modified-p", Fset_buffer_modified_p, Sset_buffer_modified_p,
1107 1, 1, 0,
1108 doc: /* Mark current buffer as modified or unmodified according to FLAG.
1109 A non-nil FLAG means mark the buffer modified. */)
1110 (flag)
1111 register Lisp_Object flag;
1113 register int already;
1114 register Lisp_Object fn;
1115 Lisp_Object buffer, window;
1117 #ifdef CLASH_DETECTION
1118 /* If buffer becoming modified, lock the file.
1119 If buffer becoming unmodified, unlock the file. */
1121 fn = current_buffer->file_truename;
1122 /* Test buffer-file-name so that binding it to nil is effective. */
1123 if (!NILP (fn) && ! NILP (current_buffer->filename))
1125 already = SAVE_MODIFF < MODIFF;
1126 if (!already && !NILP (flag))
1127 lock_file (fn);
1128 else if (already && NILP (flag))
1129 unlock_file (fn);
1131 #endif /* CLASH_DETECTION */
1133 SAVE_MODIFF = NILP (flag) ? MODIFF : 0;
1135 /* Set update_mode_lines only if buffer is displayed in some window.
1136 Packages like jit-lock or lazy-lock preserve a buffer's modified
1137 state by recording/restoring the state around blocks of code.
1138 Setting update_mode_lines makes redisplay consider all windows
1139 (on all frames). Stealth fontification of buffers not displayed
1140 would incur additional redisplay costs if we'd set
1141 update_modes_lines unconditionally.
1143 Ideally, I think there should be another mechanism for fontifying
1144 buffers without "modifying" buffers, or redisplay should be
1145 smarter about updating the `*' in mode lines. --gerd */
1146 XSETBUFFER (buffer, current_buffer);
1147 window = Fget_buffer_window (buffer, Qt);
1148 if (WINDOWP (window))
1150 ++update_mode_lines;
1151 current_buffer->prevent_redisplay_optimizations_p = 1;
1154 return flag;
1157 DEFUN ("restore-buffer-modified-p", Frestore_buffer_modified_p,
1158 Srestore_buffer_modified_p, 1, 1, 0,
1159 doc: /* Like `set-buffer-modified-p', with a difference concerning redisplay.
1160 It is not ensured that mode lines will be updated to show the modified
1161 state of the current buffer. Use with care. */)
1162 (flag)
1163 Lisp_Object flag;
1165 #ifdef CLASH_DETECTION
1166 Lisp_Object fn;
1168 /* If buffer becoming modified, lock the file.
1169 If buffer becoming unmodified, unlock the file. */
1171 fn = current_buffer->file_truename;
1172 /* Test buffer-file-name so that binding it to nil is effective. */
1173 if (!NILP (fn) && ! NILP (current_buffer->filename))
1175 int already = SAVE_MODIFF < MODIFF;
1176 if (!already && !NILP (flag))
1177 lock_file (fn);
1178 else if (already && NILP (flag))
1179 unlock_file (fn);
1181 #endif /* CLASH_DETECTION */
1183 SAVE_MODIFF = NILP (flag) ? MODIFF : 0;
1184 return flag;
1187 DEFUN ("buffer-modified-tick", Fbuffer_modified_tick, Sbuffer_modified_tick,
1188 0, 1, 0,
1189 doc: /* Return BUFFER's tick counter, incremented for each change in text.
1190 Each buffer has a tick counter which is incremented each time the
1191 text in that buffer is changed. It wraps around occasionally.
1192 No argument or nil as argument means use current buffer as BUFFER. */)
1193 (buffer)
1194 register Lisp_Object buffer;
1196 register struct buffer *buf;
1197 if (NILP (buffer))
1198 buf = current_buffer;
1199 else
1201 CHECK_BUFFER (buffer);
1202 buf = XBUFFER (buffer);
1205 return make_number (BUF_MODIFF (buf));
1208 DEFUN ("buffer-chars-modified-tick", Fbuffer_chars_modified_tick,
1209 Sbuffer_chars_modified_tick, 0, 1, 0,
1210 doc: /* Return BUFFER's character-change tick counter.
1211 Each buffer has a character-change tick counter, which is set to the
1212 value of the buffer's tick counter \(see `buffer-modified-tick'), each
1213 time text in that buffer is inserted or deleted. By comparing the
1214 values returned by two individual calls of `buffer-chars-modified-tick',
1215 you can tell whether a character change occurred in that buffer in
1216 between these calls. No argument or nil as argument means use current
1217 buffer as BUFFER. */)
1218 (buffer)
1219 register Lisp_Object buffer;
1221 register struct buffer *buf;
1222 if (NILP (buffer))
1223 buf = current_buffer;
1224 else
1226 CHECK_BUFFER (buffer);
1227 buf = XBUFFER (buffer);
1230 return make_number (BUF_CHARS_MODIFF (buf));
1233 DEFUN ("rename-buffer", Frename_buffer, Srename_buffer, 1, 2,
1234 "(list (read-string \"Rename buffer (to new name): \" \
1235 nil 'buffer-name-history (buffer-name (current-buffer))) \
1236 current-prefix-arg)",
1237 doc: /* Change current buffer's name to NEWNAME (a string).
1238 If second arg UNIQUE is nil or omitted, it is an error if a
1239 buffer named NEWNAME already exists.
1240 If UNIQUE is non-nil, come up with a new name using
1241 `generate-new-buffer-name'.
1242 Interactively, you can set UNIQUE with a prefix argument.
1243 We return the name we actually gave the buffer.
1244 This does not change the name of the visited file (if any). */)
1245 (newname, unique)
1246 register Lisp_Object newname, unique;
1248 register Lisp_Object tem, buf;
1250 CHECK_STRING (newname);
1252 if (SCHARS (newname) == 0)
1253 error ("Empty string is invalid as a buffer name");
1255 tem = Fget_buffer (newname);
1256 if (!NILP (tem))
1258 /* Don't short-circuit if UNIQUE is t. That is a useful way to
1259 rename the buffer automatically so you can create another
1260 with the original name. It makes UNIQUE equivalent to
1261 (rename-buffer (generate-new-buffer-name NEWNAME)). */
1262 if (NILP (unique) && XBUFFER (tem) == current_buffer)
1263 return current_buffer->name;
1264 if (!NILP (unique))
1265 newname = Fgenerate_new_buffer_name (newname, current_buffer->name);
1266 else
1267 error ("Buffer name `%s' is in use", SDATA (newname));
1270 current_buffer->name = newname;
1272 /* Catch redisplay's attention. Unless we do this, the mode lines for
1273 any windows displaying current_buffer will stay unchanged. */
1274 update_mode_lines++;
1276 XSETBUFFER (buf, current_buffer);
1277 Fsetcar (Frassq (buf, Vbuffer_alist), newname);
1278 if (NILP (current_buffer->filename)
1279 && !NILP (current_buffer->auto_save_file_name))
1280 call0 (intern ("rename-auto-save-file"));
1281 /* Refetch since that last call may have done GC. */
1282 return current_buffer->name;
1285 DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 3, 0,
1286 doc: /* Return most recently selected buffer other than BUFFER.
1287 Buffers not visible in windows are preferred to visible buffers,
1288 unless optional second argument VISIBLE-OK is non-nil.
1289 If the optional third argument FRAME is non-nil, use that frame's
1290 buffer list instead of the selected frame's buffer list.
1291 If no other buffer exists, the buffer `*scratch*' is returned.
1292 If BUFFER is omitted or nil, some interesting buffer is returned. */)
1293 (buffer, visible_ok, frame)
1294 register Lisp_Object buffer, visible_ok, frame;
1296 Lisp_Object Fset_buffer_major_mode ();
1297 register Lisp_Object tail, buf, notsogood, tem, pred, add_ons;
1298 notsogood = Qnil;
1300 if (NILP (frame))
1301 frame = selected_frame;
1303 tail = Vbuffer_alist;
1304 pred = frame_buffer_predicate (frame);
1306 /* Consider buffers that have been seen in the selected frame
1307 before other buffers. */
1309 tem = frame_buffer_list (frame);
1310 add_ons = Qnil;
1311 while (CONSP (tem))
1313 if (BUFFERP (XCAR (tem)))
1314 add_ons = Fcons (Fcons (Qnil, XCAR (tem)), add_ons);
1315 tem = XCDR (tem);
1317 tail = nconc2 (Fnreverse (add_ons), tail);
1319 for (; CONSP (tail); tail = XCDR (tail))
1321 buf = Fcdr (XCAR (tail));
1322 if (EQ (buf, buffer))
1323 continue;
1324 if (NILP (buf))
1325 continue;
1326 if (NILP (XBUFFER (buf)->name))
1327 continue;
1328 if (SREF (XBUFFER (buf)->name, 0) == ' ')
1329 continue;
1330 /* If the selected frame has a buffer_predicate,
1331 disregard buffers that don't fit the predicate. */
1332 if (!NILP (pred))
1334 tem = call1 (pred, buf);
1335 if (NILP (tem))
1336 continue;
1339 if (NILP (visible_ok))
1340 tem = Fget_buffer_window (buf, Qvisible);
1341 else
1342 tem = Qnil;
1343 if (NILP (tem))
1344 return buf;
1345 if (NILP (notsogood))
1346 notsogood = buf;
1348 if (!NILP (notsogood))
1349 return notsogood;
1350 buf = Fget_buffer (build_string ("*scratch*"));
1351 if (NILP (buf))
1353 buf = Fget_buffer_create (build_string ("*scratch*"));
1354 Fset_buffer_major_mode (buf);
1356 return buf;
1359 DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, Sbuffer_enable_undo,
1360 0, 1, "",
1361 doc: /* Start keeping undo information for buffer BUFFER.
1362 No argument or nil as argument means do this for the current buffer. */)
1363 (buffer)
1364 register Lisp_Object buffer;
1366 Lisp_Object real_buffer;
1368 if (NILP (buffer))
1369 XSETBUFFER (real_buffer, current_buffer);
1370 else
1372 real_buffer = Fget_buffer (buffer);
1373 if (NILP (real_buffer))
1374 nsberror (buffer);
1377 if (EQ (XBUFFER (real_buffer)->undo_list, Qt))
1378 XBUFFER (real_buffer)->undo_list = Qnil;
1380 return Qnil;
1384 DEFVAR_LISP ("kill-buffer-hook", no_cell, "\
1385 Hook to be run (by `run-hooks', which see) when a buffer is killed.\n\
1386 The buffer being killed will be current while the hook is running.\n\
1387 See `kill-buffer'."
1389 DEFUN ("kill-buffer", Fkill_buffer, Skill_buffer, 0, 1, "bKill buffer: ",
1390 doc: /* Kill buffer BUFFER-OR-NAME.
1391 The argument may be a buffer or the name of an existing buffer.
1392 Argument nil or omitted means kill the current buffer. Return t if the
1393 buffer is actually killed, nil otherwise.
1395 This function calls `replace-buffer-in-windows' for cleaning up all
1396 windows currently displaying the buffer to be killed. The functions in
1397 `kill-buffer-query-functions' are called with the buffer to be killed as
1398 the current buffer. If any of them returns nil, the buffer is not
1399 killed. The hook `kill-buffer-hook' is run before the buffer is
1400 actually killed. The buffer being killed will be current while the hook
1401 is running.
1403 Any processes that have this buffer as the `process-buffer' are killed
1404 with SIGHUP. */)
1405 (buffer_or_name)
1406 Lisp_Object buffer_or_name;
1408 Lisp_Object buffer;
1409 register struct buffer *b;
1410 register Lisp_Object tem;
1411 register struct Lisp_Marker *m;
1412 struct gcpro gcpro1;
1414 if (NILP (buffer_or_name))
1415 buffer = Fcurrent_buffer ();
1416 else
1417 buffer = Fget_buffer (buffer_or_name);
1418 if (NILP (buffer))
1419 nsberror (buffer_or_name);
1421 b = XBUFFER (buffer);
1423 /* Avoid trouble for buffer already dead. */
1424 if (NILP (b->name))
1425 return Qnil;
1427 /* Query if the buffer is still modified. */
1428 if (INTERACTIVE && !NILP (b->filename)
1429 && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b))
1431 GCPRO1 (buffer);
1432 tem = do_yes_or_no_p (format2 ("Buffer %s modified; kill anyway? ",
1433 b->name, make_number (0)));
1434 UNGCPRO;
1435 if (NILP (tem))
1436 return Qnil;
1439 /* Run hooks with the buffer to be killed the current buffer. */
1441 int count = SPECPDL_INDEX ();
1442 Lisp_Object arglist[1];
1444 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1445 set_buffer_internal (b);
1447 /* First run the query functions; if any query is answered no,
1448 don't kill the buffer. */
1449 arglist[0] = Qkill_buffer_query_functions;
1450 tem = Frun_hook_with_args_until_failure (1, arglist);
1451 if (NILP (tem))
1452 return unbind_to (count, Qnil);
1454 /* Then run the hooks. */
1455 Frun_hooks (1, &Qkill_buffer_hook);
1456 unbind_to (count, Qnil);
1459 /* We have no more questions to ask. Verify that it is valid
1460 to kill the buffer. This must be done after the questions
1461 since anything can happen within do_yes_or_no_p. */
1463 /* Don't kill the minibuffer now current. */
1464 if (EQ (buffer, XWINDOW (minibuf_window)->buffer))
1465 return Qnil;
1467 if (NILP (b->name))
1468 return Qnil;
1470 /* When we kill a base buffer, kill all its indirect buffers.
1471 We do it at this stage so nothing terrible happens if they
1472 ask questions or their hooks get errors. */
1473 if (! b->base_buffer)
1475 struct buffer *other;
1477 GCPRO1 (buffer);
1479 for (other = all_buffers; other; other = other->next)
1480 /* all_buffers contains dead buffers too;
1481 don't re-kill them. */
1482 if (other->base_buffer == b && !NILP (other->name))
1484 Lisp_Object buffer;
1485 XSETBUFFER (buffer, other);
1486 Fkill_buffer (buffer);
1489 UNGCPRO;
1492 /* Make this buffer not be current.
1493 In the process, notice if this is the sole visible buffer
1494 and give up if so. */
1495 if (b == current_buffer)
1497 tem = Fother_buffer (buffer, Qnil, Qnil);
1498 Fset_buffer (tem);
1499 if (b == current_buffer)
1500 return Qnil;
1503 /* Notice if the buffer to kill is the sole visible buffer
1504 when we're currently in the mini-buffer, and give up if so. */
1505 XSETBUFFER (tem, current_buffer);
1506 if (EQ (tem, XWINDOW (minibuf_window)->buffer))
1508 tem = Fother_buffer (buffer, Qnil, Qnil);
1509 if (EQ (buffer, tem))
1510 return Qnil;
1513 /* Now there is no question: we can kill the buffer. */
1515 #ifdef CLASH_DETECTION
1516 /* Unlock this buffer's file, if it is locked. */
1517 unlock_buffer (b);
1518 #endif /* CLASH_DETECTION */
1520 GCPRO1 (buffer);
1521 kill_buffer_processes (buffer);
1522 UNGCPRO;
1524 /* Killing buffer processes may run sentinels which may
1525 have called kill-buffer. */
1527 if (NILP (b->name))
1528 return Qnil;
1530 clear_charpos_cache (b);
1532 tem = Vinhibit_quit;
1533 Vinhibit_quit = Qt;
1534 replace_buffer_in_all_windows (buffer);
1535 Vbuffer_alist = Fdelq (Frassq (buffer, Vbuffer_alist), Vbuffer_alist);
1536 frames_discard_buffer (buffer);
1537 Vinhibit_quit = tem;
1539 /* Delete any auto-save file, if we saved it in this session.
1540 But not if the buffer is modified. */
1541 if (STRINGP (b->auto_save_file_name)
1542 && b->auto_save_modified != 0
1543 && BUF_SAVE_MODIFF (b) < b->auto_save_modified
1544 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
1545 && NILP (Fsymbol_value (intern ("auto-save-visited-file-name"))))
1547 Lisp_Object tem;
1548 tem = Fsymbol_value (intern ("delete-auto-save-files"));
1549 if (! NILP (tem))
1550 internal_delete_file (b->auto_save_file_name);
1553 if (b->base_buffer)
1555 /* Unchain all markers that belong to this indirect buffer.
1556 Don't unchain the markers that belong to the base buffer
1557 or its other indirect buffers. */
1558 for (m = BUF_MARKERS (b); m; )
1560 struct Lisp_Marker *next = m->next;
1561 if (m->buffer == b)
1562 unchain_marker (m);
1563 m = next;
1566 else
1568 /* Unchain all markers of this buffer and its indirect buffers.
1569 and leave them pointing nowhere. */
1570 for (m = BUF_MARKERS (b); m; )
1572 struct Lisp_Marker *next = m->next;
1573 m->buffer = 0;
1574 m->next = NULL;
1575 m = next;
1577 BUF_MARKERS (b) = NULL;
1578 BUF_INTERVALS (b) = NULL_INTERVAL;
1580 /* Perhaps we should explicitly free the interval tree here... */
1583 /* Reset the local variables, so that this buffer's local values
1584 won't be protected from GC. They would be protected
1585 if they happened to remain encached in their symbols.
1586 This gets rid of them for certain. */
1587 swap_out_buffer_local_variables (b);
1588 reset_buffer_local_variables (b, 1);
1590 b->name = Qnil;
1592 BLOCK_INPUT;
1593 if (! b->base_buffer)
1594 free_buffer_text (b);
1596 if (b->newline_cache)
1598 free_region_cache (b->newline_cache);
1599 b->newline_cache = 0;
1601 if (b->width_run_cache)
1603 free_region_cache (b->width_run_cache);
1604 b->width_run_cache = 0;
1606 b->width_table = Qnil;
1607 UNBLOCK_INPUT;
1608 b->undo_list = Qnil;
1610 return Qt;
1613 /* Move the assoc for buffer BUF to the front of buffer-alist. Since
1614 we do this each time BUF is selected visibly, the more recently
1615 selected buffers are always closer to the front of the list. This
1616 means that other_buffer is more likely to choose a relevant buffer. */
1618 void
1619 record_buffer (buf)
1620 Lisp_Object buf;
1622 register Lisp_Object link, prev;
1623 Lisp_Object frame;
1624 frame = selected_frame;
1626 prev = Qnil;
1627 for (link = Vbuffer_alist; CONSP (link); link = XCDR (link))
1629 if (EQ (XCDR (XCAR (link)), buf))
1630 break;
1631 prev = link;
1634 /* Effectively do Vbuffer_alist = Fdelq (link, Vbuffer_alist);
1635 we cannot use Fdelq itself here because it allows quitting. */
1637 if (NILP (prev))
1638 Vbuffer_alist = XCDR (Vbuffer_alist);
1639 else
1640 XSETCDR (prev, XCDR (XCDR (prev)));
1642 XSETCDR (link, Vbuffer_alist);
1643 Vbuffer_alist = link;
1645 /* Effectively do a delq on buried_buffer_list. */
1647 prev = Qnil;
1648 for (link = XFRAME (frame)->buried_buffer_list; CONSP (link);
1649 link = XCDR (link))
1651 if (EQ (XCAR (link), buf))
1653 if (NILP (prev))
1654 XFRAME (frame)->buried_buffer_list = XCDR (link);
1655 else
1656 XSETCDR (prev, XCDR (XCDR (prev)));
1657 break;
1659 prev = link;
1662 /* Now move this buffer to the front of frame_buffer_list also. */
1664 prev = Qnil;
1665 for (link = frame_buffer_list (frame); CONSP (link);
1666 link = XCDR (link))
1668 if (EQ (XCAR (link), buf))
1669 break;
1670 prev = link;
1673 /* Effectively do delq. */
1675 if (CONSP (link))
1677 if (NILP (prev))
1678 set_frame_buffer_list (frame,
1679 XCDR (frame_buffer_list (frame)));
1680 else
1681 XSETCDR (prev, XCDR (XCDR (prev)));
1683 XSETCDR (link, frame_buffer_list (frame));
1684 set_frame_buffer_list (frame, link);
1686 else
1687 set_frame_buffer_list (frame, Fcons (buf, frame_buffer_list (frame)));
1690 DEFUN ("set-buffer-major-mode", Fset_buffer_major_mode, Sset_buffer_major_mode, 1, 1, 0,
1691 doc: /* Set an appropriate major mode for BUFFER.
1692 For the *scratch* buffer, use `initial-major-mode', otherwise choose a mode
1693 according to `default-major-mode'.
1694 Use this function before selecting the buffer, since it may need to inspect
1695 the current buffer's major mode. */)
1696 (buffer)
1697 Lisp_Object buffer;
1699 int count;
1700 Lisp_Object function;
1702 CHECK_BUFFER (buffer);
1704 if (STRINGP (XBUFFER (buffer)->name)
1705 && strcmp (SDATA (XBUFFER (buffer)->name), "*scratch*") == 0)
1706 function = find_symbol_value (intern ("initial-major-mode"));
1707 else
1709 function = buffer_defaults.major_mode;
1710 if (NILP (function)
1711 && NILP (Fget (current_buffer->major_mode, Qmode_class)))
1712 function = current_buffer->major_mode;
1715 if (NILP (function) || EQ (function, Qfundamental_mode))
1716 return Qnil;
1718 count = SPECPDL_INDEX ();
1720 /* To select a nonfundamental mode,
1721 select the buffer temporarily and then call the mode function. */
1723 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1725 Fset_buffer (buffer);
1726 call0 (function);
1728 return unbind_to (count, Qnil);
1731 /* Switch to buffer BUFFER in the selected window.
1732 If NORECORD is non-nil, don't call record_buffer. */
1734 Lisp_Object
1735 switch_to_buffer_1 (buffer_or_name, norecord)
1736 Lisp_Object buffer_or_name, norecord;
1738 register Lisp_Object buffer;
1740 if (NILP (buffer_or_name))
1741 buffer = Fother_buffer (Fcurrent_buffer (), Qnil, Qnil);
1742 else
1744 buffer = Fget_buffer (buffer_or_name);
1745 if (NILP (buffer))
1747 buffer = Fget_buffer_create (buffer_or_name);
1748 Fset_buffer_major_mode (buffer);
1751 Fset_buffer (buffer);
1752 if (NILP (norecord))
1753 record_buffer (buffer);
1755 Fset_window_buffer (EQ (selected_window, minibuf_window)
1756 ? Fnext_window (minibuf_window, Qnil, Qnil)
1757 : selected_window,
1758 buffer, Qnil);
1760 return buffer;
1763 DEFUN ("switch-to-buffer", Fswitch_to_buffer, Sswitch_to_buffer, 1, 2,
1764 "(list (read-buffer-to-switch \"Switch to buffer: \"))",
1765 doc: /* Make BUFFER-OR-NAME current and display it in selected window.
1766 BUFFER-OR-NAME may be a buffer, a string \(a buffer name), or
1767 nil. Return the buffer switched to.
1769 If BUFFER-OR-NAME is a string and does not identify an existing
1770 buffer, create a new buffer with that name. Interactively, if
1771 `confirm-nonexistent-file-or-buffer' is non-nil, request
1772 confirmation before creating a new buffer. If BUFFER-OR-NAME is
1773 nil, switch to buffer returned by `other-buffer'.
1775 Optional second arg NORECORD non-nil means do not put this buffer
1776 at the front of the list of recently selected ones. This
1777 function returns the buffer it switched to as a Lisp object.
1779 If the selected window is the minibuffer window or dedicated to
1780 its buffer, use `pop-to-buffer' for displaying the buffer.
1782 WARNING: This is NOT the way to work on another buffer temporarily
1783 within a Lisp program! Use `set-buffer' instead. That avoids
1784 messing with the window-buffer correspondences. */)
1785 (buffer_or_name, norecord)
1786 Lisp_Object buffer_or_name, norecord;
1788 char *err;
1790 if (EQ (buffer_or_name, Fwindow_buffer (selected_window)))
1792 /* Basically a NOP. Avoid signalling an error in the case where
1793 the selected window is dedicated, or a minibuffer. */
1795 /* But do put this buffer at the front of the buffer list, unless
1796 that has been inhibited. Note that even if BUFFER-OR-NAME is
1797 at the front of the main buffer-list already, we still want to
1798 move it to the front of the frame's buffer list. */
1799 if (NILP (norecord))
1800 record_buffer (buffer_or_name);
1801 return Fset_buffer (buffer_or_name);
1803 else if (EQ (minibuf_window, selected_window)
1804 /* If `dedicated' is neither nil nor t, it means it's
1805 dedicatedness can be overridden by an explicit request
1806 such as a call to switch-to-buffer. */
1807 || EQ (Fwindow_dedicated_p (selected_window), Qt))
1808 /* We can't use the selected window so let `pop-to-buffer' try some
1809 other window. */
1810 return call3 (intern ("pop-to-buffer"), buffer_or_name, Qnil, norecord);
1811 else
1812 return switch_to_buffer_1 (buffer_or_name, norecord);
1815 DEFUN ("current-buffer", Fcurrent_buffer, Scurrent_buffer, 0, 0, 0,
1816 doc: /* Return the current buffer as a Lisp object. */)
1819 register Lisp_Object buf;
1820 XSETBUFFER (buf, current_buffer);
1821 return buf;
1824 /* Set the current buffer to B.
1826 We previously set windows_or_buffers_changed here to invalidate
1827 global unchanged information in beg_unchanged and end_unchanged.
1828 This is no longer necessary because we now compute unchanged
1829 information on a buffer-basis. Every action affecting other
1830 windows than the selected one requires a select_window at some
1831 time, and that increments windows_or_buffers_changed. */
1833 void
1834 set_buffer_internal (b)
1835 register struct buffer *b;
1837 if (current_buffer != b)
1838 set_buffer_internal_1 (b);
1841 /* Set the current buffer to B, and do not set windows_or_buffers_changed.
1842 This is used by redisplay. */
1844 void
1845 set_buffer_internal_1 (b)
1846 register struct buffer *b;
1848 register struct buffer *old_buf;
1849 register Lisp_Object tail, valcontents;
1850 Lisp_Object tem;
1852 #ifdef USE_MMAP_FOR_BUFFERS
1853 if (b->text->beg == NULL)
1854 enlarge_buffer_text (b, 0);
1855 #endif /* USE_MMAP_FOR_BUFFERS */
1857 if (current_buffer == b)
1858 return;
1860 old_buf = current_buffer;
1861 current_buffer = b;
1862 last_known_column_point = -1; /* invalidate indentation cache */
1864 if (old_buf)
1866 /* Put the undo list back in the base buffer, so that it appears
1867 that an indirect buffer shares the undo list of its base. */
1868 if (old_buf->base_buffer)
1869 old_buf->base_buffer->undo_list = old_buf->undo_list;
1871 /* If the old current buffer has markers to record PT, BEGV and ZV
1872 when it is not current, update them now. */
1873 if (! NILP (old_buf->pt_marker))
1875 Lisp_Object obuf;
1876 XSETBUFFER (obuf, old_buf);
1877 set_marker_both (old_buf->pt_marker, obuf,
1878 BUF_PT (old_buf), BUF_PT_BYTE (old_buf));
1880 if (! NILP (old_buf->begv_marker))
1882 Lisp_Object obuf;
1883 XSETBUFFER (obuf, old_buf);
1884 set_marker_both (old_buf->begv_marker, obuf,
1885 BUF_BEGV (old_buf), BUF_BEGV_BYTE (old_buf));
1887 if (! NILP (old_buf->zv_marker))
1889 Lisp_Object obuf;
1890 XSETBUFFER (obuf, old_buf);
1891 set_marker_both (old_buf->zv_marker, obuf,
1892 BUF_ZV (old_buf), BUF_ZV_BYTE (old_buf));
1896 /* Get the undo list from the base buffer, so that it appears
1897 that an indirect buffer shares the undo list of its base. */
1898 if (b->base_buffer)
1899 b->undo_list = b->base_buffer->undo_list;
1901 /* If the new current buffer has markers to record PT, BEGV and ZV
1902 when it is not current, fetch them now. */
1903 if (! NILP (b->pt_marker))
1905 BUF_PT (b) = marker_position (b->pt_marker);
1906 BUF_PT_BYTE (b) = marker_byte_position (b->pt_marker);
1908 if (! NILP (b->begv_marker))
1910 BUF_BEGV (b) = marker_position (b->begv_marker);
1911 BUF_BEGV_BYTE (b) = marker_byte_position (b->begv_marker);
1913 if (! NILP (b->zv_marker))
1915 BUF_ZV (b) = marker_position (b->zv_marker);
1916 BUF_ZV_BYTE (b) = marker_byte_position (b->zv_marker);
1919 /* Look down buffer's list of local Lisp variables
1920 to find and update any that forward into C variables. */
1922 for (tail = b->local_var_alist; CONSP (tail); tail = XCDR (tail))
1924 if (CONSP (XCAR (tail))
1925 && SYMBOLP (XCAR (XCAR (tail)))
1926 && (valcontents = SYMBOL_VALUE (XCAR (XCAR (tail))),
1927 (BUFFER_LOCAL_VALUEP (valcontents)))
1928 && (tem = XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
1929 (BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem))))
1930 /* Just reference the variable to cause it to become set for
1931 this buffer. */
1932 Fsymbol_value (XCAR (XCAR (tail)));
1935 /* Do the same with any others that were local to the previous buffer */
1937 if (old_buf)
1938 for (tail = old_buf->local_var_alist; CONSP (tail); tail = XCDR (tail))
1940 if (CONSP (tail)
1941 && SYMBOLP (XCAR (XCAR (tail)))
1942 && (valcontents = SYMBOL_VALUE (XCAR (XCAR (tail))),
1943 (BUFFER_LOCAL_VALUEP (valcontents)))
1944 && (tem = XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
1945 (BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem))))
1946 /* Just reference the variable to cause it to become set for
1947 this buffer. */
1948 Fsymbol_value (XCAR (XCAR (tail)));
1952 /* Switch to buffer B temporarily for redisplay purposes.
1953 This avoids certain things that don't need to be done within redisplay. */
1955 void
1956 set_buffer_temp (b)
1957 struct buffer *b;
1959 register struct buffer *old_buf;
1961 if (current_buffer == b)
1962 return;
1964 old_buf = current_buffer;
1965 current_buffer = b;
1967 if (old_buf)
1969 /* If the old current buffer has markers to record PT, BEGV and ZV
1970 when it is not current, update them now. */
1971 if (! NILP (old_buf->pt_marker))
1973 Lisp_Object obuf;
1974 XSETBUFFER (obuf, old_buf);
1975 set_marker_both (old_buf->pt_marker, obuf,
1976 BUF_PT (old_buf), BUF_PT_BYTE (old_buf));
1978 if (! NILP (old_buf->begv_marker))
1980 Lisp_Object obuf;
1981 XSETBUFFER (obuf, old_buf);
1982 set_marker_both (old_buf->begv_marker, obuf,
1983 BUF_BEGV (old_buf), BUF_BEGV_BYTE (old_buf));
1985 if (! NILP (old_buf->zv_marker))
1987 Lisp_Object obuf;
1988 XSETBUFFER (obuf, old_buf);
1989 set_marker_both (old_buf->zv_marker, obuf,
1990 BUF_ZV (old_buf), BUF_ZV_BYTE (old_buf));
1994 /* If the new current buffer has markers to record PT, BEGV and ZV
1995 when it is not current, fetch them now. */
1996 if (! NILP (b->pt_marker))
1998 BUF_PT (b) = marker_position (b->pt_marker);
1999 BUF_PT_BYTE (b) = marker_byte_position (b->pt_marker);
2001 if (! NILP (b->begv_marker))
2003 BUF_BEGV (b) = marker_position (b->begv_marker);
2004 BUF_BEGV_BYTE (b) = marker_byte_position (b->begv_marker);
2006 if (! NILP (b->zv_marker))
2008 BUF_ZV (b) = marker_position (b->zv_marker);
2009 BUF_ZV_BYTE (b) = marker_byte_position (b->zv_marker);
2013 DEFUN ("set-buffer", Fset_buffer, Sset_buffer, 1, 1, 0,
2014 doc: /* Make buffer BUFFER-OR-NAME current for editing operations.
2015 BUFFER-OR-NAME may be a buffer or the name of an existing buffer. See
2016 also `save-excursion' when you want to make a buffer current
2017 temporarily. This function does not display the buffer, so its effect
2018 ends when the current command terminates. Use `switch-to-buffer' or
2019 `pop-to-buffer' to switch buffers permanently. */)
2020 (buffer_or_name)
2021 register Lisp_Object buffer_or_name;
2023 register Lisp_Object buffer;
2024 buffer = Fget_buffer (buffer_or_name);
2025 if (NILP (buffer))
2026 nsberror (buffer_or_name);
2027 if (NILP (XBUFFER (buffer)->name))
2028 error ("Selecting deleted buffer");
2029 set_buffer_internal (XBUFFER (buffer));
2030 return buffer;
2033 /* Set the current buffer to BUFFER provided it is alive. */
2035 Lisp_Object
2036 set_buffer_if_live (buffer)
2037 Lisp_Object buffer;
2039 if (! NILP (XBUFFER (buffer)->name))
2040 Fset_buffer (buffer);
2041 return Qnil;
2044 DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only,
2045 Sbarf_if_buffer_read_only, 0, 0, 0,
2046 doc: /* Signal a `buffer-read-only' error if the current buffer is read-only. */)
2049 if (!NILP (current_buffer->read_only)
2050 && NILP (Vinhibit_read_only))
2051 xsignal1 (Qbuffer_read_only, Fcurrent_buffer ());
2052 return Qnil;
2055 DEFUN ("bury-buffer", Fbury_buffer, Sbury_buffer, 0, 1, "",
2056 doc: /* Put BUFFER-OR-NAME at the end of the list of all buffers.
2057 There it is the least likely candidate for `other-buffer' to return;
2058 thus, the least likely buffer for \\[switch-to-buffer] to select by
2059 default.
2061 The argument may be a buffer name or an actual buffer object. If
2062 BUFFER-OR-NAME is nil or omitted, bury the current buffer and remove it
2063 from the selected window if it is displayed there. If the selected
2064 window is dedicated to its buffer, delete that window if there are other
2065 windows on the same frame. If the selected window is the only window on
2066 its frame, iconify that frame. */)
2067 (buffer_or_name)
2068 register Lisp_Object buffer_or_name;
2070 Lisp_Object buffer;
2072 /* Figure out what buffer we're going to bury. */
2073 if (NILP (buffer_or_name))
2075 Lisp_Object tem;
2076 XSETBUFFER (buffer, current_buffer);
2078 tem = Fwindow_buffer (selected_window);
2079 /* If we're burying the current buffer, unshow it. */
2080 if (EQ (buffer, tem))
2082 if (NILP (Fwindow_dedicated_p (selected_window)))
2083 Fswitch_to_buffer (Fother_buffer (buffer, Qnil, Qnil), Qnil);
2084 else if (NILP (XWINDOW (selected_window)->parent))
2085 Ficonify_frame (Fwindow_frame (selected_window));
2086 else
2087 Fdelete_window (selected_window);
2090 else
2092 buffer = Fget_buffer (buffer_or_name);
2093 if (NILP (buffer))
2094 nsberror (buffer_or_name);
2097 /* Move buffer to the end of the buffer list. Do nothing if the
2098 buffer is killed. */
2099 if (!NILP (XBUFFER (buffer)->name))
2101 Lisp_Object aelt, link;
2103 aelt = Frassq (buffer, Vbuffer_alist);
2104 link = Fmemq (aelt, Vbuffer_alist);
2105 Vbuffer_alist = Fdelq (aelt, Vbuffer_alist);
2106 XSETCDR (link, Qnil);
2107 Vbuffer_alist = nconc2 (Vbuffer_alist, link);
2109 XFRAME (selected_frame)->buffer_list
2110 = Fdelq (buffer, XFRAME (selected_frame)->buffer_list);
2111 XFRAME (selected_frame)->buried_buffer_list
2112 = Fcons (buffer, Fdelq (buffer, XFRAME (selected_frame)->buried_buffer_list));
2115 return Qnil;
2118 DEFUN ("erase-buffer", Ferase_buffer, Serase_buffer, 0, 0, "*",
2119 doc: /* Delete the entire contents of the current buffer.
2120 Any narrowing restriction in effect (see `narrow-to-region') is removed,
2121 so the buffer is truly empty after this. */)
2124 Fwiden ();
2126 del_range (BEG, Z);
2128 current_buffer->last_window_start = 1;
2129 /* Prevent warnings, or suspension of auto saving, that would happen
2130 if future size is less than past size. Use of erase-buffer
2131 implies that the future text is not really related to the past text. */
2132 XSETFASTINT (current_buffer->save_length, 0);
2133 return Qnil;
2136 void
2137 validate_region (b, e)
2138 register Lisp_Object *b, *e;
2140 CHECK_NUMBER_COERCE_MARKER (*b);
2141 CHECK_NUMBER_COERCE_MARKER (*e);
2143 if (XINT (*b) > XINT (*e))
2145 Lisp_Object tem;
2146 tem = *b; *b = *e; *e = tem;
2149 if (!(BEGV <= XINT (*b) && XINT (*b) <= XINT (*e)
2150 && XINT (*e) <= ZV))
2151 args_out_of_range (*b, *e);
2154 /* Advance BYTE_POS up to a character boundary
2155 and return the adjusted position. */
2157 static int
2158 advance_to_char_boundary (byte_pos)
2159 int byte_pos;
2161 int c;
2163 if (byte_pos == BEG)
2164 /* Beginning of buffer is always a character boundary. */
2165 return BEG;
2167 c = FETCH_BYTE (byte_pos);
2168 if (! CHAR_HEAD_P (c))
2170 /* We should advance BYTE_POS only when C is a constituent of a
2171 multibyte sequence. */
2172 int orig_byte_pos = byte_pos;
2176 byte_pos--;
2177 c = FETCH_BYTE (byte_pos);
2179 while (! CHAR_HEAD_P (c) && byte_pos > BEG);
2180 INC_POS (byte_pos);
2181 if (byte_pos < orig_byte_pos)
2182 byte_pos = orig_byte_pos;
2183 /* If C is a constituent of a multibyte sequence, BYTE_POS was
2184 surely advance to the correct character boundary. If C is
2185 not, BYTE_POS was unchanged. */
2188 return byte_pos;
2191 #ifdef REL_ALLOC
2192 extern void r_alloc_reset_variable P_ ((POINTER_TYPE *, POINTER_TYPE *));
2193 #endif /* REL_ALLOC */
2195 DEFUN ("buffer-swap-text", Fbuffer_swap_text, Sbuffer_swap_text,
2196 1, 1, 0,
2197 doc: /* Swap the text between current buffer and BUFFER. */)
2198 (buffer)
2199 Lisp_Object buffer;
2201 struct buffer *other_buffer;
2202 CHECK_BUFFER (buffer);
2203 other_buffer = XBUFFER (buffer);
2205 if (NILP (other_buffer->name))
2206 error ("Cannot swap a dead buffer's text");
2208 /* Actually, it probably works just fine.
2209 * if (other_buffer == current_buffer)
2210 * error ("Cannot swap a buffer's text with itself"); */
2212 /* Actually, this may be workable as well, tho probably only if they're
2213 *both* indirect. */
2214 if (other_buffer->base_buffer
2215 || current_buffer->base_buffer)
2216 error ("Cannot swap indirect buffers's text");
2218 { /* This is probably harder to make work. */
2219 struct buffer *other;
2220 for (other = all_buffers; other; other = other->next)
2221 if (other->base_buffer == other_buffer
2222 || other->base_buffer == current_buffer)
2223 error ("One of the buffers to swap has indirect buffers");
2226 #define swapfield(field, type) \
2227 do { \
2228 type tmp##field = other_buffer->field; \
2229 other_buffer->field = current_buffer->field; \
2230 current_buffer->field = tmp##field; \
2231 } while (0)
2233 swapfield (own_text, struct buffer_text);
2234 eassert (current_buffer->text == &current_buffer->own_text);
2235 eassert (other_buffer->text == &other_buffer->own_text);
2236 #ifdef REL_ALLOC
2237 r_alloc_reset_variable ((POINTER_TYPE **) &current_buffer->own_text.beg,
2238 (POINTER_TYPE **) &other_buffer->own_text.beg);
2239 r_alloc_reset_variable ((POINTER_TYPE **) &other_buffer->own_text.beg,
2240 (POINTER_TYPE **) &current_buffer->own_text.beg);
2241 #endif /* REL_ALLOC */
2243 swapfield (pt, EMACS_INT);
2244 swapfield (pt_byte, EMACS_INT);
2245 swapfield (begv, EMACS_INT);
2246 swapfield (begv_byte, EMACS_INT);
2247 swapfield (zv, EMACS_INT);
2248 swapfield (zv_byte, EMACS_INT);
2249 eassert (!current_buffer->base_buffer);
2250 eassert (!other_buffer->base_buffer);
2251 current_buffer->clip_changed = 1; other_buffer->clip_changed = 1;
2252 swapfield (newline_cache, struct region_cache *);
2253 swapfield (width_run_cache, struct region_cache *);
2254 current_buffer->prevent_redisplay_optimizations_p = 1;
2255 other_buffer->prevent_redisplay_optimizations_p = 1;
2256 swapfield (overlays_before, struct Lisp_Overlay *);
2257 swapfield (overlays_after, struct Lisp_Overlay *);
2258 swapfield (overlay_center, EMACS_INT);
2259 swapfield (undo_list, Lisp_Object);
2260 swapfield (mark, Lisp_Object);
2261 swapfield (enable_multibyte_characters, Lisp_Object);
2262 /* FIXME: Not sure what we should do with these *_marker fields.
2263 Hopefully they're just nil anyway. */
2264 swapfield (pt_marker, Lisp_Object);
2265 swapfield (begv_marker, Lisp_Object);
2266 swapfield (zv_marker, Lisp_Object);
2267 current_buffer->point_before_scroll = Qnil;
2268 other_buffer->point_before_scroll = Qnil;
2270 current_buffer->text->modiff++; other_buffer->text->modiff++;
2271 current_buffer->text->chars_modiff++; other_buffer->text->chars_modiff++;
2272 current_buffer->text->overlay_modiff++; other_buffer->text->overlay_modiff++;
2273 current_buffer->text->beg_unchanged = current_buffer->text->gpt;
2274 current_buffer->text->end_unchanged = current_buffer->text->gpt;
2275 other_buffer->text->beg_unchanged = other_buffer->text->gpt;
2276 other_buffer->text->end_unchanged = other_buffer->text->gpt;
2278 struct Lisp_Marker *m;
2279 for (m = BUF_MARKERS (current_buffer); m; m = m->next)
2280 if (m->buffer == other_buffer)
2281 m->buffer = current_buffer;
2282 else
2283 /* Since there's no indirect buffer in sight, markers on
2284 BUF_MARKERS(buf) should either be for `buf' or dead. */
2285 eassert (!m->buffer);
2286 for (m = BUF_MARKERS (other_buffer); m; m = m->next)
2287 if (m->buffer == current_buffer)
2288 m->buffer = other_buffer;
2289 else
2290 /* Since there's no indirect buffer in sight, markers on
2291 BUF_MARKERS(buf) should either be for `buf' or dead. */
2292 eassert (!m->buffer);
2294 { /* Some of the C code expects that w->buffer == w->pointm->buffer.
2295 So since we just swapped the markers between the two buffers, we need
2296 to undo the effect of this swap for window markers. */
2297 Lisp_Object w = Fselected_window (), ws = Qnil;
2298 Lisp_Object buf1, buf2;
2299 XSETBUFFER (buf1, current_buffer); XSETBUFFER (buf2, other_buffer);
2301 while (NILP (Fmemq (w, ws)))
2303 ws = Fcons (w, ws);
2304 if (MARKERP (XWINDOW (w)->pointm)
2305 && (EQ (XWINDOW (w)->buffer, buf1)
2306 || EQ (XWINDOW (w)->buffer, buf2)))
2307 Fset_marker (XWINDOW (w)->pointm,
2308 make_number (BUF_BEGV (XBUFFER (XWINDOW (w)->buffer))),
2309 XWINDOW (w)->buffer);
2310 w = Fnext_window (w, Qt, Qt);
2314 if (current_buffer->text->intervals)
2315 (eassert (EQ (current_buffer->text->intervals->up.obj, buffer)),
2316 XSETBUFFER (current_buffer->text->intervals->up.obj, current_buffer));
2317 if (other_buffer->text->intervals)
2318 (eassert (EQ (other_buffer->text->intervals->up.obj, Fcurrent_buffer ())),
2319 XSETBUFFER (other_buffer->text->intervals->up.obj, other_buffer));
2321 return Qnil;
2324 DEFUN ("set-buffer-multibyte", Fset_buffer_multibyte, Sset_buffer_multibyte,
2325 1, 1, 0,
2326 doc: /* Set the multibyte flag of the current buffer to FLAG.
2327 If FLAG is t, this makes the buffer a multibyte buffer.
2328 If FLAG is nil, this makes the buffer a single-byte buffer.
2329 In these cases, the buffer contents remain unchanged as a sequence of
2330 bytes but the contents viewed as characters do change.
2331 If FLAG is `to', this makes the buffer a multibyte buffer by changing
2332 all eight-bit bytes to eight-bit characters.
2333 If the multibyte flag was really changed, undo information of the
2334 current buffer is cleared. */)
2335 (flag)
2336 Lisp_Object flag;
2338 struct Lisp_Marker *tail, *markers;
2339 struct buffer *other;
2340 int begv, zv;
2341 int narrowed = (BEG != BEGV || Z != ZV);
2342 int modified_p = !NILP (Fbuffer_modified_p (Qnil));
2343 Lisp_Object old_undo = current_buffer->undo_list;
2344 struct gcpro gcpro1;
2346 if (current_buffer->base_buffer)
2347 error ("Cannot do `set-buffer-multibyte' on an indirect buffer");
2349 /* Do nothing if nothing actually changes. */
2350 if (NILP (flag) == NILP (current_buffer->enable_multibyte_characters))
2351 return flag;
2353 GCPRO1 (old_undo);
2355 /* Don't record these buffer changes. We will put a special undo entry
2356 instead. */
2357 current_buffer->undo_list = Qt;
2359 /* If the cached position is for this buffer, clear it out. */
2360 clear_charpos_cache (current_buffer);
2362 if (NILP (flag))
2363 begv = BEGV_BYTE, zv = ZV_BYTE;
2364 else
2365 begv = BEGV, zv = ZV;
2367 if (narrowed)
2368 Fwiden ();
2370 if (NILP (flag))
2372 int pos, stop;
2373 unsigned char *p;
2375 /* Do this first, so it can use CHAR_TO_BYTE
2376 to calculate the old correspondences. */
2377 set_intervals_multibyte (0);
2379 current_buffer->enable_multibyte_characters = Qnil;
2381 Z = Z_BYTE;
2382 BEGV = BEGV_BYTE;
2383 ZV = ZV_BYTE;
2384 GPT = GPT_BYTE;
2385 TEMP_SET_PT_BOTH (PT_BYTE, PT_BYTE);
2388 for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
2389 tail->charpos = tail->bytepos;
2391 /* Convert multibyte form of 8-bit characters to unibyte. */
2392 pos = BEG;
2393 stop = GPT;
2394 p = BEG_ADDR;
2395 while (1)
2397 int c, bytes;
2399 if (pos == stop)
2401 if (pos == Z)
2402 break;
2403 p = GAP_END_ADDR;
2404 stop = Z;
2406 if (ASCII_BYTE_P (*p))
2407 p++, pos++;
2408 else if (CHAR_BYTE8_HEAD_P (*p))
2410 c = STRING_CHAR_AND_LENGTH (p, stop - pos, bytes);
2411 /* Delete all bytes for this 8-bit character but the
2412 last one, and change the last one to the charcter
2413 code. */
2414 bytes--;
2415 del_range_2 (pos, pos, pos + bytes, pos + bytes, 0);
2416 p = GAP_END_ADDR;
2417 *p++ = c;
2418 pos++;
2419 if (begv > pos)
2420 begv -= bytes;
2421 if (zv > pos)
2422 zv -= bytes;
2423 stop = Z;
2425 else
2427 bytes = BYTES_BY_CHAR_HEAD (*p);
2428 p += bytes, pos += bytes;
2431 if (narrowed)
2432 Fnarrow_to_region (make_number (begv), make_number (zv));
2434 else
2436 int pt = PT;
2437 int pos, stop;
2438 unsigned char *p, *pend;
2440 /* Be sure not to have a multibyte sequence striding over the GAP.
2441 Ex: We change this: "...abc\302 _GAP_ \241def..."
2442 to: "...abc _GAP_ \302\241def..." */
2444 if (EQ (flag, Qt)
2445 && GPT_BYTE > 1 && GPT_BYTE < Z_BYTE
2446 && ! CHAR_HEAD_P (*(GAP_END_ADDR)))
2448 unsigned char *p = GPT_ADDR - 1;
2450 while (! CHAR_HEAD_P (*p) && p > BEG_ADDR) p--;
2451 if (BASE_LEADING_CODE_P (*p))
2453 int new_gpt = GPT_BYTE - (GPT_ADDR - p);
2455 move_gap_both (new_gpt, new_gpt);
2459 /* Make the buffer contents valid as multibyte by converting
2460 8-bit characters to multibyte form. */
2461 pos = BEG;
2462 stop = GPT;
2463 p = BEG_ADDR;
2464 pend = GPT_ADDR;
2465 while (1)
2467 int bytes;
2469 if (pos == stop)
2471 if (pos == Z)
2472 break;
2473 p = GAP_END_ADDR;
2474 pend = Z_ADDR;
2475 stop = Z;
2478 if (ASCII_BYTE_P (*p))
2479 p++, pos++;
2480 else if (EQ (flag, Qt) && (bytes = MULTIBYTE_LENGTH (p, pend)) > 0)
2481 p += bytes, pos += bytes;
2482 else
2484 unsigned char tmp[MAX_MULTIBYTE_LENGTH];
2485 int c;
2487 c = BYTE8_TO_CHAR (*p);
2488 bytes = CHAR_STRING (c, tmp);
2489 *p = tmp[0];
2490 TEMP_SET_PT_BOTH (pos + 1, pos + 1);
2491 bytes--;
2492 insert_1_both (tmp + 1, bytes, bytes, 1, 0, 0);
2493 /* Now the gap is after the just inserted data. */
2494 pos = GPT;
2495 p = GAP_END_ADDR;
2496 if (pos <= begv)
2497 begv += bytes;
2498 if (pos <= zv)
2499 zv += bytes;
2500 if (pos <= pt)
2501 pt += bytes;
2502 pend = Z_ADDR;
2503 stop = Z;
2507 if (pt != PT)
2508 TEMP_SET_PT (pt);
2510 if (narrowed)
2511 Fnarrow_to_region (make_number (begv), make_number (zv));
2513 /* Do this first, so that chars_in_text asks the right question.
2514 set_intervals_multibyte needs it too. */
2515 current_buffer->enable_multibyte_characters = Qt;
2517 GPT_BYTE = advance_to_char_boundary (GPT_BYTE);
2518 GPT = chars_in_text (BEG_ADDR, GPT_BYTE - BEG_BYTE) + BEG;
2520 Z = chars_in_text (GAP_END_ADDR, Z_BYTE - GPT_BYTE) + GPT;
2522 BEGV_BYTE = advance_to_char_boundary (BEGV_BYTE);
2523 if (BEGV_BYTE > GPT_BYTE)
2524 BEGV = chars_in_text (GAP_END_ADDR, BEGV_BYTE - GPT_BYTE) + GPT;
2525 else
2526 BEGV = chars_in_text (BEG_ADDR, BEGV_BYTE - BEG_BYTE) + BEG;
2528 ZV_BYTE = advance_to_char_boundary (ZV_BYTE);
2529 if (ZV_BYTE > GPT_BYTE)
2530 ZV = chars_in_text (GAP_END_ADDR, ZV_BYTE - GPT_BYTE) + GPT;
2531 else
2532 ZV = chars_in_text (BEG_ADDR, ZV_BYTE - BEG_BYTE) + BEG;
2535 int pt_byte = advance_to_char_boundary (PT_BYTE);
2536 int pt;
2538 if (pt_byte > GPT_BYTE)
2539 pt = chars_in_text (GAP_END_ADDR, pt_byte - GPT_BYTE) + GPT;
2540 else
2541 pt = chars_in_text (BEG_ADDR, pt_byte - BEG_BYTE) + BEG;
2542 TEMP_SET_PT_BOTH (pt, pt_byte);
2545 tail = markers = BUF_MARKERS (current_buffer);
2547 /* This prevents BYTE_TO_CHAR (that is, buf_bytepos_to_charpos) from
2548 getting confused by the markers that have not yet been updated.
2549 It is also a signal that it should never create a marker. */
2550 BUF_MARKERS (current_buffer) = NULL;
2552 for (; tail; tail = tail->next)
2554 tail->bytepos = advance_to_char_boundary (tail->bytepos);
2555 tail->charpos = BYTE_TO_CHAR (tail->bytepos);
2558 /* Make sure no markers were put on the chain
2559 while the chain value was incorrect. */
2560 if (BUF_MARKERS (current_buffer))
2561 abort ();
2563 BUF_MARKERS (current_buffer) = markers;
2565 /* Do this last, so it can calculate the new correspondences
2566 between chars and bytes. */
2567 set_intervals_multibyte (1);
2570 if (!EQ (old_undo, Qt))
2572 /* Represent all the above changes by a special undo entry. */
2573 extern Lisp_Object Qapply;
2574 current_buffer->undo_list = Fcons (list3 (Qapply,
2575 intern ("set-buffer-multibyte"),
2576 NILP (flag) ? Qt : Qnil),
2577 old_undo);
2580 UNGCPRO;
2582 /* Changing the multibyteness of a buffer means that all windows
2583 showing that buffer must be updated thoroughly. */
2584 current_buffer->prevent_redisplay_optimizations_p = 1;
2585 ++windows_or_buffers_changed;
2587 /* Copy this buffer's new multibyte status
2588 into all of its indirect buffers. */
2589 for (other = all_buffers; other; other = other->next)
2590 if (other->base_buffer == current_buffer && !NILP (other->name))
2592 other->enable_multibyte_characters
2593 = current_buffer->enable_multibyte_characters;
2594 other->prevent_redisplay_optimizations_p = 1;
2597 /* Restore the modifiedness of the buffer. */
2598 if (!modified_p && !NILP (Fbuffer_modified_p (Qnil)))
2599 Fset_buffer_modified_p (Qnil);
2601 #ifdef subprocesses
2602 /* Update coding systems of this buffer's process (if any). */
2604 Lisp_Object process;
2606 process = Fget_buffer_process (Fcurrent_buffer ());
2607 if (PROCESSP (process))
2608 setup_process_coding_systems (process);
2610 #endif /* subprocesses */
2612 return flag;
2615 DEFUN ("kill-all-local-variables", Fkill_all_local_variables, Skill_all_local_variables,
2616 0, 0, 0,
2617 doc: /* Switch to Fundamental mode by killing current buffer's local variables.
2618 Most local variable bindings are eliminated so that the default values
2619 become effective once more. Also, the syntax table is set from
2620 `standard-syntax-table', the local keymap is set to nil,
2621 and the abbrev table from `fundamental-mode-abbrev-table'.
2622 This function also forces redisplay of the mode line.
2624 Every function to select a new major mode starts by
2625 calling this function.
2627 As a special exception, local variables whose names have
2628 a non-nil `permanent-local' property are not eliminated by this function.
2630 The first thing this function does is run
2631 the normal hook `change-major-mode-hook'. */)
2634 if (!NILP (Vrun_hooks))
2635 call1 (Vrun_hooks, Qchange_major_mode_hook);
2637 /* Make sure none of the bindings in local_var_alist
2638 remain swapped in, in their symbols. */
2640 swap_out_buffer_local_variables (current_buffer);
2642 /* Actually eliminate all local bindings of this buffer. */
2644 reset_buffer_local_variables (current_buffer, 0);
2646 /* Force mode-line redisplay. Useful here because all major mode
2647 commands call this function. */
2648 update_mode_lines++;
2650 return Qnil;
2653 /* Make sure no local variables remain set up with buffer B
2654 for their current values. */
2656 static void
2657 swap_out_buffer_local_variables (b)
2658 struct buffer *b;
2660 Lisp_Object oalist, alist, sym, buffer;
2662 XSETBUFFER (buffer, b);
2663 oalist = b->local_var_alist;
2665 for (alist = oalist; CONSP (alist); alist = XCDR (alist))
2667 if (CONSP (XCAR (alist))
2668 && (sym = XCAR (XCAR (alist)), SYMBOLP (sym))
2669 /* Need not do anything if some other buffer's binding is
2670 now encached. */
2671 && EQ (XBUFFER_LOCAL_VALUE (SYMBOL_VALUE (sym))->buffer,
2672 buffer))
2674 /* Symbol is set up for this buffer's old local value:
2675 swap it out! */
2676 swap_in_global_binding (sym);
2681 /* Find all the overlays in the current buffer that contain position POS.
2682 Return the number found, and store them in a vector in *VEC_PTR.
2683 Store in *LEN_PTR the size allocated for the vector.
2684 Store in *NEXT_PTR the next position after POS where an overlay starts,
2685 or ZV if there are no more overlays between POS and ZV.
2686 Store in *PREV_PTR the previous position before POS where an overlay ends,
2687 or where an overlay starts which ends at or after POS;
2688 or BEGV if there are no such overlays from BEGV to POS.
2689 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
2691 *VEC_PTR and *LEN_PTR should contain a valid vector and size
2692 when this function is called.
2694 If EXTEND is non-zero, we make the vector bigger if necessary.
2695 If EXTEND is zero, we never extend the vector,
2696 and we store only as many overlays as will fit.
2697 But we still return the total number of overlays.
2699 If CHANGE_REQ is true, then any position written into *PREV_PTR or
2700 *NEXT_PTR is guaranteed to be not equal to POS, unless it is the
2701 default (BEGV or ZV). */
2704 overlays_at (pos, extend, vec_ptr, len_ptr, next_ptr, prev_ptr, change_req)
2705 EMACS_INT pos;
2706 int extend;
2707 Lisp_Object **vec_ptr;
2708 int *len_ptr;
2709 EMACS_INT *next_ptr;
2710 EMACS_INT *prev_ptr;
2711 int change_req;
2713 Lisp_Object overlay, start, end;
2714 struct Lisp_Overlay *tail;
2715 int idx = 0;
2716 int len = *len_ptr;
2717 Lisp_Object *vec = *vec_ptr;
2718 int next = ZV;
2719 int prev = BEGV;
2720 int inhibit_storing = 0;
2722 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
2724 int startpos, endpos;
2726 XSETMISC (overlay, tail);
2728 start = OVERLAY_START (overlay);
2729 end = OVERLAY_END (overlay);
2730 endpos = OVERLAY_POSITION (end);
2731 if (endpos < pos)
2733 if (prev < endpos)
2734 prev = endpos;
2735 break;
2737 startpos = OVERLAY_POSITION (start);
2738 /* This one ends at or after POS
2739 so its start counts for PREV_PTR if it's before POS. */
2740 if (prev < startpos && startpos < pos)
2741 prev = startpos;
2742 if (endpos == pos)
2743 continue;
2744 if (startpos <= pos)
2746 if (idx == len)
2748 /* The supplied vector is full.
2749 Either make it bigger, or don't store any more in it. */
2750 if (extend)
2752 /* Make it work with an initial len == 0. */
2753 len *= 2;
2754 if (len == 0)
2755 len = 4;
2756 *len_ptr = len;
2757 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2758 *vec_ptr = vec;
2760 else
2761 inhibit_storing = 1;
2764 if (!inhibit_storing)
2765 vec[idx] = overlay;
2766 /* Keep counting overlays even if we can't return them all. */
2767 idx++;
2769 else if (startpos < next)
2770 next = startpos;
2773 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
2775 int startpos, endpos;
2777 XSETMISC (overlay, tail);
2779 start = OVERLAY_START (overlay);
2780 end = OVERLAY_END (overlay);
2781 startpos = OVERLAY_POSITION (start);
2782 if (pos < startpos)
2784 if (startpos < next)
2785 next = startpos;
2786 break;
2788 endpos = OVERLAY_POSITION (end);
2789 if (pos < endpos)
2791 if (idx == len)
2793 if (extend)
2795 /* Make it work with an initial len == 0. */
2796 len *= 2;
2797 if (len == 0)
2798 len = 4;
2799 *len_ptr = len;
2800 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2801 *vec_ptr = vec;
2803 else
2804 inhibit_storing = 1;
2807 if (!inhibit_storing)
2808 vec[idx] = overlay;
2809 idx++;
2811 if (startpos < pos && startpos > prev)
2812 prev = startpos;
2814 else if (endpos < pos && endpos > prev)
2815 prev = endpos;
2816 else if (endpos == pos && startpos > prev
2817 && (!change_req || startpos < pos))
2818 prev = startpos;
2821 if (next_ptr)
2822 *next_ptr = next;
2823 if (prev_ptr)
2824 *prev_ptr = prev;
2825 return idx;
2828 /* Find all the overlays in the current buffer that overlap the range
2829 BEG-END, or are empty at BEG, or are empty at END provided END
2830 denotes the position at the end of the current buffer.
2832 Return the number found, and store them in a vector in *VEC_PTR.
2833 Store in *LEN_PTR the size allocated for the vector.
2834 Store in *NEXT_PTR the next position after POS where an overlay starts,
2835 or ZV if there are no more overlays.
2836 Store in *PREV_PTR the previous position before POS where an overlay ends,
2837 or BEGV if there are no previous overlays.
2838 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
2840 *VEC_PTR and *LEN_PTR should contain a valid vector and size
2841 when this function is called.
2843 If EXTEND is non-zero, we make the vector bigger if necessary.
2844 If EXTEND is zero, we never extend the vector,
2845 and we store only as many overlays as will fit.
2846 But we still return the total number of overlays. */
2848 static int
2849 overlays_in (beg, end, extend, vec_ptr, len_ptr, next_ptr, prev_ptr)
2850 int beg, end;
2851 int extend;
2852 Lisp_Object **vec_ptr;
2853 int *len_ptr;
2854 int *next_ptr;
2855 int *prev_ptr;
2857 Lisp_Object overlay, ostart, oend;
2858 struct Lisp_Overlay *tail;
2859 int idx = 0;
2860 int len = *len_ptr;
2861 Lisp_Object *vec = *vec_ptr;
2862 int next = ZV;
2863 int prev = BEGV;
2864 int inhibit_storing = 0;
2865 int end_is_Z = end == Z;
2867 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
2869 int startpos, endpos;
2871 XSETMISC (overlay, tail);
2873 ostart = OVERLAY_START (overlay);
2874 oend = OVERLAY_END (overlay);
2875 endpos = OVERLAY_POSITION (oend);
2876 if (endpos < beg)
2878 if (prev < endpos)
2879 prev = endpos;
2880 break;
2882 startpos = OVERLAY_POSITION (ostart);
2883 /* Count an interval if it overlaps the range, is empty at the
2884 start of the range, or is empty at END provided END denotes the
2885 end of the buffer. */
2886 if ((beg < endpos && startpos < end)
2887 || (startpos == endpos
2888 && (beg == endpos || (end_is_Z && endpos == end))))
2890 if (idx == len)
2892 /* The supplied vector is full.
2893 Either make it bigger, or don't store any more in it. */
2894 if (extend)
2896 /* Make it work with an initial len == 0. */
2897 len *= 2;
2898 if (len == 0)
2899 len = 4;
2900 *len_ptr = len;
2901 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2902 *vec_ptr = vec;
2904 else
2905 inhibit_storing = 1;
2908 if (!inhibit_storing)
2909 vec[idx] = overlay;
2910 /* Keep counting overlays even if we can't return them all. */
2911 idx++;
2913 else if (startpos < next)
2914 next = startpos;
2917 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
2919 int startpos, endpos;
2921 XSETMISC (overlay, tail);
2923 ostart = OVERLAY_START (overlay);
2924 oend = OVERLAY_END (overlay);
2925 startpos = OVERLAY_POSITION (ostart);
2926 if (end < startpos)
2928 if (startpos < next)
2929 next = startpos;
2930 break;
2932 endpos = OVERLAY_POSITION (oend);
2933 /* Count an interval if it overlaps the range, is empty at the
2934 start of the range, or is empty at END provided END denotes the
2935 end of the buffer. */
2936 if ((beg < endpos && startpos < end)
2937 || (startpos == endpos
2938 && (beg == endpos || (end_is_Z && endpos == end))))
2940 if (idx == len)
2942 if (extend)
2944 /* Make it work with an initial len == 0. */
2945 len *= 2;
2946 if (len == 0)
2947 len = 4;
2948 *len_ptr = len;
2949 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2950 *vec_ptr = vec;
2952 else
2953 inhibit_storing = 1;
2956 if (!inhibit_storing)
2957 vec[idx] = overlay;
2958 idx++;
2960 else if (endpos < beg && endpos > prev)
2961 prev = endpos;
2964 if (next_ptr)
2965 *next_ptr = next;
2966 if (prev_ptr)
2967 *prev_ptr = prev;
2968 return idx;
2972 /* Return non-zero if there exists an overlay with a non-nil
2973 `mouse-face' property overlapping OVERLAY. */
2976 mouse_face_overlay_overlaps (overlay)
2977 Lisp_Object overlay;
2979 int start = OVERLAY_POSITION (OVERLAY_START (overlay));
2980 int end = OVERLAY_POSITION (OVERLAY_END (overlay));
2981 int n, i, size;
2982 Lisp_Object *v, tem;
2984 size = 10;
2985 v = (Lisp_Object *) alloca (size * sizeof *v);
2986 n = overlays_in (start, end, 0, &v, &size, NULL, NULL);
2987 if (n > size)
2989 v = (Lisp_Object *) alloca (n * sizeof *v);
2990 overlays_in (start, end, 0, &v, &n, NULL, NULL);
2993 for (i = 0; i < n; ++i)
2994 if (!EQ (v[i], overlay)
2995 && (tem = Foverlay_get (overlay, Qmouse_face),
2996 !NILP (tem)))
2997 break;
2999 return i < n;
3004 /* Fast function to just test if we're at an overlay boundary. */
3006 overlay_touches_p (pos)
3007 int pos;
3009 Lisp_Object overlay;
3010 struct Lisp_Overlay *tail;
3012 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
3014 int endpos;
3016 XSETMISC (overlay ,tail);
3017 if (!OVERLAYP (overlay))
3018 abort ();
3020 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3021 if (endpos < pos)
3022 break;
3023 if (endpos == pos || OVERLAY_POSITION (OVERLAY_START (overlay)) == pos)
3024 return 1;
3027 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
3029 int startpos;
3031 XSETMISC (overlay, tail);
3032 if (!OVERLAYP (overlay))
3033 abort ();
3035 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3036 if (pos < startpos)
3037 break;
3038 if (startpos == pos || OVERLAY_POSITION (OVERLAY_END (overlay)) == pos)
3039 return 1;
3041 return 0;
3044 struct sortvec
3046 Lisp_Object overlay;
3047 int beg, end;
3048 int priority;
3051 static int
3052 compare_overlays (v1, v2)
3053 const void *v1, *v2;
3055 const struct sortvec *s1 = (const struct sortvec *) v1;
3056 const struct sortvec *s2 = (const struct sortvec *) v2;
3057 if (s1->priority != s2->priority)
3058 return s1->priority - s2->priority;
3059 if (s1->beg != s2->beg)
3060 return s1->beg - s2->beg;
3061 if (s1->end != s2->end)
3062 return s2->end - s1->end;
3063 return 0;
3066 /* Sort an array of overlays by priority. The array is modified in place.
3067 The return value is the new size; this may be smaller than the original
3068 size if some of the overlays were invalid or were window-specific. */
3070 sort_overlays (overlay_vec, noverlays, w)
3071 Lisp_Object *overlay_vec;
3072 int noverlays;
3073 struct window *w;
3075 int i, j;
3076 struct sortvec *sortvec;
3077 sortvec = (struct sortvec *) alloca (noverlays * sizeof (struct sortvec));
3079 /* Put the valid and relevant overlays into sortvec. */
3081 for (i = 0, j = 0; i < noverlays; i++)
3083 Lisp_Object tem;
3084 Lisp_Object overlay;
3086 overlay = overlay_vec[i];
3087 if (OVERLAY_VALID (overlay)
3088 && OVERLAY_POSITION (OVERLAY_START (overlay)) > 0
3089 && OVERLAY_POSITION (OVERLAY_END (overlay)) > 0)
3091 /* If we're interested in a specific window, then ignore
3092 overlays that are limited to some other window. */
3093 if (w)
3095 Lisp_Object window;
3097 window = Foverlay_get (overlay, Qwindow);
3098 if (WINDOWP (window) && XWINDOW (window) != w)
3099 continue;
3102 /* This overlay is good and counts: put it into sortvec. */
3103 sortvec[j].overlay = overlay;
3104 sortvec[j].beg = OVERLAY_POSITION (OVERLAY_START (overlay));
3105 sortvec[j].end = OVERLAY_POSITION (OVERLAY_END (overlay));
3106 tem = Foverlay_get (overlay, Qpriority);
3107 if (INTEGERP (tem))
3108 sortvec[j].priority = XINT (tem);
3109 else
3110 sortvec[j].priority = 0;
3111 j++;
3114 noverlays = j;
3116 /* Sort the overlays into the proper order: increasing priority. */
3118 if (noverlays > 1)
3119 qsort (sortvec, noverlays, sizeof (struct sortvec), compare_overlays);
3121 for (i = 0; i < noverlays; i++)
3122 overlay_vec[i] = sortvec[i].overlay;
3123 return (noverlays);
3126 struct sortstr
3128 Lisp_Object string, string2;
3129 int size;
3130 int priority;
3133 struct sortstrlist
3135 struct sortstr *buf; /* An array that expands as needed; never freed. */
3136 int size; /* Allocated length of that array. */
3137 int used; /* How much of the array is currently in use. */
3138 int bytes; /* Total length of the strings in buf. */
3141 /* Buffers for storing information about the overlays touching a given
3142 position. These could be automatic variables in overlay_strings, but
3143 it's more efficient to hold onto the memory instead of repeatedly
3144 allocating and freeing it. */
3145 static struct sortstrlist overlay_heads, overlay_tails;
3146 static unsigned char *overlay_str_buf;
3148 /* Allocated length of overlay_str_buf. */
3149 static int overlay_str_len;
3151 /* A comparison function suitable for passing to qsort. */
3152 static int
3153 cmp_for_strings (as1, as2)
3154 char *as1, *as2;
3156 struct sortstr *s1 = (struct sortstr *)as1;
3157 struct sortstr *s2 = (struct sortstr *)as2;
3158 if (s1->size != s2->size)
3159 return s2->size - s1->size;
3160 if (s1->priority != s2->priority)
3161 return s1->priority - s2->priority;
3162 return 0;
3165 static void
3166 record_overlay_string (ssl, str, str2, pri, size)
3167 struct sortstrlist *ssl;
3168 Lisp_Object str, str2, pri;
3169 int size;
3171 int nbytes;
3173 if (ssl->used == ssl->size)
3175 if (ssl->buf)
3176 ssl->size *= 2;
3177 else
3178 ssl->size = 5;
3179 ssl->buf = ((struct sortstr *)
3180 xrealloc (ssl->buf, ssl->size * sizeof (struct sortstr)));
3182 ssl->buf[ssl->used].string = str;
3183 ssl->buf[ssl->used].string2 = str2;
3184 ssl->buf[ssl->used].size = size;
3185 ssl->buf[ssl->used].priority = (INTEGERP (pri) ? XINT (pri) : 0);
3186 ssl->used++;
3188 if (NILP (current_buffer->enable_multibyte_characters))
3189 nbytes = SCHARS (str);
3190 else if (! STRING_MULTIBYTE (str))
3191 nbytes = count_size_as_multibyte (SDATA (str),
3192 SBYTES (str));
3193 else
3194 nbytes = SBYTES (str);
3196 ssl->bytes += nbytes;
3198 if (STRINGP (str2))
3200 if (NILP (current_buffer->enable_multibyte_characters))
3201 nbytes = SCHARS (str2);
3202 else if (! STRING_MULTIBYTE (str2))
3203 nbytes = count_size_as_multibyte (SDATA (str2),
3204 SBYTES (str2));
3205 else
3206 nbytes = SBYTES (str2);
3208 ssl->bytes += nbytes;
3212 /* Return the concatenation of the strings associated with overlays that
3213 begin or end at POS, ignoring overlays that are specific to a window
3214 other than W. The strings are concatenated in the appropriate order:
3215 shorter overlays nest inside longer ones, and higher priority inside
3216 lower. Normally all of the after-strings come first, but zero-sized
3217 overlays have their after-strings ride along with the before-strings
3218 because it would look strange to print them inside-out.
3220 Returns the string length, and stores the contents indirectly through
3221 PSTR, if that variable is non-null. The string may be overwritten by
3222 subsequent calls. */
3225 overlay_strings (pos, w, pstr)
3226 EMACS_INT pos;
3227 struct window *w;
3228 unsigned char **pstr;
3230 Lisp_Object overlay, window, str;
3231 struct Lisp_Overlay *ov;
3232 int startpos, endpos;
3233 int multibyte = ! NILP (current_buffer->enable_multibyte_characters);
3235 overlay_heads.used = overlay_heads.bytes = 0;
3236 overlay_tails.used = overlay_tails.bytes = 0;
3237 for (ov = current_buffer->overlays_before; ov; ov = ov->next)
3239 XSETMISC (overlay, ov);
3240 eassert (OVERLAYP (overlay));
3242 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3243 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3244 if (endpos < pos)
3245 break;
3246 if (endpos != pos && startpos != pos)
3247 continue;
3248 window = Foverlay_get (overlay, Qwindow);
3249 if (WINDOWP (window) && XWINDOW (window) != w)
3250 continue;
3251 if (startpos == pos
3252 && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
3253 record_overlay_string (&overlay_heads, str,
3254 (startpos == endpos
3255 ? Foverlay_get (overlay, Qafter_string)
3256 : Qnil),
3257 Foverlay_get (overlay, Qpriority),
3258 endpos - startpos);
3259 else if (endpos == pos
3260 && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
3261 record_overlay_string (&overlay_tails, str, Qnil,
3262 Foverlay_get (overlay, Qpriority),
3263 endpos - startpos);
3265 for (ov = current_buffer->overlays_after; ov; ov = ov->next)
3267 XSETMISC (overlay, ov);
3268 eassert (OVERLAYP (overlay));
3270 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3271 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3272 if (startpos > pos)
3273 break;
3274 if (endpos != pos && startpos != pos)
3275 continue;
3276 window = Foverlay_get (overlay, Qwindow);
3277 if (WINDOWP (window) && XWINDOW (window) != w)
3278 continue;
3279 if (startpos == pos
3280 && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
3281 record_overlay_string (&overlay_heads, str,
3282 (startpos == endpos
3283 ? Foverlay_get (overlay, Qafter_string)
3284 : Qnil),
3285 Foverlay_get (overlay, Qpriority),
3286 endpos - startpos);
3287 else if (endpos == pos
3288 && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
3289 record_overlay_string (&overlay_tails, str, Qnil,
3290 Foverlay_get (overlay, Qpriority),
3291 endpos - startpos);
3293 if (overlay_tails.used > 1)
3294 qsort (overlay_tails.buf, overlay_tails.used, sizeof (struct sortstr),
3295 cmp_for_strings);
3296 if (overlay_heads.used > 1)
3297 qsort (overlay_heads.buf, overlay_heads.used, sizeof (struct sortstr),
3298 cmp_for_strings);
3299 if (overlay_heads.bytes || overlay_tails.bytes)
3301 Lisp_Object tem;
3302 int i;
3303 unsigned char *p;
3304 int total = overlay_heads.bytes + overlay_tails.bytes;
3306 if (total > overlay_str_len)
3308 overlay_str_len = total;
3309 overlay_str_buf = (unsigned char *)xrealloc (overlay_str_buf,
3310 total);
3312 p = overlay_str_buf;
3313 for (i = overlay_tails.used; --i >= 0;)
3315 int nbytes;
3316 tem = overlay_tails.buf[i].string;
3317 nbytes = copy_text (SDATA (tem), p,
3318 SBYTES (tem),
3319 STRING_MULTIBYTE (tem), multibyte);
3320 p += nbytes;
3322 for (i = 0; i < overlay_heads.used; ++i)
3324 int nbytes;
3325 tem = overlay_heads.buf[i].string;
3326 nbytes = copy_text (SDATA (tem), p,
3327 SBYTES (tem),
3328 STRING_MULTIBYTE (tem), multibyte);
3329 p += nbytes;
3330 tem = overlay_heads.buf[i].string2;
3331 if (STRINGP (tem))
3333 nbytes = copy_text (SDATA (tem), p,
3334 SBYTES (tem),
3335 STRING_MULTIBYTE (tem), multibyte);
3336 p += nbytes;
3339 if (p != overlay_str_buf + total)
3340 abort ();
3341 if (pstr)
3342 *pstr = overlay_str_buf;
3343 return total;
3345 return 0;
3348 /* Shift overlays in BUF's overlay lists, to center the lists at POS. */
3350 void
3351 recenter_overlay_lists (buf, pos)
3352 struct buffer *buf;
3353 EMACS_INT pos;
3355 Lisp_Object overlay, beg, end;
3356 struct Lisp_Overlay *prev, *tail, *next;
3358 /* See if anything in overlays_before should move to overlays_after. */
3360 /* We don't strictly need prev in this loop; it should always be nil.
3361 But we use it for symmetry and in case that should cease to be true
3362 with some future change. */
3363 prev = NULL;
3364 for (tail = buf->overlays_before; tail; prev = tail, tail = next)
3366 next = tail->next;
3367 XSETMISC (overlay, tail);
3369 /* If the overlay is not valid, get rid of it. */
3370 if (!OVERLAY_VALID (overlay))
3371 #if 1
3372 abort ();
3373 #else
3375 /* Splice the cons cell TAIL out of overlays_before. */
3376 if (!NILP (prev))
3377 XCDR (prev) = next;
3378 else
3379 buf->overlays_before = next;
3380 tail = prev;
3381 continue;
3383 #endif
3385 beg = OVERLAY_START (overlay);
3386 end = OVERLAY_END (overlay);
3388 if (OVERLAY_POSITION (end) > pos)
3390 /* OVERLAY needs to be moved. */
3391 int where = OVERLAY_POSITION (beg);
3392 struct Lisp_Overlay *other, *other_prev;
3394 /* Splice the cons cell TAIL out of overlays_before. */
3395 if (prev)
3396 prev->next = next;
3397 else
3398 buf->overlays_before = next;
3400 /* Search thru overlays_after for where to put it. */
3401 other_prev = NULL;
3402 for (other = buf->overlays_after; other;
3403 other_prev = other, other = other->next)
3405 Lisp_Object otherbeg, otheroverlay;
3407 XSETMISC (otheroverlay, other);
3408 eassert (OVERLAY_VALID (otheroverlay));
3410 otherbeg = OVERLAY_START (otheroverlay);
3411 if (OVERLAY_POSITION (otherbeg) >= where)
3412 break;
3415 /* Add TAIL to overlays_after before OTHER. */
3416 tail->next = other;
3417 if (other_prev)
3418 other_prev->next = tail;
3419 else
3420 buf->overlays_after = tail;
3421 tail = prev;
3423 else
3424 /* We've reached the things that should stay in overlays_before.
3425 All the rest of overlays_before must end even earlier,
3426 so stop now. */
3427 break;
3430 /* See if anything in overlays_after should be in overlays_before. */
3431 prev = NULL;
3432 for (tail = buf->overlays_after; tail; prev = tail, tail = next)
3434 next = tail->next;
3435 XSETMISC (overlay, tail);
3437 /* If the overlay is not valid, get rid of it. */
3438 if (!OVERLAY_VALID (overlay))
3439 #if 1
3440 abort ();
3441 #else
3443 /* Splice the cons cell TAIL out of overlays_after. */
3444 if (!NILP (prev))
3445 XCDR (prev) = next;
3446 else
3447 buf->overlays_after = next;
3448 tail = prev;
3449 continue;
3451 #endif
3453 beg = OVERLAY_START (overlay);
3454 end = OVERLAY_END (overlay);
3456 /* Stop looking, when we know that nothing further
3457 can possibly end before POS. */
3458 if (OVERLAY_POSITION (beg) > pos)
3459 break;
3461 if (OVERLAY_POSITION (end) <= pos)
3463 /* OVERLAY needs to be moved. */
3464 int where = OVERLAY_POSITION (end);
3465 struct Lisp_Overlay *other, *other_prev;
3467 /* Splice the cons cell TAIL out of overlays_after. */
3468 if (prev)
3469 prev->next = next;
3470 else
3471 buf->overlays_after = next;
3473 /* Search thru overlays_before for where to put it. */
3474 other_prev = NULL;
3475 for (other = buf->overlays_before; other;
3476 other_prev = other, other = other->next)
3478 Lisp_Object otherend, otheroverlay;
3480 XSETMISC (otheroverlay, other);
3481 eassert (OVERLAY_VALID (otheroverlay));
3483 otherend = OVERLAY_END (otheroverlay);
3484 if (OVERLAY_POSITION (otherend) <= where)
3485 break;
3488 /* Add TAIL to overlays_before before OTHER. */
3489 tail->next = other;
3490 if (other_prev)
3491 other_prev->next = tail;
3492 else
3493 buf->overlays_before = tail;
3494 tail = prev;
3498 buf->overlay_center = pos;
3501 void
3502 adjust_overlays_for_insert (pos, length)
3503 EMACS_INT pos;
3504 EMACS_INT length;
3506 /* After an insertion, the lists are still sorted properly,
3507 but we may need to update the value of the overlay center. */
3508 if (current_buffer->overlay_center >= pos)
3509 current_buffer->overlay_center += length;
3512 void
3513 adjust_overlays_for_delete (pos, length)
3514 EMACS_INT pos;
3515 EMACS_INT length;
3517 if (current_buffer->overlay_center < pos)
3518 /* The deletion was to our right. No change needed; the before- and
3519 after-lists are still consistent. */
3521 else if (current_buffer->overlay_center > pos + length)
3522 /* The deletion was to our left. We need to adjust the center value
3523 to account for the change in position, but the lists are consistent
3524 given the new value. */
3525 current_buffer->overlay_center -= length;
3526 else
3527 /* We're right in the middle. There might be things on the after-list
3528 that now belong on the before-list. Recentering will move them,
3529 and also update the center point. */
3530 recenter_overlay_lists (current_buffer, pos);
3533 /* Fix up overlays that were garbled as a result of permuting markers
3534 in the range START through END. Any overlay with at least one
3535 endpoint in this range will need to be unlinked from the overlay
3536 list and reinserted in its proper place.
3537 Such an overlay might even have negative size at this point.
3538 If so, we'll make the overlay empty. */
3539 void
3540 fix_start_end_in_overlays (start, end)
3541 register int start, end;
3543 Lisp_Object overlay;
3544 struct Lisp_Overlay *before_list, *after_list;
3545 /* These are either nil, indicating that before_list or after_list
3546 should be assigned, or the cons cell the cdr of which should be
3547 assigned. */
3548 struct Lisp_Overlay *beforep = NULL, *afterp = NULL;
3549 /* 'Parent', likewise, indicates a cons cell or
3550 current_buffer->overlays_before or overlays_after, depending
3551 which loop we're in. */
3552 struct Lisp_Overlay *tail, *parent;
3553 int startpos, endpos;
3555 /* This algorithm shifts links around instead of consing and GCing.
3556 The loop invariant is that before_list (resp. after_list) is a
3557 well-formed list except that its last element, the CDR of beforep
3558 (resp. afterp) if beforep (afterp) isn't nil or before_list
3559 (after_list) if it is, is still uninitialized. So it's not a bug
3560 that before_list isn't initialized, although it may look
3561 strange. */
3562 for (parent = NULL, tail = current_buffer->overlays_before; tail;)
3564 XSETMISC (overlay, tail);
3566 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3567 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3569 /* If the overlay is backwards, make it empty. */
3570 if (endpos < startpos)
3572 startpos = endpos;
3573 Fset_marker (OVERLAY_START (overlay), make_number (startpos),
3574 Qnil);
3577 if (endpos < start)
3578 break;
3580 if (endpos < end
3581 || (startpos >= start && startpos < end))
3583 /* Add it to the end of the wrong list. Later on,
3584 recenter_overlay_lists will move it to the right place. */
3585 if (endpos < current_buffer->overlay_center)
3587 if (!afterp)
3588 after_list = tail;
3589 else
3590 afterp->next = tail;
3591 afterp = tail;
3593 else
3595 if (!beforep)
3596 before_list = tail;
3597 else
3598 beforep->next = tail;
3599 beforep = tail;
3601 if (!parent)
3602 current_buffer->overlays_before = tail->next;
3603 else
3604 parent->next = tail->next;
3605 tail = tail->next;
3607 else
3608 parent = tail, tail = parent->next;
3610 for (parent = NULL, tail = current_buffer->overlays_after; tail;)
3612 XSETMISC (overlay, tail);
3614 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3615 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3617 /* If the overlay is backwards, make it empty. */
3618 if (endpos < startpos)
3620 startpos = endpos;
3621 Fset_marker (OVERLAY_START (overlay), make_number (startpos),
3622 Qnil);
3625 if (startpos >= end)
3626 break;
3628 if (startpos >= start
3629 || (endpos >= start && endpos < end))
3631 if (endpos < current_buffer->overlay_center)
3633 if (!afterp)
3634 after_list = tail;
3635 else
3636 afterp->next = tail;
3637 afterp = tail;
3639 else
3641 if (!beforep)
3642 before_list = tail;
3643 else
3644 beforep->next = tail;
3645 beforep = tail;
3647 if (!parent)
3648 current_buffer->overlays_after = tail->next;
3649 else
3650 parent->next = tail->next;
3651 tail = tail->next;
3653 else
3654 parent = tail, tail = parent->next;
3657 /* Splice the constructed (wrong) lists into the buffer's lists,
3658 and let the recenter function make it sane again. */
3659 if (beforep)
3661 beforep->next = current_buffer->overlays_before;
3662 current_buffer->overlays_before = before_list;
3664 recenter_overlay_lists (current_buffer, current_buffer->overlay_center);
3666 if (afterp)
3668 afterp->next = current_buffer->overlays_after;
3669 current_buffer->overlays_after = after_list;
3671 recenter_overlay_lists (current_buffer, current_buffer->overlay_center);
3674 /* We have two types of overlay: the one whose ending marker is
3675 after-insertion-marker (this is the usual case) and the one whose
3676 ending marker is before-insertion-marker. When `overlays_before'
3677 contains overlays of the latter type and the former type in this
3678 order and both overlays end at inserting position, inserting a text
3679 increases only the ending marker of the latter type, which results
3680 in incorrect ordering of `overlays_before'.
3682 This function fixes ordering of overlays in the slot
3683 `overlays_before' of the buffer *BP. Before the insertion, `point'
3684 was at PREV, and now is at POS. */
3686 void
3687 fix_overlays_before (bp, prev, pos)
3688 struct buffer *bp;
3689 EMACS_INT prev, pos;
3691 /* If parent is nil, replace overlays_before; otherwise, parent->next. */
3692 struct Lisp_Overlay *tail = bp->overlays_before, *parent = NULL, *right_pair;
3693 Lisp_Object tem;
3694 EMACS_INT end;
3696 /* After the insertion, the several overlays may be in incorrect
3697 order. The possibility is that, in the list `overlays_before',
3698 an overlay which ends at POS appears after an overlay which ends
3699 at PREV. Since POS is greater than PREV, we must fix the
3700 ordering of these overlays, by moving overlays ends at POS before
3701 the overlays ends at PREV. */
3703 /* At first, find a place where disordered overlays should be linked
3704 in. It is where an overlay which end before POS exists. (i.e. an
3705 overlay whose ending marker is after-insertion-marker if disorder
3706 exists). */
3707 while (tail
3708 && (XSETMISC (tem, tail),
3709 (end = OVERLAY_POSITION (OVERLAY_END (tem))) >= pos))
3711 parent = tail;
3712 tail = tail->next;
3715 /* If we don't find such an overlay,
3716 or the found one ends before PREV,
3717 or the found one is the last one in the list,
3718 we don't have to fix anything. */
3719 if (!tail || end < prev || !tail->next)
3720 return;
3722 right_pair = parent;
3723 parent = tail;
3724 tail = tail->next;
3726 /* Now, end position of overlays in the list TAIL should be before
3727 or equal to PREV. In the loop, an overlay which ends at POS is
3728 moved ahead to the place indicated by the CDR of RIGHT_PAIR. If
3729 we found an overlay which ends before PREV, the remaining
3730 overlays are in correct order. */
3731 while (tail)
3733 XSETMISC (tem, tail);
3734 end = OVERLAY_POSITION (OVERLAY_END (tem));
3736 if (end == pos)
3737 { /* This overlay is disordered. */
3738 struct Lisp_Overlay *found = tail;
3740 /* Unlink the found overlay. */
3741 tail = found->next;
3742 parent->next = tail;
3743 /* Move an overlay at RIGHT_PLACE to the next of the found one,
3744 and link it into the right place. */
3745 if (!right_pair)
3747 found->next = bp->overlays_before;
3748 bp->overlays_before = found;
3750 else
3752 found->next = right_pair->next;
3753 right_pair->next = found;
3756 else if (end == prev)
3758 parent = tail;
3759 tail = tail->next;
3761 else /* No more disordered overlay. */
3762 break;
3766 DEFUN ("overlayp", Foverlayp, Soverlayp, 1, 1, 0,
3767 doc: /* Return t if OBJECT is an overlay. */)
3768 (object)
3769 Lisp_Object object;
3771 return (OVERLAYP (object) ? Qt : Qnil);
3774 DEFUN ("make-overlay", Fmake_overlay, Smake_overlay, 2, 5, 0,
3775 doc: /* Create a new overlay with range BEG to END in BUFFER.
3776 If omitted, BUFFER defaults to the current buffer.
3777 BEG and END may be integers or markers.
3778 The fourth arg FRONT-ADVANCE, if non-nil, makes the marker
3779 for the front of the overlay advance when text is inserted there
3780 \(which means the text *is not* included in the overlay).
3781 The fifth arg REAR-ADVANCE, if non-nil, makes the marker
3782 for the rear of the overlay advance when text is inserted there
3783 \(which means the text *is* included in the overlay). */)
3784 (beg, end, buffer, front_advance, rear_advance)
3785 Lisp_Object beg, end, buffer;
3786 Lisp_Object front_advance, rear_advance;
3788 Lisp_Object overlay;
3789 struct buffer *b;
3791 if (NILP (buffer))
3792 XSETBUFFER (buffer, current_buffer);
3793 else
3794 CHECK_BUFFER (buffer);
3795 if (MARKERP (beg)
3796 && ! EQ (Fmarker_buffer (beg), buffer))
3797 error ("Marker points into wrong buffer");
3798 if (MARKERP (end)
3799 && ! EQ (Fmarker_buffer (end), buffer))
3800 error ("Marker points into wrong buffer");
3802 CHECK_NUMBER_COERCE_MARKER (beg);
3803 CHECK_NUMBER_COERCE_MARKER (end);
3805 if (XINT (beg) > XINT (end))
3807 Lisp_Object temp;
3808 temp = beg; beg = end; end = temp;
3811 b = XBUFFER (buffer);
3813 beg = Fset_marker (Fmake_marker (), beg, buffer);
3814 end = Fset_marker (Fmake_marker (), end, buffer);
3816 if (!NILP (front_advance))
3817 XMARKER (beg)->insertion_type = 1;
3818 if (!NILP (rear_advance))
3819 XMARKER (end)->insertion_type = 1;
3821 overlay = allocate_misc ();
3822 XMISCTYPE (overlay) = Lisp_Misc_Overlay;
3823 XOVERLAY (overlay)->start = beg;
3824 XOVERLAY (overlay)->end = end;
3825 XOVERLAY (overlay)->plist = Qnil;
3826 XOVERLAY (overlay)->next = NULL;
3828 /* Put the new overlay on the wrong list. */
3829 end = OVERLAY_END (overlay);
3830 if (OVERLAY_POSITION (end) < b->overlay_center)
3832 if (b->overlays_after)
3833 XOVERLAY (overlay)->next = b->overlays_after;
3834 b->overlays_after = XOVERLAY (overlay);
3836 else
3838 if (b->overlays_before)
3839 XOVERLAY (overlay)->next = b->overlays_before;
3840 b->overlays_before = XOVERLAY (overlay);
3843 /* This puts it in the right list, and in the right order. */
3844 recenter_overlay_lists (b, b->overlay_center);
3846 /* We don't need to redisplay the region covered by the overlay, because
3847 the overlay has no properties at the moment. */
3849 return overlay;
3852 /* Mark a section of BUF as needing redisplay because of overlays changes. */
3854 static void
3855 modify_overlay (buf, start, end)
3856 struct buffer *buf;
3857 EMACS_INT start, end;
3859 if (start > end)
3861 int temp = start;
3862 start = end;
3863 end = temp;
3866 BUF_COMPUTE_UNCHANGED (buf, start, end);
3868 /* If this is a buffer not in the selected window,
3869 we must do other windows. */
3870 if (buf != XBUFFER (XWINDOW (selected_window)->buffer))
3871 windows_or_buffers_changed = 1;
3872 /* If multiple windows show this buffer, we must do other windows. */
3873 else if (buffer_shared > 1)
3874 windows_or_buffers_changed = 1;
3875 /* If we modify an overlay at the end of the buffer, we cannot
3876 be sure that window end is still valid. */
3877 else if (end >= ZV && start <= ZV)
3878 windows_or_buffers_changed = 1;
3880 ++BUF_OVERLAY_MODIFF (buf);
3884 Lisp_Object Fdelete_overlay ();
3886 static struct Lisp_Overlay *
3887 unchain_overlay (list, overlay)
3888 struct Lisp_Overlay *list, *overlay;
3890 struct Lisp_Overlay *tmp, *prev;
3891 for (tmp = list, prev = NULL; tmp; prev = tmp, tmp = tmp->next)
3892 if (tmp == overlay)
3894 if (prev)
3895 prev->next = tmp->next;
3896 else
3897 list = tmp->next;
3898 overlay->next = NULL;
3899 break;
3901 return list;
3904 DEFUN ("move-overlay", Fmove_overlay, Smove_overlay, 3, 4, 0,
3905 doc: /* Set the endpoints of OVERLAY to BEG and END in BUFFER.
3906 If BUFFER is omitted, leave OVERLAY in the same buffer it inhabits now.
3907 If BUFFER is omitted, and OVERLAY is in no buffer, put it in the current
3908 buffer. */)
3909 (overlay, beg, end, buffer)
3910 Lisp_Object overlay, beg, end, buffer;
3912 struct buffer *b, *ob;
3913 Lisp_Object obuffer;
3914 int count = SPECPDL_INDEX ();
3916 CHECK_OVERLAY (overlay);
3917 if (NILP (buffer))
3918 buffer = Fmarker_buffer (OVERLAY_START (overlay));
3919 if (NILP (buffer))
3920 XSETBUFFER (buffer, current_buffer);
3921 CHECK_BUFFER (buffer);
3923 if (MARKERP (beg)
3924 && ! EQ (Fmarker_buffer (beg), buffer))
3925 error ("Marker points into wrong buffer");
3926 if (MARKERP (end)
3927 && ! EQ (Fmarker_buffer (end), buffer))
3928 error ("Marker points into wrong buffer");
3930 CHECK_NUMBER_COERCE_MARKER (beg);
3931 CHECK_NUMBER_COERCE_MARKER (end);
3933 if (XINT (beg) == XINT (end) && ! NILP (Foverlay_get (overlay, Qevaporate)))
3934 return Fdelete_overlay (overlay);
3936 if (XINT (beg) > XINT (end))
3938 Lisp_Object temp;
3939 temp = beg; beg = end; end = temp;
3942 specbind (Qinhibit_quit, Qt);
3944 obuffer = Fmarker_buffer (OVERLAY_START (overlay));
3945 b = XBUFFER (buffer);
3946 ob = BUFFERP (obuffer) ? XBUFFER (obuffer) : (struct buffer *) 0;
3948 /* If the overlay has changed buffers, do a thorough redisplay. */
3949 if (!EQ (buffer, obuffer))
3951 /* Redisplay where the overlay was. */
3952 if (!NILP (obuffer))
3954 int o_beg;
3955 int o_end;
3957 o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
3958 o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
3960 modify_overlay (ob, o_beg, o_end);
3963 /* Redisplay where the overlay is going to be. */
3964 modify_overlay (b, XINT (beg), XINT (end));
3966 else
3967 /* Redisplay the area the overlay has just left, or just enclosed. */
3969 int o_beg, o_end;
3971 o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
3972 o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
3974 if (o_beg == XINT (beg))
3975 modify_overlay (b, o_end, XINT (end));
3976 else if (o_end == XINT (end))
3977 modify_overlay (b, o_beg, XINT (beg));
3978 else
3980 if (XINT (beg) < o_beg) o_beg = XINT (beg);
3981 if (XINT (end) > o_end) o_end = XINT (end);
3982 modify_overlay (b, o_beg, o_end);
3986 if (!NILP (obuffer))
3988 ob->overlays_before
3989 = unchain_overlay (ob->overlays_before, XOVERLAY (overlay));
3990 ob->overlays_after
3991 = unchain_overlay (ob->overlays_after, XOVERLAY (overlay));
3992 eassert (XOVERLAY (overlay)->next == NULL);
3995 Fset_marker (OVERLAY_START (overlay), beg, buffer);
3996 Fset_marker (OVERLAY_END (overlay), end, buffer);
3998 /* Put the overlay on the wrong list. */
3999 end = OVERLAY_END (overlay);
4000 if (OVERLAY_POSITION (end) < b->overlay_center)
4002 XOVERLAY (overlay)->next = b->overlays_after;
4003 b->overlays_after = XOVERLAY (overlay);
4005 else
4007 XOVERLAY (overlay)->next = b->overlays_before;
4008 b->overlays_before = XOVERLAY (overlay);
4011 /* This puts it in the right list, and in the right order. */
4012 recenter_overlay_lists (b, b->overlay_center);
4014 return unbind_to (count, overlay);
4017 DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0,
4018 doc: /* Delete the overlay OVERLAY from its buffer. */)
4019 (overlay)
4020 Lisp_Object overlay;
4022 Lisp_Object buffer;
4023 struct buffer *b;
4024 int count = SPECPDL_INDEX ();
4026 CHECK_OVERLAY (overlay);
4028 buffer = Fmarker_buffer (OVERLAY_START (overlay));
4029 if (NILP (buffer))
4030 return Qnil;
4032 b = XBUFFER (buffer);
4033 specbind (Qinhibit_quit, Qt);
4035 b->overlays_before = unchain_overlay (b->overlays_before,XOVERLAY (overlay));
4036 b->overlays_after = unchain_overlay (b->overlays_after, XOVERLAY (overlay));
4037 eassert (XOVERLAY (overlay)->next == NULL);
4038 modify_overlay (b,
4039 marker_position (OVERLAY_START (overlay)),
4040 marker_position (OVERLAY_END (overlay)));
4041 Fset_marker (OVERLAY_START (overlay), Qnil, Qnil);
4042 Fset_marker (OVERLAY_END (overlay), Qnil, Qnil);
4044 /* When deleting an overlay with before or after strings, turn off
4045 display optimizations for the affected buffer, on the basis that
4046 these strings may contain newlines. This is easier to do than to
4047 check for that situation during redisplay. */
4048 if (!windows_or_buffers_changed
4049 && (!NILP (Foverlay_get (overlay, Qbefore_string))
4050 || !NILP (Foverlay_get (overlay, Qafter_string))))
4051 b->prevent_redisplay_optimizations_p = 1;
4053 return unbind_to (count, Qnil);
4056 /* Overlay dissection functions. */
4058 DEFUN ("overlay-start", Foverlay_start, Soverlay_start, 1, 1, 0,
4059 doc: /* Return the position at which OVERLAY starts. */)
4060 (overlay)
4061 Lisp_Object overlay;
4063 CHECK_OVERLAY (overlay);
4065 return (Fmarker_position (OVERLAY_START (overlay)));
4068 DEFUN ("overlay-end", Foverlay_end, Soverlay_end, 1, 1, 0,
4069 doc: /* Return the position at which OVERLAY ends. */)
4070 (overlay)
4071 Lisp_Object overlay;
4073 CHECK_OVERLAY (overlay);
4075 return (Fmarker_position (OVERLAY_END (overlay)));
4078 DEFUN ("overlay-buffer", Foverlay_buffer, Soverlay_buffer, 1, 1, 0,
4079 doc: /* Return the buffer OVERLAY belongs to.
4080 Return nil if OVERLAY has been deleted. */)
4081 (overlay)
4082 Lisp_Object overlay;
4084 CHECK_OVERLAY (overlay);
4086 return Fmarker_buffer (OVERLAY_START (overlay));
4089 DEFUN ("overlay-properties", Foverlay_properties, Soverlay_properties, 1, 1, 0,
4090 doc: /* Return a list of the properties on OVERLAY.
4091 This is a copy of OVERLAY's plist; modifying its conses has no effect on
4092 OVERLAY. */)
4093 (overlay)
4094 Lisp_Object overlay;
4096 CHECK_OVERLAY (overlay);
4098 return Fcopy_sequence (XOVERLAY (overlay)->plist);
4102 DEFUN ("overlays-at", Foverlays_at, Soverlays_at, 1, 1, 0,
4103 doc: /* Return a list of the overlays that contain the character at POS. */)
4104 (pos)
4105 Lisp_Object pos;
4107 int noverlays;
4108 Lisp_Object *overlay_vec;
4109 int len;
4110 Lisp_Object result;
4112 CHECK_NUMBER_COERCE_MARKER (pos);
4114 len = 10;
4115 /* We can't use alloca here because overlays_at can call xrealloc. */
4116 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
4118 /* Put all the overlays we want in a vector in overlay_vec.
4119 Store the length in len. */
4120 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
4121 (EMACS_INT *) 0, (EMACS_INT *) 0, 0);
4123 /* Make a list of them all. */
4124 result = Flist (noverlays, overlay_vec);
4126 xfree (overlay_vec);
4127 return result;
4130 DEFUN ("overlays-in", Foverlays_in, Soverlays_in, 2, 2, 0,
4131 doc: /* Return a list of the overlays that overlap the region BEG ... END.
4132 Overlap means that at least one character is contained within the overlay
4133 and also contained within the specified region.
4134 Empty overlays are included in the result if they are located at BEG,
4135 between BEG and END, or at END provided END denotes the position at the
4136 end of the buffer. */)
4137 (beg, end)
4138 Lisp_Object beg, end;
4140 int noverlays;
4141 Lisp_Object *overlay_vec;
4142 int len;
4143 Lisp_Object result;
4145 CHECK_NUMBER_COERCE_MARKER (beg);
4146 CHECK_NUMBER_COERCE_MARKER (end);
4148 len = 10;
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_in (XINT (beg), XINT (end), 1, &overlay_vec, &len,
4154 (int *) 0, (int *) 0);
4156 /* Make a list of them all. */
4157 result = Flist (noverlays, overlay_vec);
4159 xfree (overlay_vec);
4160 return result;
4163 DEFUN ("next-overlay-change", Fnext_overlay_change, Snext_overlay_change,
4164 1, 1, 0,
4165 doc: /* Return the next position after POS where an overlay starts or ends.
4166 If there are no overlay boundaries from POS to (point-max),
4167 the value is (point-max). */)
4168 (pos)
4169 Lisp_Object pos;
4171 int noverlays;
4172 EMACS_INT endpos;
4173 Lisp_Object *overlay_vec;
4174 int len;
4175 int i;
4177 CHECK_NUMBER_COERCE_MARKER (pos);
4179 len = 10;
4180 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
4182 /* Put all the overlays we want in a vector in overlay_vec.
4183 Store the length in len.
4184 endpos gets the position where the next overlay starts. */
4185 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
4186 &endpos, (EMACS_INT *) 0, 1);
4188 /* If any of these overlays ends before endpos,
4189 use its ending point instead. */
4190 for (i = 0; i < noverlays; i++)
4192 Lisp_Object oend;
4193 EMACS_INT oendpos;
4195 oend = OVERLAY_END (overlay_vec[i]);
4196 oendpos = OVERLAY_POSITION (oend);
4197 if (oendpos < endpos)
4198 endpos = oendpos;
4201 xfree (overlay_vec);
4202 return make_number (endpos);
4205 DEFUN ("previous-overlay-change", Fprevious_overlay_change,
4206 Sprevious_overlay_change, 1, 1, 0,
4207 doc: /* Return the previous position before POS where an overlay starts or ends.
4208 If there are no overlay boundaries from (point-min) to POS,
4209 the value is (point-min). */)
4210 (pos)
4211 Lisp_Object pos;
4213 int noverlays;
4214 EMACS_INT prevpos;
4215 Lisp_Object *overlay_vec;
4216 int len;
4218 CHECK_NUMBER_COERCE_MARKER (pos);
4220 /* At beginning of buffer, we know the answer;
4221 avoid bug subtracting 1 below. */
4222 if (XINT (pos) == BEGV)
4223 return pos;
4225 len = 10;
4226 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
4228 /* Put all the overlays we want in a vector in overlay_vec.
4229 Store the length in len.
4230 prevpos gets the position of the previous change. */
4231 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
4232 (EMACS_INT *) 0, &prevpos, 1);
4234 xfree (overlay_vec);
4235 return make_number (prevpos);
4238 /* These functions are for debugging overlays. */
4240 DEFUN ("overlay-lists", Foverlay_lists, Soverlay_lists, 0, 0, 0,
4241 doc: /* Return a pair of lists giving all the overlays of the current buffer.
4242 The car has all the overlays before the overlay center;
4243 the cdr has all the overlays after the overlay center.
4244 Recentering overlays moves overlays between these lists.
4245 The lists you get are copies, so that changing them has no effect.
4246 However, the overlays you get are the real objects that the buffer uses. */)
4249 struct Lisp_Overlay *ol;
4250 Lisp_Object before = Qnil, after = Qnil, tmp;
4251 for (ol = current_buffer->overlays_before; ol; ol = ol->next)
4253 XSETMISC (tmp, ol);
4254 before = Fcons (tmp, before);
4256 for (ol = current_buffer->overlays_after; ol; ol = ol->next)
4258 XSETMISC (tmp, ol);
4259 after = Fcons (tmp, after);
4261 return Fcons (Fnreverse (before), Fnreverse (after));
4264 DEFUN ("overlay-recenter", Foverlay_recenter, Soverlay_recenter, 1, 1, 0,
4265 doc: /* Recenter the overlays of the current buffer around position POS.
4266 That makes overlay lookup faster for positions near POS (but perhaps slower
4267 for positions far away from POS). */)
4268 (pos)
4269 Lisp_Object pos;
4271 CHECK_NUMBER_COERCE_MARKER (pos);
4273 recenter_overlay_lists (current_buffer, XINT (pos));
4274 return Qnil;
4277 DEFUN ("overlay-get", Foverlay_get, Soverlay_get, 2, 2, 0,
4278 doc: /* Get the property of overlay OVERLAY with property name PROP. */)
4279 (overlay, prop)
4280 Lisp_Object overlay, prop;
4282 CHECK_OVERLAY (overlay);
4283 return lookup_char_property (XOVERLAY (overlay)->plist, prop, 0);
4286 DEFUN ("overlay-put", Foverlay_put, Soverlay_put, 3, 3, 0,
4287 doc: /* Set one property of overlay OVERLAY: give property PROP value VALUE. */)
4288 (overlay, prop, value)
4289 Lisp_Object overlay, prop, value;
4291 Lisp_Object tail, buffer;
4292 int changed;
4294 CHECK_OVERLAY (overlay);
4296 buffer = Fmarker_buffer (OVERLAY_START (overlay));
4298 for (tail = XOVERLAY (overlay)->plist;
4299 CONSP (tail) && CONSP (XCDR (tail));
4300 tail = XCDR (XCDR (tail)))
4301 if (EQ (XCAR (tail), prop))
4303 changed = !EQ (XCAR (XCDR (tail)), value);
4304 XSETCAR (XCDR (tail), value);
4305 goto found;
4307 /* It wasn't in the list, so add it to the front. */
4308 changed = !NILP (value);
4309 XOVERLAY (overlay)->plist
4310 = Fcons (prop, Fcons (value, XOVERLAY (overlay)->plist));
4311 found:
4312 if (! NILP (buffer))
4314 if (changed)
4315 modify_overlay (XBUFFER (buffer),
4316 marker_position (OVERLAY_START (overlay)),
4317 marker_position (OVERLAY_END (overlay)));
4318 if (EQ (prop, Qevaporate) && ! NILP (value)
4319 && (OVERLAY_POSITION (OVERLAY_START (overlay))
4320 == OVERLAY_POSITION (OVERLAY_END (overlay))))
4321 Fdelete_overlay (overlay);
4324 return value;
4327 /* Subroutine of report_overlay_modification. */
4329 /* Lisp vector holding overlay hook functions to call.
4330 Vector elements come in pairs.
4331 Each even-index element is a list of hook functions.
4332 The following odd-index element is the overlay they came from.
4334 Before the buffer change, we fill in this vector
4335 as we call overlay hook functions.
4336 After the buffer change, we get the functions to call from this vector.
4337 This way we always call the same functions before and after the change. */
4338 static Lisp_Object last_overlay_modification_hooks;
4340 /* Number of elements actually used in last_overlay_modification_hooks. */
4341 static int last_overlay_modification_hooks_used;
4343 /* Add one functionlist/overlay pair
4344 to the end of last_overlay_modification_hooks. */
4346 static void
4347 add_overlay_mod_hooklist (functionlist, overlay)
4348 Lisp_Object functionlist, overlay;
4350 int oldsize = XVECTOR (last_overlay_modification_hooks)->size;
4352 if (last_overlay_modification_hooks_used == oldsize)
4353 last_overlay_modification_hooks = larger_vector
4354 (last_overlay_modification_hooks, oldsize * 2, Qnil);
4355 ASET (last_overlay_modification_hooks, last_overlay_modification_hooks_used,
4356 functionlist); last_overlay_modification_hooks_used++;
4357 ASET (last_overlay_modification_hooks, last_overlay_modification_hooks_used,
4358 overlay); last_overlay_modification_hooks_used++;
4361 /* Run the modification-hooks of overlays that include
4362 any part of the text in START to END.
4363 If this change is an insertion, also
4364 run the insert-before-hooks of overlay starting at END,
4365 and the insert-after-hooks of overlay ending at START.
4367 This is called both before and after the modification.
4368 AFTER is nonzero when we call after the modification.
4370 ARG1, ARG2, ARG3 are arguments to pass to the hook functions.
4371 When AFTER is nonzero, they are the start position,
4372 the position after the inserted new text,
4373 and the length of deleted or replaced old text. */
4375 void
4376 report_overlay_modification (start, end, after, arg1, arg2, arg3)
4377 Lisp_Object start, end;
4378 int after;
4379 Lisp_Object arg1, arg2, arg3;
4381 Lisp_Object prop, overlay;
4382 struct Lisp_Overlay *tail;
4383 /* 1 if this change is an insertion. */
4384 int insertion = (after ? XFASTINT (arg3) == 0 : EQ (start, end));
4385 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4387 overlay = Qnil;
4388 tail = NULL;
4390 /* We used to run the functions as soon as we found them and only register
4391 them in last_overlay_modification_hooks for the purpose of the `after'
4392 case. But running elisp code as we traverse the list of overlays is
4393 painful because the list can be modified by the elisp code so we had to
4394 copy at several places. We now simply do a read-only traversal that
4395 only collects the functions to run and we run them afterwards. It's
4396 simpler, especially since all the code was already there. -stef */
4398 if (!after)
4400 /* We are being called before a change.
4401 Scan the overlays to find the functions to call. */
4402 last_overlay_modification_hooks_used = 0;
4403 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
4405 int startpos, endpos;
4406 Lisp_Object ostart, oend;
4408 XSETMISC (overlay, tail);
4410 ostart = OVERLAY_START (overlay);
4411 oend = OVERLAY_END (overlay);
4412 endpos = OVERLAY_POSITION (oend);
4413 if (XFASTINT (start) > endpos)
4414 break;
4415 startpos = OVERLAY_POSITION (ostart);
4416 if (insertion && (XFASTINT (start) == startpos
4417 || XFASTINT (end) == startpos))
4419 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
4420 if (!NILP (prop))
4421 add_overlay_mod_hooklist (prop, overlay);
4423 if (insertion && (XFASTINT (start) == endpos
4424 || XFASTINT (end) == endpos))
4426 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
4427 if (!NILP (prop))
4428 add_overlay_mod_hooklist (prop, overlay);
4430 /* Test for intersecting intervals. This does the right thing
4431 for both insertion and deletion. */
4432 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
4434 prop = Foverlay_get (overlay, Qmodification_hooks);
4435 if (!NILP (prop))
4436 add_overlay_mod_hooklist (prop, overlay);
4440 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
4442 int startpos, endpos;
4443 Lisp_Object ostart, oend;
4445 XSETMISC (overlay, tail);
4447 ostart = OVERLAY_START (overlay);
4448 oend = OVERLAY_END (overlay);
4449 startpos = OVERLAY_POSITION (ostart);
4450 endpos = OVERLAY_POSITION (oend);
4451 if (XFASTINT (end) < startpos)
4452 break;
4453 if (insertion && (XFASTINT (start) == startpos
4454 || XFASTINT (end) == startpos))
4456 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
4457 if (!NILP (prop))
4458 add_overlay_mod_hooklist (prop, overlay);
4460 if (insertion && (XFASTINT (start) == endpos
4461 || XFASTINT (end) == endpos))
4463 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
4464 if (!NILP (prop))
4465 add_overlay_mod_hooklist (prop, overlay);
4467 /* Test for intersecting intervals. This does the right thing
4468 for both insertion and deletion. */
4469 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
4471 prop = Foverlay_get (overlay, Qmodification_hooks);
4472 if (!NILP (prop))
4473 add_overlay_mod_hooklist (prop, overlay);
4478 GCPRO4 (overlay, arg1, arg2, arg3);
4480 /* Call the functions recorded in last_overlay_modification_hooks.
4481 First copy the vector contents, in case some of these hooks
4482 do subsequent modification of the buffer. */
4483 int size = last_overlay_modification_hooks_used;
4484 Lisp_Object *copy = (Lisp_Object *) alloca (size * sizeof (Lisp_Object));
4485 int i;
4487 bcopy (XVECTOR (last_overlay_modification_hooks)->contents,
4488 copy, size * sizeof (Lisp_Object));
4489 gcpro1.var = copy;
4490 gcpro1.nvars = size;
4492 for (i = 0; i < size;)
4494 Lisp_Object prop, overlay;
4495 prop = copy[i++];
4496 overlay = copy[i++];
4497 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
4500 UNGCPRO;
4503 static void
4504 call_overlay_mod_hooks (list, overlay, after, arg1, arg2, arg3)
4505 Lisp_Object list, overlay;
4506 int after;
4507 Lisp_Object arg1, arg2, arg3;
4509 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4511 GCPRO4 (list, arg1, arg2, arg3);
4513 while (CONSP (list))
4515 if (NILP (arg3))
4516 call4 (XCAR (list), overlay, after ? Qt : Qnil, arg1, arg2);
4517 else
4518 call5 (XCAR (list), overlay, after ? Qt : Qnil, arg1, arg2, arg3);
4519 list = XCDR (list);
4521 UNGCPRO;
4524 /* Delete any zero-sized overlays at position POS, if the `evaporate'
4525 property is set. */
4526 void
4527 evaporate_overlays (pos)
4528 EMACS_INT pos;
4530 Lisp_Object overlay, hit_list;
4531 struct Lisp_Overlay *tail;
4533 hit_list = Qnil;
4534 if (pos <= current_buffer->overlay_center)
4535 for (tail = current_buffer->overlays_before; tail; tail = tail->next)
4537 int endpos;
4538 XSETMISC (overlay, tail);
4539 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
4540 if (endpos < pos)
4541 break;
4542 if (endpos == pos && OVERLAY_POSITION (OVERLAY_START (overlay)) == pos
4543 && ! NILP (Foverlay_get (overlay, Qevaporate)))
4544 hit_list = Fcons (overlay, hit_list);
4546 else
4547 for (tail = current_buffer->overlays_after; tail; tail = tail->next)
4549 int startpos;
4550 XSETMISC (overlay, tail);
4551 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
4552 if (startpos > pos)
4553 break;
4554 if (startpos == pos && OVERLAY_POSITION (OVERLAY_END (overlay)) == pos
4555 && ! NILP (Foverlay_get (overlay, Qevaporate)))
4556 hit_list = Fcons (overlay, hit_list);
4558 for (; CONSP (hit_list); hit_list = XCDR (hit_list))
4559 Fdelete_overlay (XCAR (hit_list));
4562 /* Somebody has tried to store a value with an unacceptable type
4563 in the slot with offset OFFSET. */
4565 void
4566 buffer_slot_type_mismatch (newval, type)
4567 Lisp_Object newval;
4568 int type;
4570 Lisp_Object predicate;
4572 switch (type)
4574 case Lisp_Int: predicate = Qintegerp; break;
4575 case Lisp_String: predicate = Qstringp; break;
4576 case Lisp_Symbol: predicate = Qsymbolp; break;
4577 default: abort ();
4580 wrong_type_argument (predicate, newval);
4584 /***********************************************************************
4585 Allocation with mmap
4586 ***********************************************************************/
4588 #ifdef USE_MMAP_FOR_BUFFERS
4590 #include <sys/types.h>
4591 #include <sys/mman.h>
4593 #ifndef MAP_ANON
4594 #ifdef MAP_ANONYMOUS
4595 #define MAP_ANON MAP_ANONYMOUS
4596 #else
4597 #define MAP_ANON 0
4598 #endif
4599 #endif
4601 #ifndef MAP_FAILED
4602 #define MAP_FAILED ((void *) -1)
4603 #endif
4605 #include <stdio.h>
4606 #include <errno.h>
4608 #if MAP_ANON == 0
4609 #include <fcntl.h>
4610 #endif
4612 #include "coding.h"
4615 /* Memory is allocated in regions which are mapped using mmap(2).
4616 The current implementation lets the system select mapped
4617 addresses; we're not using MAP_FIXED in general, except when
4618 trying to enlarge regions.
4620 Each mapped region starts with a mmap_region structure, the user
4621 area starts after that structure, aligned to MEM_ALIGN.
4623 +-----------------------+
4624 | struct mmap_info + |
4625 | padding |
4626 +-----------------------+
4627 | user data |
4630 +-----------------------+ */
4632 struct mmap_region
4634 /* User-specified size. */
4635 size_t nbytes_specified;
4637 /* Number of bytes mapped */
4638 size_t nbytes_mapped;
4640 /* Pointer to the location holding the address of the memory
4641 allocated with the mmap'd block. The variable actually points
4642 after this structure. */
4643 POINTER_TYPE **var;
4645 /* Next and previous in list of all mmap'd regions. */
4646 struct mmap_region *next, *prev;
4649 /* Doubly-linked list of mmap'd regions. */
4651 static struct mmap_region *mmap_regions;
4653 /* File descriptor for mmap. If we don't have anonymous mapping,
4654 /dev/zero will be opened on it. */
4656 static int mmap_fd;
4658 /* Temporary storage for mmap_set_vars, see there. */
4660 static struct mmap_region *mmap_regions_1;
4661 static int mmap_fd_1;
4663 /* Page size on this system. */
4665 static int mmap_page_size;
4667 /* 1 means mmap has been intialized. */
4669 static int mmap_initialized_p;
4671 /* Value is X rounded up to the next multiple of N. */
4673 #define ROUND(X, N) (((X) + (N) - 1) / (N) * (N))
4675 /* Size of mmap_region structure plus padding. */
4677 #define MMAP_REGION_STRUCT_SIZE \
4678 ROUND (sizeof (struct mmap_region), MEM_ALIGN)
4680 /* Given a pointer P to the start of the user-visible part of a mapped
4681 region, return a pointer to the start of the region. */
4683 #define MMAP_REGION(P) \
4684 ((struct mmap_region *) ((char *) (P) - MMAP_REGION_STRUCT_SIZE))
4686 /* Given a pointer P to the start of a mapped region, return a pointer
4687 to the start of the user-visible part of the region. */
4689 #define MMAP_USER_AREA(P) \
4690 ((POINTER_TYPE *) ((char *) (P) + MMAP_REGION_STRUCT_SIZE))
4692 #define MEM_ALIGN sizeof (double)
4694 /* Predicate returning true if part of the address range [START .. END]
4695 is currently mapped. Used to prevent overwriting an existing
4696 memory mapping.
4698 Default is to conservativly assume the address range is occupied by
4699 something else. This can be overridden by system configuration
4700 files if system-specific means to determine this exists. */
4702 #ifndef MMAP_ALLOCATED_P
4703 #define MMAP_ALLOCATED_P(start, end) 1
4704 #endif
4706 /* Function prototypes. */
4708 static int mmap_free_1 P_ ((struct mmap_region *));
4709 static int mmap_enlarge P_ ((struct mmap_region *, int));
4710 static struct mmap_region *mmap_find P_ ((POINTER_TYPE *, POINTER_TYPE *));
4711 static POINTER_TYPE *mmap_alloc P_ ((POINTER_TYPE **, size_t));
4712 static POINTER_TYPE *mmap_realloc P_ ((POINTER_TYPE **, size_t));
4713 static void mmap_free P_ ((POINTER_TYPE **ptr));
4714 static void mmap_init P_ ((void));
4717 /* Return a region overlapping address range START...END, or null if
4718 none. END is not including, i.e. the last byte in the range
4719 is at END - 1. */
4721 static struct mmap_region *
4722 mmap_find (start, end)
4723 POINTER_TYPE *start, *end;
4725 struct mmap_region *r;
4726 char *s = (char *) start, *e = (char *) end;
4728 for (r = mmap_regions; r; r = r->next)
4730 char *rstart = (char *) r;
4731 char *rend = rstart + r->nbytes_mapped;
4733 if (/* First byte of range, i.e. START, in this region? */
4734 (s >= rstart && s < rend)
4735 /* Last byte of range, i.e. END - 1, in this region? */
4736 || (e > rstart && e <= rend)
4737 /* First byte of this region in the range? */
4738 || (rstart >= s && rstart < e)
4739 /* Last byte of this region in the range? */
4740 || (rend > s && rend <= e))
4741 break;
4744 return r;
4748 /* Unmap a region. P is a pointer to the start of the user-araa of
4749 the region. Value is non-zero if successful. */
4751 static int
4752 mmap_free_1 (r)
4753 struct mmap_region *r;
4755 if (r->next)
4756 r->next->prev = r->prev;
4757 if (r->prev)
4758 r->prev->next = r->next;
4759 else
4760 mmap_regions = r->next;
4762 if (munmap ((POINTER_TYPE *) r, r->nbytes_mapped) == -1)
4764 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4765 return 0;
4768 return 1;
4772 /* Enlarge region R by NPAGES pages. NPAGES < 0 means shrink R.
4773 Value is non-zero if successful. */
4775 static int
4776 mmap_enlarge (r, npages)
4777 struct mmap_region *r;
4778 int npages;
4780 char *region_end = (char *) r + r->nbytes_mapped;
4781 size_t nbytes;
4782 int success = 0;
4784 if (npages < 0)
4786 /* Unmap pages at the end of the region. */
4787 nbytes = - npages * mmap_page_size;
4788 if (munmap (region_end - nbytes, nbytes) == -1)
4789 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4790 else
4792 r->nbytes_mapped -= nbytes;
4793 success = 1;
4796 else if (npages > 0)
4798 nbytes = npages * mmap_page_size;
4800 /* Try to map additional pages at the end of the region. We
4801 cannot do this if the address range is already occupied by
4802 something else because mmap deletes any previous mapping.
4803 I'm not sure this is worth doing, let's see. */
4804 if (!MMAP_ALLOCATED_P (region_end, region_end + nbytes))
4806 POINTER_TYPE *p;
4808 p = mmap (region_end, nbytes, PROT_READ | PROT_WRITE,
4809 MAP_ANON | MAP_PRIVATE | MAP_FIXED, mmap_fd, 0);
4810 if (p == MAP_FAILED)
4811 ; /* fprintf (stderr, "mmap: %s\n", emacs_strerror (errno)); */
4812 else if (p != (POINTER_TYPE *) region_end)
4814 /* Kernels are free to choose a different address. In
4815 that case, unmap what we've mapped above; we have
4816 no use for it. */
4817 if (munmap (p, nbytes) == -1)
4818 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4820 else
4822 r->nbytes_mapped += nbytes;
4823 success = 1;
4828 return success;
4832 /* Set or reset variables holding references to mapped regions. If
4833 RESTORE_P is zero, set all variables to null. If RESTORE_P is
4834 non-zero, set all variables to the start of the user-areas
4835 of mapped regions.
4837 This function is called from Fdump_emacs to ensure that the dumped
4838 Emacs doesn't contain references to memory that won't be mapped
4839 when Emacs starts. */
4841 void
4842 mmap_set_vars (restore_p)
4843 int restore_p;
4845 struct mmap_region *r;
4847 if (restore_p)
4849 mmap_regions = mmap_regions_1;
4850 mmap_fd = mmap_fd_1;
4851 for (r = mmap_regions; r; r = r->next)
4852 *r->var = MMAP_USER_AREA (r);
4854 else
4856 for (r = mmap_regions; r; r = r->next)
4857 *r->var = NULL;
4858 mmap_regions_1 = mmap_regions;
4859 mmap_regions = NULL;
4860 mmap_fd_1 = mmap_fd;
4861 mmap_fd = -1;
4866 /* Allocate a block of storage large enough to hold NBYTES bytes of
4867 data. A pointer to the data is returned in *VAR. VAR is thus the
4868 address of some variable which will use the data area.
4870 The allocation of 0 bytes is valid.
4872 If we can't allocate the necessary memory, set *VAR to null, and
4873 return null. */
4875 static POINTER_TYPE *
4876 mmap_alloc (var, nbytes)
4877 POINTER_TYPE **var;
4878 size_t nbytes;
4880 void *p;
4881 size_t map;
4883 mmap_init ();
4885 map = ROUND (nbytes + MMAP_REGION_STRUCT_SIZE, mmap_page_size);
4886 p = mmap (NULL, map, PROT_READ | PROT_WRITE, MAP_ANON | MAP_PRIVATE,
4887 mmap_fd, 0);
4889 if (p == MAP_FAILED)
4891 if (errno != ENOMEM)
4892 fprintf (stderr, "mmap: %s\n", emacs_strerror (errno));
4893 p = NULL;
4895 else
4897 struct mmap_region *r = (struct mmap_region *) p;
4899 r->nbytes_specified = nbytes;
4900 r->nbytes_mapped = map;
4901 r->var = var;
4902 r->prev = NULL;
4903 r->next = mmap_regions;
4904 if (r->next)
4905 r->next->prev = r;
4906 mmap_regions = r;
4908 p = MMAP_USER_AREA (p);
4911 return *var = p;
4915 /* Given a pointer at address VAR to data allocated with mmap_alloc,
4916 resize it to size NBYTES. Change *VAR to reflect the new block,
4917 and return this value. If more memory cannot be allocated, then
4918 leave *VAR unchanged, and return null. */
4920 static POINTER_TYPE *
4921 mmap_realloc (var, nbytes)
4922 POINTER_TYPE **var;
4923 size_t nbytes;
4925 POINTER_TYPE *result;
4927 mmap_init ();
4929 if (*var == NULL)
4930 result = mmap_alloc (var, nbytes);
4931 else if (nbytes == 0)
4933 mmap_free (var);
4934 result = mmap_alloc (var, nbytes);
4936 else
4938 struct mmap_region *r = MMAP_REGION (*var);
4939 size_t room = r->nbytes_mapped - MMAP_REGION_STRUCT_SIZE;
4941 if (room < nbytes)
4943 /* Must enlarge. */
4944 POINTER_TYPE *old_ptr = *var;
4946 /* Try to map additional pages at the end of the region.
4947 If that fails, allocate a new region, copy data
4948 from the old region, then free it. */
4949 if (mmap_enlarge (r, (ROUND (nbytes - room, mmap_page_size)
4950 / mmap_page_size)))
4952 r->nbytes_specified = nbytes;
4953 *var = result = old_ptr;
4955 else if (mmap_alloc (var, nbytes))
4957 bcopy (old_ptr, *var, r->nbytes_specified);
4958 mmap_free_1 (MMAP_REGION (old_ptr));
4959 result = *var;
4960 r = MMAP_REGION (result);
4961 r->nbytes_specified = nbytes;
4963 else
4965 *var = old_ptr;
4966 result = NULL;
4969 else if (room - nbytes >= mmap_page_size)
4971 /* Shrinking by at least a page. Let's give some
4972 memory back to the system.
4974 The extra parens are to make the division happens first,
4975 on positive values, so we know it will round towards
4976 zero. */
4977 mmap_enlarge (r, - ((room - nbytes) / mmap_page_size));
4978 result = *var;
4979 r->nbytes_specified = nbytes;
4981 else
4983 /* Leave it alone. */
4984 result = *var;
4985 r->nbytes_specified = nbytes;
4989 return result;
4993 /* Free a block of relocatable storage whose data is pointed to by
4994 PTR. Store 0 in *PTR to show there's no block allocated. */
4996 static void
4997 mmap_free (var)
4998 POINTER_TYPE **var;
5000 mmap_init ();
5002 if (*var)
5004 mmap_free_1 (MMAP_REGION (*var));
5005 *var = NULL;
5010 /* Perform necessary intializations for the use of mmap. */
5012 static void
5013 mmap_init ()
5015 #if MAP_ANON == 0
5016 /* The value of mmap_fd is initially 0 in temacs, and -1
5017 in a dumped Emacs. */
5018 if (mmap_fd <= 0)
5020 /* No anonymous mmap -- we need the file descriptor. */
5021 mmap_fd = open ("/dev/zero", O_RDONLY);
5022 if (mmap_fd == -1)
5023 fatal ("Cannot open /dev/zero: %s", emacs_strerror (errno));
5025 #endif /* MAP_ANON == 0 */
5027 if (mmap_initialized_p)
5028 return;
5029 mmap_initialized_p = 1;
5031 #if MAP_ANON != 0
5032 mmap_fd = -1;
5033 #endif
5035 mmap_page_size = getpagesize ();
5038 #endif /* USE_MMAP_FOR_BUFFERS */
5042 /***********************************************************************
5043 Buffer-text Allocation
5044 ***********************************************************************/
5046 #ifdef REL_ALLOC
5047 extern POINTER_TYPE *r_alloc P_ ((POINTER_TYPE **, size_t));
5048 extern POINTER_TYPE *r_re_alloc P_ ((POINTER_TYPE **, size_t));
5049 extern void r_alloc_free P_ ((POINTER_TYPE **ptr));
5050 #endif /* REL_ALLOC */
5053 /* Allocate NBYTES bytes for buffer B's text buffer. */
5055 static void
5056 alloc_buffer_text (b, nbytes)
5057 struct buffer *b;
5058 size_t nbytes;
5060 POINTER_TYPE *p;
5062 BLOCK_INPUT;
5063 #if defined USE_MMAP_FOR_BUFFERS
5064 p = mmap_alloc ((POINTER_TYPE **) &b->text->beg, nbytes);
5065 #elif defined REL_ALLOC
5066 p = r_alloc ((POINTER_TYPE **) &b->text->beg, nbytes);
5067 #else
5068 p = xmalloc (nbytes);
5069 #endif
5071 if (p == NULL)
5073 UNBLOCK_INPUT;
5074 memory_full ();
5077 b->text->beg = (unsigned char *) p;
5078 UNBLOCK_INPUT;
5081 /* Enlarge buffer B's text buffer by DELTA bytes. DELTA < 0 means
5082 shrink it. */
5084 void
5085 enlarge_buffer_text (struct buffer *b, EMACS_INT delta)
5087 POINTER_TYPE *p;
5088 size_t nbytes = (BUF_Z_BYTE (b) - BUF_BEG_BYTE (b) + BUF_GAP_SIZE (b) + 1
5089 + delta);
5090 BLOCK_INPUT;
5091 #if defined USE_MMAP_FOR_BUFFERS
5092 p = mmap_realloc ((POINTER_TYPE **) &b->text->beg, nbytes);
5093 #elif defined REL_ALLOC
5094 p = r_re_alloc ((POINTER_TYPE **) &b->text->beg, nbytes);
5095 #else
5096 p = xrealloc (b->text->beg, nbytes);
5097 #endif
5099 if (p == NULL)
5101 UNBLOCK_INPUT;
5102 memory_full ();
5105 BUF_BEG_ADDR (b) = (unsigned char *) p;
5106 UNBLOCK_INPUT;
5110 /* Free buffer B's text buffer. */
5112 static void
5113 free_buffer_text (b)
5114 struct buffer *b;
5116 BLOCK_INPUT;
5118 #if defined USE_MMAP_FOR_BUFFERS
5119 mmap_free ((POINTER_TYPE **) &b->text->beg);
5120 #elif defined REL_ALLOC
5121 r_alloc_free ((POINTER_TYPE **) &b->text->beg);
5122 #else
5123 xfree (b->text->beg);
5124 #endif
5126 BUF_BEG_ADDR (b) = NULL;
5127 UNBLOCK_INPUT;
5132 /***********************************************************************
5133 Initialization
5134 ***********************************************************************/
5136 void
5137 init_buffer_once ()
5139 int idx;
5141 bzero (buffer_permanent_local_flags, sizeof buffer_permanent_local_flags);
5143 /* Make sure all markable slots in buffer_defaults
5144 are initialized reasonably, so mark_buffer won't choke. */
5145 reset_buffer (&buffer_defaults);
5146 reset_buffer_local_variables (&buffer_defaults, 1);
5147 reset_buffer (&buffer_local_symbols);
5148 reset_buffer_local_variables (&buffer_local_symbols, 1);
5149 /* Prevent GC from getting confused. */
5150 buffer_defaults.text = &buffer_defaults.own_text;
5151 buffer_local_symbols.text = &buffer_local_symbols.own_text;
5152 BUF_INTERVALS (&buffer_defaults) = 0;
5153 BUF_INTERVALS (&buffer_local_symbols) = 0;
5154 XSETPVECTYPE (&buffer_defaults, PVEC_BUFFER);
5155 XSETBUFFER (Vbuffer_defaults, &buffer_defaults);
5156 XSETPVECTYPE (&buffer_local_symbols, PVEC_BUFFER);
5157 XSETBUFFER (Vbuffer_local_symbols, &buffer_local_symbols);
5159 /* Set up the default values of various buffer slots. */
5160 /* Must do these before making the first buffer! */
5162 /* real setup is done in bindings.el */
5163 buffer_defaults.mode_line_format = build_string ("%-");
5164 buffer_defaults.header_line_format = Qnil;
5165 buffer_defaults.abbrev_mode = Qnil;
5166 buffer_defaults.overwrite_mode = Qnil;
5167 buffer_defaults.case_fold_search = Qt;
5168 buffer_defaults.auto_fill_function = Qnil;
5169 buffer_defaults.selective_display = Qnil;
5170 #ifndef old
5171 buffer_defaults.selective_display_ellipses = Qt;
5172 #endif
5173 buffer_defaults.abbrev_table = Qnil;
5174 buffer_defaults.display_table = Qnil;
5175 buffer_defaults.undo_list = Qnil;
5176 buffer_defaults.mark_active = Qnil;
5177 buffer_defaults.file_format = Qnil;
5178 buffer_defaults.auto_save_file_format = Qt;
5179 buffer_defaults.overlays_before = NULL;
5180 buffer_defaults.overlays_after = NULL;
5181 buffer_defaults.overlay_center = BEG;
5183 XSETFASTINT (buffer_defaults.tab_width, 8);
5184 buffer_defaults.truncate_lines = Qnil;
5185 buffer_defaults.word_wrap = Qnil;
5186 buffer_defaults.ctl_arrow = Qt;
5187 buffer_defaults.direction_reversed = Qnil;
5188 buffer_defaults.cursor_type = Qt;
5189 buffer_defaults.extra_line_spacing = Qnil;
5190 buffer_defaults.cursor_in_non_selected_windows = Qt;
5192 #ifdef DOS_NT
5193 buffer_defaults.buffer_file_type = Qnil; /* TEXT */
5194 #endif
5195 buffer_defaults.enable_multibyte_characters = Qt;
5196 buffer_defaults.buffer_file_coding_system = Qnil;
5197 XSETFASTINT (buffer_defaults.fill_column, 70);
5198 XSETFASTINT (buffer_defaults.left_margin, 0);
5199 buffer_defaults.cache_long_line_scans = Qnil;
5200 buffer_defaults.file_truename = Qnil;
5201 XSETFASTINT (buffer_defaults.display_count, 0);
5202 XSETFASTINT (buffer_defaults.left_margin_cols, 0);
5203 XSETFASTINT (buffer_defaults.right_margin_cols, 0);
5204 buffer_defaults.left_fringe_width = Qnil;
5205 buffer_defaults.right_fringe_width = Qnil;
5206 buffer_defaults.fringes_outside_margins = Qnil;
5207 buffer_defaults.scroll_bar_width = Qnil;
5208 buffer_defaults.vertical_scroll_bar_type = Qt;
5209 buffer_defaults.indicate_empty_lines = Qnil;
5210 buffer_defaults.indicate_buffer_boundaries = Qnil;
5211 buffer_defaults.fringe_indicator_alist = Qnil;
5212 buffer_defaults.fringe_cursor_alist = Qnil;
5213 buffer_defaults.scroll_up_aggressively = Qnil;
5214 buffer_defaults.scroll_down_aggressively = Qnil;
5215 buffer_defaults.display_time = Qnil;
5217 /* Assign the local-flags to the slots that have default values.
5218 The local flag is a bit that is used in the buffer
5219 to say that it has its own local value for the slot.
5220 The local flag bits are in the local_var_flags slot of the buffer. */
5222 /* Nothing can work if this isn't true */
5223 if (sizeof (EMACS_INT) != sizeof (Lisp_Object)) abort ();
5225 /* 0 means not a lisp var, -1 means always local, else mask */
5226 bzero (&buffer_local_flags, sizeof buffer_local_flags);
5227 XSETINT (buffer_local_flags.filename, -1);
5228 XSETINT (buffer_local_flags.directory, -1);
5229 XSETINT (buffer_local_flags.backed_up, -1);
5230 XSETINT (buffer_local_flags.save_length, -1);
5231 XSETINT (buffer_local_flags.auto_save_file_name, -1);
5232 XSETINT (buffer_local_flags.read_only, -1);
5233 XSETINT (buffer_local_flags.major_mode, -1);
5234 XSETINT (buffer_local_flags.mode_name, -1);
5235 XSETINT (buffer_local_flags.undo_list, -1);
5236 XSETINT (buffer_local_flags.mark_active, -1);
5237 XSETINT (buffer_local_flags.point_before_scroll, -1);
5238 XSETINT (buffer_local_flags.file_truename, -1);
5239 XSETINT (buffer_local_flags.invisibility_spec, -1);
5240 XSETINT (buffer_local_flags.file_format, -1);
5241 XSETINT (buffer_local_flags.auto_save_file_format, -1);
5242 XSETINT (buffer_local_flags.display_count, -1);
5243 XSETINT (buffer_local_flags.display_time, -1);
5244 XSETINT (buffer_local_flags.enable_multibyte_characters, -1);
5246 idx = 1;
5247 XSETFASTINT (buffer_local_flags.mode_line_format, idx); ++idx;
5248 XSETFASTINT (buffer_local_flags.abbrev_mode, idx); ++idx;
5249 XSETFASTINT (buffer_local_flags.overwrite_mode, idx); ++idx;
5250 XSETFASTINT (buffer_local_flags.case_fold_search, idx); ++idx;
5251 XSETFASTINT (buffer_local_flags.auto_fill_function, idx); ++idx;
5252 XSETFASTINT (buffer_local_flags.selective_display, idx); ++idx;
5253 #ifndef old
5254 XSETFASTINT (buffer_local_flags.selective_display_ellipses, idx); ++idx;
5255 #endif
5256 XSETFASTINT (buffer_local_flags.tab_width, idx); ++idx;
5257 XSETFASTINT (buffer_local_flags.truncate_lines, idx); ++idx;
5258 XSETFASTINT (buffer_local_flags.word_wrap, idx); ++idx;
5259 XSETFASTINT (buffer_local_flags.ctl_arrow, idx); ++idx;
5260 XSETFASTINT (buffer_local_flags.fill_column, idx); ++idx;
5261 XSETFASTINT (buffer_local_flags.left_margin, idx); ++idx;
5262 XSETFASTINT (buffer_local_flags.abbrev_table, idx); ++idx;
5263 XSETFASTINT (buffer_local_flags.display_table, idx); ++idx;
5264 #ifdef DOS_NT
5265 XSETFASTINT (buffer_local_flags.buffer_file_type, idx);
5266 /* Make this one a permanent local. */
5267 buffer_permanent_local_flags[idx++] = 1;
5268 #endif
5269 XSETFASTINT (buffer_local_flags.syntax_table, idx); ++idx;
5270 XSETFASTINT (buffer_local_flags.cache_long_line_scans, idx); ++idx;
5271 XSETFASTINT (buffer_local_flags.category_table, idx); ++idx;
5272 XSETFASTINT (buffer_local_flags.direction_reversed, idx); ++idx;
5273 XSETFASTINT (buffer_local_flags.buffer_file_coding_system, idx);
5274 /* Make this one a permanent local. */
5275 buffer_permanent_local_flags[idx++] = 1;
5276 XSETFASTINT (buffer_local_flags.left_margin_cols, idx); ++idx;
5277 XSETFASTINT (buffer_local_flags.right_margin_cols, idx); ++idx;
5278 XSETFASTINT (buffer_local_flags.left_fringe_width, idx); ++idx;
5279 XSETFASTINT (buffer_local_flags.right_fringe_width, idx); ++idx;
5280 XSETFASTINT (buffer_local_flags.fringes_outside_margins, idx); ++idx;
5281 XSETFASTINT (buffer_local_flags.scroll_bar_width, idx); ++idx;
5282 XSETFASTINT (buffer_local_flags.vertical_scroll_bar_type, idx); ++idx;
5283 XSETFASTINT (buffer_local_flags.indicate_empty_lines, idx); ++idx;
5284 XSETFASTINT (buffer_local_flags.indicate_buffer_boundaries, idx); ++idx;
5285 XSETFASTINT (buffer_local_flags.fringe_indicator_alist, idx); ++idx;
5286 XSETFASTINT (buffer_local_flags.fringe_cursor_alist, idx); ++idx;
5287 XSETFASTINT (buffer_local_flags.scroll_up_aggressively, idx); ++idx;
5288 XSETFASTINT (buffer_local_flags.scroll_down_aggressively, idx); ++idx;
5289 XSETFASTINT (buffer_local_flags.header_line_format, idx); ++idx;
5290 XSETFASTINT (buffer_local_flags.cursor_type, idx); ++idx;
5291 XSETFASTINT (buffer_local_flags.extra_line_spacing, idx); ++idx;
5292 XSETFASTINT (buffer_local_flags.cursor_in_non_selected_windows, idx); ++idx;
5294 /* Need more room? */
5295 if (idx >= MAX_PER_BUFFER_VARS)
5296 abort ();
5297 last_per_buffer_idx = idx;
5299 Vbuffer_alist = Qnil;
5300 current_buffer = 0;
5301 all_buffers = 0;
5303 QSFundamental = build_string ("Fundamental");
5305 Qfundamental_mode = intern ("fundamental-mode");
5306 buffer_defaults.major_mode = Qfundamental_mode;
5308 Qmode_class = intern ("mode-class");
5310 Qprotected_field = intern ("protected-field");
5312 Qpermanent_local = intern ("permanent-local");
5314 Qkill_buffer_hook = intern ("kill-buffer-hook");
5315 Fput (Qkill_buffer_hook, Qpermanent_local, Qt);
5317 Qucs_set_table_for_input = intern ("ucs-set-table-for-input");
5319 /* super-magic invisible buffer */
5320 Vprin1_to_string_buffer = Fget_buffer_create (build_string (" prin1"));
5321 Vbuffer_alist = Qnil;
5323 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
5325 inhibit_modification_hooks = 0;
5328 void
5329 init_buffer ()
5331 char *pwd;
5332 Lisp_Object temp;
5333 int len;
5335 #ifdef USE_MMAP_FOR_BUFFERS
5337 /* When using the ralloc implementation based on mmap(2), buffer
5338 text pointers will have been set to null in the dumped Emacs.
5339 Map new memory. */
5340 struct buffer *b;
5342 for (b = all_buffers; b; b = b->next)
5343 if (b->text->beg == NULL)
5344 enlarge_buffer_text (b, 0);
5346 #endif /* USE_MMAP_FOR_BUFFERS */
5348 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
5349 if (NILP (buffer_defaults.enable_multibyte_characters))
5350 Fset_buffer_multibyte (Qnil);
5352 pwd = get_current_dir_name ();
5354 if (!pwd)
5355 fatal ("`get_current_dir_name' failed: %s\n", strerror (errno));
5357 /* Maybe this should really use some standard subroutine
5358 whose definition is filename syntax dependent. */
5359 len = strlen (pwd);
5360 if (!(IS_DIRECTORY_SEP (pwd[len - 1])))
5362 /* Grow buffer to add directory separator and '\0'. */
5363 pwd = (char *) realloc (pwd, len + 2);
5364 if (!pwd)
5365 fatal ("`get_current_dir_name' failed: %s\n", strerror (errno));
5366 pwd[len] = DIRECTORY_SEP;
5367 pwd[len + 1] = '\0';
5370 current_buffer->directory = make_unibyte_string (pwd, strlen (pwd));
5371 if (! NILP (buffer_defaults.enable_multibyte_characters))
5372 /* At this moment, we still don't know how to decode the
5373 directory name. So, we keep the bytes in multibyte form so
5374 that ENCODE_FILE correctly gets the original bytes. */
5375 current_buffer->directory
5376 = string_to_multibyte (current_buffer->directory);
5378 /* Add /: to the front of the name
5379 if it would otherwise be treated as magic. */
5380 temp = Ffind_file_name_handler (current_buffer->directory, Qt);
5381 if (! NILP (temp)
5382 /* If the default dir is just /, TEMP is non-nil
5383 because of the ange-ftp completion handler.
5384 However, it is not necessary to turn / into /:/.
5385 So avoid doing that. */
5386 && strcmp ("/", SDATA (current_buffer->directory)))
5387 current_buffer->directory
5388 = concat2 (build_string ("/:"), current_buffer->directory);
5390 temp = get_minibuffer (0);
5391 XBUFFER (temp)->directory = current_buffer->directory;
5393 free (pwd);
5396 /* Similar to defvar_lisp but define a variable whose value is the Lisp
5397 Object stored in the current buffer. address is the address of the slot
5398 in the buffer that is current now. */
5400 /* TYPE is nil for a general Lisp variable.
5401 An integer specifies a type; then only LIsp values
5402 with that type code are allowed (except that nil is allowed too).
5403 LNAME is the LIsp-level variable name.
5404 VNAME is the name of the buffer slot.
5405 DOC is a dummy where you write the doc string as a comment. */
5406 #define DEFVAR_PER_BUFFER(lname, vname, type, doc) \
5407 defvar_per_buffer (lname, vname, type, 0)
5409 static void
5410 defvar_per_buffer (namestring, address, type, doc)
5411 char *namestring;
5412 Lisp_Object *address;
5413 Lisp_Object type;
5414 char *doc;
5416 Lisp_Object sym, val;
5417 int offset;
5419 sym = intern (namestring);
5420 val = allocate_misc ();
5421 offset = (char *)address - (char *)current_buffer;
5423 XMISCTYPE (val) = Lisp_Misc_Buffer_Objfwd;
5424 XBUFFER_OBJFWD (val)->offset = offset;
5425 XBUFFER_OBJFWD (val)->slottype = type;
5426 SET_SYMBOL_VALUE (sym, val);
5427 PER_BUFFER_SYMBOL (offset) = sym;
5429 if (PER_BUFFER_IDX (offset) == 0)
5430 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
5431 slot of buffer_local_flags */
5432 abort ();
5436 /* initialize the buffer routines */
5437 void
5438 syms_of_buffer ()
5440 staticpro (&last_overlay_modification_hooks);
5441 last_overlay_modification_hooks
5442 = Fmake_vector (make_number (10), Qnil);
5444 staticpro (&Vbuffer_defaults);
5445 staticpro (&Vbuffer_local_symbols);
5446 staticpro (&Qfundamental_mode);
5447 staticpro (&Qmode_class);
5448 staticpro (&QSFundamental);
5449 staticpro (&Vbuffer_alist);
5450 staticpro (&Qprotected_field);
5451 staticpro (&Qpermanent_local);
5452 Qpermanent_local_hook = intern ("permanent-local-hook");
5453 staticpro (&Qpermanent_local_hook);
5454 staticpro (&Qkill_buffer_hook);
5455 Qoverlayp = intern ("overlayp");
5456 staticpro (&Qoverlayp);
5457 Qevaporate = intern ("evaporate");
5458 staticpro (&Qevaporate);
5459 Qmodification_hooks = intern ("modification-hooks");
5460 staticpro (&Qmodification_hooks);
5461 Qinsert_in_front_hooks = intern ("insert-in-front-hooks");
5462 staticpro (&Qinsert_in_front_hooks);
5463 Qinsert_behind_hooks = intern ("insert-behind-hooks");
5464 staticpro (&Qinsert_behind_hooks);
5465 Qget_file_buffer = intern ("get-file-buffer");
5466 staticpro (&Qget_file_buffer);
5467 Qpriority = intern ("priority");
5468 staticpro (&Qpriority);
5469 Qwindow = intern ("window");
5470 staticpro (&Qwindow);
5471 Qbefore_string = intern ("before-string");
5472 staticpro (&Qbefore_string);
5473 Qafter_string = intern ("after-string");
5474 staticpro (&Qafter_string);
5475 Qfirst_change_hook = intern ("first-change-hook");
5476 staticpro (&Qfirst_change_hook);
5477 Qbefore_change_functions = intern ("before-change-functions");
5478 staticpro (&Qbefore_change_functions);
5479 Qafter_change_functions = intern ("after-change-functions");
5480 staticpro (&Qafter_change_functions);
5481 /* The next one is initialized in init_buffer_once. */
5482 staticpro (&Qucs_set_table_for_input);
5484 Qkill_buffer_query_functions = intern ("kill-buffer-query-functions");
5485 staticpro (&Qkill_buffer_query_functions);
5487 Fput (Qprotected_field, Qerror_conditions,
5488 Fcons (Qprotected_field, Fcons (Qerror, Qnil)));
5489 Fput (Qprotected_field, Qerror_message,
5490 build_string ("Attempt to modify a protected field"));
5492 /* All these use DEFVAR_LISP_NOPRO because the slots in
5493 buffer_defaults will all be marked via Vbuffer_defaults. */
5495 DEFVAR_LISP_NOPRO ("default-mode-line-format",
5496 &buffer_defaults.mode_line_format,
5497 doc: /* Default value of `mode-line-format' for buffers that don't override it.
5498 This is the same as (default-value 'mode-line-format). */);
5500 DEFVAR_LISP_NOPRO ("default-header-line-format",
5501 &buffer_defaults.header_line_format,
5502 doc: /* Default value of `header-line-format' for buffers that don't override it.
5503 This is the same as (default-value 'header-line-format). */);
5505 DEFVAR_LISP_NOPRO ("default-cursor-type", &buffer_defaults.cursor_type,
5506 doc: /* Default value of `cursor-type' for buffers that don't override it.
5507 This is the same as (default-value 'cursor-type). */);
5509 DEFVAR_LISP_NOPRO ("default-line-spacing",
5510 &buffer_defaults.extra_line_spacing,
5511 doc: /* Default value of `line-spacing' for buffers that don't override it.
5512 This is the same as (default-value 'line-spacing). */);
5514 DEFVAR_LISP_NOPRO ("default-cursor-in-non-selected-windows",
5515 &buffer_defaults.cursor_in_non_selected_windows,
5516 doc: /* Default value of `cursor-in-non-selected-windows'.
5517 This is the same as (default-value 'cursor-in-non-selected-windows). */);
5519 DEFVAR_LISP_NOPRO ("default-abbrev-mode",
5520 &buffer_defaults.abbrev_mode,
5521 doc: /* Default value of `abbrev-mode' for buffers that do not override it.
5522 This is the same as (default-value 'abbrev-mode). */);
5524 DEFVAR_LISP_NOPRO ("default-ctl-arrow",
5525 &buffer_defaults.ctl_arrow,
5526 doc: /* Default value of `ctl-arrow' for buffers that do not override it.
5527 This is the same as (default-value 'ctl-arrow). */);
5529 DEFVAR_LISP_NOPRO ("default-direction-reversed",
5530 &buffer_defaults.direction_reversed,
5531 doc: /* Default value of `direction-reversed' for buffers that do not override it.
5532 This is the same as (default-value 'direction-reversed). */);
5534 DEFVAR_LISP_NOPRO ("default-enable-multibyte-characters",
5535 &buffer_defaults.enable_multibyte_characters,
5536 doc: /* *Default value of `enable-multibyte-characters' for buffers not overriding it.
5537 This is the same as (default-value 'enable-multibyte-characters). */);
5539 DEFVAR_LISP_NOPRO ("default-buffer-file-coding-system",
5540 &buffer_defaults.buffer_file_coding_system,
5541 doc: /* Default value of `buffer-file-coding-system' for buffers not overriding it.
5542 This is the same as (default-value 'buffer-file-coding-system). */);
5544 DEFVAR_LISP_NOPRO ("default-truncate-lines",
5545 &buffer_defaults.truncate_lines,
5546 doc: /* Default value of `truncate-lines' for buffers that do not override it.
5547 This is the same as (default-value 'truncate-lines). */);
5549 DEFVAR_LISP_NOPRO ("default-fill-column",
5550 &buffer_defaults.fill_column,
5551 doc: /* Default value of `fill-column' for buffers that do not override it.
5552 This is the same as (default-value 'fill-column). */);
5554 DEFVAR_LISP_NOPRO ("default-left-margin",
5555 &buffer_defaults.left_margin,
5556 doc: /* Default value of `left-margin' for buffers that do not override it.
5557 This is the same as (default-value 'left-margin). */);
5559 DEFVAR_LISP_NOPRO ("default-tab-width",
5560 &buffer_defaults.tab_width,
5561 doc: /* Default value of `tab-width' for buffers that do not override it.
5562 This is the same as (default-value 'tab-width). */);
5564 DEFVAR_LISP_NOPRO ("default-case-fold-search",
5565 &buffer_defaults.case_fold_search,
5566 doc: /* Default value of `case-fold-search' for buffers that don't override it.
5567 This is the same as (default-value 'case-fold-search). */);
5569 #ifdef DOS_NT
5570 DEFVAR_LISP_NOPRO ("default-buffer-file-type",
5571 &buffer_defaults.buffer_file_type,
5572 doc: /* Default file type for buffers that do not override it.
5573 This is the same as (default-value 'buffer-file-type).
5574 The file type is nil for text, t for binary. */);
5575 #endif
5577 DEFVAR_LISP_NOPRO ("default-left-margin-width",
5578 &buffer_defaults.left_margin_cols,
5579 doc: /* Default value of `left-margin-width' for buffers that don't override it.
5580 This is the same as (default-value 'left-margin-width). */);
5582 DEFVAR_LISP_NOPRO ("default-right-margin-width",
5583 &buffer_defaults.right_margin_cols,
5584 doc: /* Default value of `right-margin-width' for buffers that don't override it.
5585 This is the same as (default-value 'right-margin-width). */);
5587 DEFVAR_LISP_NOPRO ("default-left-fringe-width",
5588 &buffer_defaults.left_fringe_width,
5589 doc: /* Default value of `left-fringe-width' for buffers that don't override it.
5590 This is the same as (default-value 'left-fringe-width). */);
5592 DEFVAR_LISP_NOPRO ("default-right-fringe-width",
5593 &buffer_defaults.right_fringe_width,
5594 doc: /* Default value of `right-fringe-width' for buffers that don't override it.
5595 This is the same as (default-value 'right-fringe-width). */);
5597 DEFVAR_LISP_NOPRO ("default-fringes-outside-margins",
5598 &buffer_defaults.fringes_outside_margins,
5599 doc: /* Default value of `fringes-outside-margins' for buffers that don't override it.
5600 This is the same as (default-value 'fringes-outside-margins). */);
5602 DEFVAR_LISP_NOPRO ("default-scroll-bar-width",
5603 &buffer_defaults.scroll_bar_width,
5604 doc: /* Default value of `scroll-bar-width' for buffers that don't override it.
5605 This is the same as (default-value 'scroll-bar-width). */);
5607 DEFVAR_LISP_NOPRO ("default-vertical-scroll-bar",
5608 &buffer_defaults.vertical_scroll_bar_type,
5609 doc: /* Default value of `vertical-scroll-bar' for buffers that don't override it.
5610 This is the same as (default-value 'vertical-scroll-bar). */);
5612 DEFVAR_LISP_NOPRO ("default-indicate-empty-lines",
5613 &buffer_defaults.indicate_empty_lines,
5614 doc: /* Default value of `indicate-empty-lines' for buffers that don't override it.
5615 This is the same as (default-value 'indicate-empty-lines). */);
5617 DEFVAR_LISP_NOPRO ("default-indicate-buffer-boundaries",
5618 &buffer_defaults.indicate_buffer_boundaries,
5619 doc: /* Default value of `indicate-buffer-boundaries' for buffers that don't override it.
5620 This is the same as (default-value 'indicate-buffer-boundaries). */);
5622 DEFVAR_LISP_NOPRO ("default-fringe-indicator-alist",
5623 &buffer_defaults.fringe_indicator_alist,
5624 doc: /* Default value of `fringe-indicator-alist' for buffers that don't override it.
5625 This is the same as (default-value 'fringe-indicator-alist'). */);
5627 DEFVAR_LISP_NOPRO ("default-fringe-cursor-alist",
5628 &buffer_defaults.fringe_cursor_alist,
5629 doc: /* Default value of `fringe-cursor-alist' for buffers that don't override it.
5630 This is the same as (default-value 'fringe-cursor-alist'). */);
5632 DEFVAR_LISP_NOPRO ("default-scroll-up-aggressively",
5633 &buffer_defaults.scroll_up_aggressively,
5634 doc: /* Default value of `scroll-up-aggressively'.
5635 This value applies in buffers that don't have their own local values.
5636 This is the same as (default-value 'scroll-up-aggressively). */);
5638 DEFVAR_LISP_NOPRO ("default-scroll-down-aggressively",
5639 &buffer_defaults.scroll_down_aggressively,
5640 doc: /* Default value of `scroll-down-aggressively'.
5641 This value applies in buffers that don't have their own local values.
5642 This is the same as (default-value 'scroll-down-aggressively). */);
5644 DEFVAR_PER_BUFFER ("header-line-format",
5645 &current_buffer->header_line_format,
5646 Qnil,
5647 doc: /* Analogous to `mode-line-format', but controls the header line.
5648 The header line appears, optionally, at the top of a window;
5649 the mode line appears at the bottom. */);
5651 DEFVAR_PER_BUFFER ("mode-line-format", &current_buffer->mode_line_format,
5652 Qnil,
5653 doc: /* Template for displaying mode line for current buffer.
5654 Each buffer has its own value of this variable.
5655 Value may be nil, a string, a symbol or a list or cons cell.
5656 A value of nil means don't display a mode line.
5657 For a symbol, its value is used (but it is ignored if t or nil).
5658 A string appearing directly as the value of a symbol is processed verbatim
5659 in that the %-constructs below are not recognized.
5660 Note that unless the symbol is marked as a `risky-local-variable', all
5661 properties in any strings, as well as all :eval and :propertize forms
5662 in the value of that symbol will be ignored.
5663 For a list of the form `(:eval FORM)', FORM is evaluated and the result
5664 is used as a mode line element. Be careful--FORM should not load any files,
5665 because that can cause an infinite recursion.
5666 For a list of the form `(:propertize ELT PROPS...)', ELT is displayed
5667 with the specified properties PROPS applied.
5668 For a list whose car is a symbol, the symbol's value is taken,
5669 and if that is non-nil, the cadr of the list is processed recursively.
5670 Otherwise, the caddr of the list (if there is one) is processed.
5671 For a list whose car is a string or list, each element is processed
5672 recursively and the results are effectively concatenated.
5673 For a list whose car is an integer, the cdr of the list is processed
5674 and padded (if the number is positive) or truncated (if negative)
5675 to the width specified by that number.
5676 A string is printed verbatim in the mode line except for %-constructs:
5677 (%-constructs are allowed when the string is the entire mode-line-format
5678 or when it is found in a cons-cell or a list)
5679 %b -- print buffer name. %f -- print visited file name.
5680 %F -- print frame name.
5681 %* -- print %, * or hyphen. %+ -- print *, % or hyphen.
5682 %& is like %*, but ignore read-only-ness.
5683 % means buffer is read-only and * means it is modified.
5684 For a modified read-only buffer, %* gives % and %+ gives *.
5685 %s -- print process status. %l -- print the current line number.
5686 %c -- print the current column number (this makes editing slower).
5687 To make the column number update correctly in all cases,
5688 `column-number-mode' must be non-nil.
5689 %i -- print the size of the buffer.
5690 %I -- like %i, but use k, M, G, etc., to abbreviate.
5691 %p -- print percent of buffer above top of window, or Top, Bot or All.
5692 %P -- print percent of buffer above bottom of window, perhaps plus Top,
5693 or print Bottom or All.
5694 %n -- print Narrow if appropriate.
5695 %t -- visited file is text or binary (if OS supports this distinction).
5696 %z -- print mnemonics of keyboard, terminal, and buffer coding systems.
5697 %Z -- like %z, but including the end-of-line format.
5698 %e -- print error message about full memory.
5699 %@ -- print @ or hyphen. @ means that default-directory is on a
5700 remote machine.
5701 %[ -- print one [ for each recursive editing level. %] similar.
5702 %% -- print %. %- -- print infinitely many dashes.
5703 Decimal digits after the % specify field width to which to pad. */);
5705 DEFVAR_LISP_NOPRO ("default-major-mode", &buffer_defaults.major_mode,
5706 doc: /* *Major mode for new buffers. Defaults to `fundamental-mode'.
5707 A value of nil means use current buffer's major mode,
5708 provided it is not marked as "special".
5710 When a mode is used by default, `find-file' switches to it
5711 before it reads the contents into the buffer and before
5712 it finishes setting up the buffer. Thus, the mode and
5713 its hooks should not expect certain variables such as
5714 `buffer-read-only' and `buffer-file-coding-system' to be set up. */);
5716 DEFVAR_PER_BUFFER ("major-mode", &current_buffer->major_mode,
5717 make_number (Lisp_Symbol),
5718 doc: /* Symbol for current buffer's major mode. */);
5720 DEFVAR_PER_BUFFER ("mode-name", &current_buffer->mode_name,
5721 Qnil,
5722 doc: /* Pretty name of current buffer's major mode.
5723 Usually a string, but can use any of the constructs for `mode-line-format',
5724 which see.
5725 Format with `format-mode-line' to produce a string value. */);
5727 DEFVAR_PER_BUFFER ("local-abbrev-table", &current_buffer->abbrev_table, Qnil,
5728 doc: /* Local (mode-specific) abbrev table of current buffer. */);
5730 DEFVAR_PER_BUFFER ("abbrev-mode", &current_buffer->abbrev_mode, Qnil,
5731 doc: /* Non-nil turns on automatic expansion of abbrevs as they are inserted. */);
5733 DEFVAR_PER_BUFFER ("case-fold-search", &current_buffer->case_fold_search,
5734 Qnil,
5735 doc: /* *Non-nil if searches and matches should ignore case. */);
5737 DEFVAR_PER_BUFFER ("fill-column", &current_buffer->fill_column,
5738 make_number (Lisp_Int),
5739 doc: /* *Column beyond which automatic line-wrapping should happen.
5740 Interactively, you can set the buffer local value using \\[set-fill-column]. */);
5742 DEFVAR_PER_BUFFER ("left-margin", &current_buffer->left_margin,
5743 make_number (Lisp_Int),
5744 doc: /* *Column for the default `indent-line-function' to indent to.
5745 Linefeed indents to this column in Fundamental mode. */);
5747 DEFVAR_PER_BUFFER ("tab-width", &current_buffer->tab_width,
5748 make_number (Lisp_Int),
5749 doc: /* *Distance between tab stops (for display of tab characters), in columns. */);
5751 DEFVAR_PER_BUFFER ("ctl-arrow", &current_buffer->ctl_arrow, Qnil,
5752 doc: /* *Non-nil means display control chars with uparrow.
5753 A value of nil means use backslash and octal digits.
5754 This variable does not apply to characters whose display is specified
5755 in the current display table (if there is one). */);
5757 DEFVAR_PER_BUFFER ("enable-multibyte-characters",
5758 &current_buffer->enable_multibyte_characters,
5759 Qnil,
5760 doc: /* Non-nil means the buffer contents are regarded as multi-byte characters.
5761 Otherwise they are regarded as unibyte. This affects the display,
5762 file I/O and the behavior of various editing commands.
5764 This variable is buffer-local but you cannot set it directly;
5765 use the function `set-buffer-multibyte' to change a buffer's representation.
5766 Changing its default value with `setq-default' is supported.
5767 See also variable `default-enable-multibyte-characters' and Info node
5768 `(elisp)Text Representations'. */);
5769 XSYMBOL (intern ("enable-multibyte-characters"))->constant = 1;
5771 DEFVAR_PER_BUFFER ("buffer-file-coding-system",
5772 &current_buffer->buffer_file_coding_system, Qnil,
5773 doc: /* Coding system to be used for encoding the buffer contents on saving.
5774 This variable applies to saving the buffer, and also to `write-region'
5775 and other functions that use `write-region'.
5776 It does not apply to sending output to subprocesses, however.
5778 If this is nil, the buffer is saved without any code conversion
5779 unless some coding system is specified in `file-coding-system-alist'
5780 for the buffer file.
5782 If the text to be saved cannot be encoded as specified by this variable,
5783 an alternative encoding is selected by `select-safe-coding-system', which see.
5785 The variable `coding-system-for-write', if non-nil, overrides this variable.
5787 This variable is never applied to a way of decoding a file while reading it. */);
5789 DEFVAR_PER_BUFFER ("direction-reversed", &current_buffer->direction_reversed,
5790 Qnil,
5791 doc: /* *Non-nil means lines in the buffer are displayed right to left. */);
5793 DEFVAR_PER_BUFFER ("truncate-lines", &current_buffer->truncate_lines, Qnil,
5794 doc: /* *Non-nil means do not display continuation lines.
5795 Instead, give each line of text just one screen line.
5797 Note that this is overridden by the variable
5798 `truncate-partial-width-windows' if that variable is non-nil
5799 and this buffer is not full-frame width. */);
5801 DEFVAR_PER_BUFFER ("word-wrap", &current_buffer->word_wrap, Qnil,
5802 doc: /* *Non-nil means to use word-wrapping for continuation lines.
5803 When word-wrapping is on, continuation lines are wrapped at the space
5804 or tab character nearest to the right window edge.
5805 If nil, continuation lines are wrapped at the right screen edge.
5807 This variable has no effect if long lines are truncated (see
5808 `truncate-lines' and `truncate-partial-width-windows'). If you use
5809 word-wrapping, you might want to reduce the value of
5810 `truncate-partial-width-windows', since wrapping can make text readable
5811 in narrower windows. */);
5813 #ifdef DOS_NT
5814 DEFVAR_PER_BUFFER ("buffer-file-type", &current_buffer->buffer_file_type,
5815 Qnil,
5816 doc: /* Non-nil if the visited file is a binary file.
5817 This variable is meaningful on MS-DOG and Windows NT.
5818 On those systems, it is automatically local in every buffer.
5819 On other systems, this variable is normally always nil. */);
5820 #endif
5822 DEFVAR_PER_BUFFER ("default-directory", &current_buffer->directory,
5823 make_number (Lisp_String),
5824 doc: /* Name of default directory of current buffer. Should end with slash.
5825 To interactively change the default directory, use command `cd'. */);
5827 DEFVAR_PER_BUFFER ("auto-fill-function", &current_buffer->auto_fill_function,
5828 Qnil,
5829 doc: /* Function called (if non-nil) to perform auto-fill.
5830 It is called after self-inserting any character specified in
5831 the `auto-fill-chars' table.
5832 NOTE: This variable is not a hook;
5833 its value may not be a list of functions. */);
5835 DEFVAR_PER_BUFFER ("buffer-file-name", &current_buffer->filename,
5836 make_number (Lisp_String),
5837 doc: /* Name of file visited in current buffer, or nil if not visiting a file. */);
5839 DEFVAR_PER_BUFFER ("buffer-file-truename", &current_buffer->file_truename,
5840 make_number (Lisp_String),
5841 doc: /* Abbreviated truename of file visited in current buffer, or nil if none.
5842 The truename of a file is calculated by `file-truename'
5843 and then abbreviated with `abbreviate-file-name'. */);
5845 DEFVAR_PER_BUFFER ("buffer-auto-save-file-name",
5846 &current_buffer->auto_save_file_name,
5847 make_number (Lisp_String),
5848 doc: /* Name of file for auto-saving current buffer.
5849 If it is nil, that means don't auto-save this buffer. */);
5851 DEFVAR_PER_BUFFER ("buffer-read-only", &current_buffer->read_only, Qnil,
5852 doc: /* Non-nil if this buffer is read-only. */);
5854 DEFVAR_PER_BUFFER ("buffer-backed-up", &current_buffer->backed_up, Qnil,
5855 doc: /* Non-nil if this buffer's file has been backed up.
5856 Backing up is done before the first time the file is saved. */);
5858 DEFVAR_PER_BUFFER ("buffer-saved-size", &current_buffer->save_length,
5859 make_number (Lisp_Int),
5860 doc: /* Length of current buffer when last read in, saved or auto-saved.
5861 0 initially.
5862 -1 means auto-saving turned off until next real save.
5864 If you set this to -2, that means don't turn off auto-saving in this buffer
5865 if its text size shrinks. If you use `buffer-swap-text' on a buffer,
5866 you probably should set this to -2 in that buffer. */);
5868 DEFVAR_PER_BUFFER ("selective-display", &current_buffer->selective_display,
5869 Qnil,
5870 doc: /* Non-nil enables selective display.
5871 An integer N as value means display only lines
5872 that start with less than N columns of space.
5873 A value of t means that the character ^M makes itself and
5874 all the rest of the line invisible; also, when saving the buffer
5875 in a file, save the ^M as a newline. */);
5877 #ifndef old
5878 DEFVAR_PER_BUFFER ("selective-display-ellipses",
5879 &current_buffer->selective_display_ellipses,
5880 Qnil,
5881 doc: /* Non-nil means display ... on previous line when a line is invisible. */);
5882 #endif
5884 DEFVAR_PER_BUFFER ("overwrite-mode", &current_buffer->overwrite_mode, Qnil,
5885 doc: /* Non-nil if self-insertion should replace existing text.
5886 The value should be one of `overwrite-mode-textual',
5887 `overwrite-mode-binary', or nil.
5888 If it is `overwrite-mode-textual', self-insertion still
5889 inserts at the end of a line, and inserts when point is before a tab,
5890 until the tab is filled in.
5891 If `overwrite-mode-binary', self-insertion replaces newlines and tabs too. */);
5893 DEFVAR_PER_BUFFER ("buffer-display-table", &current_buffer->display_table,
5894 Qnil,
5895 doc: /* Display table that controls display of the contents of current buffer.
5897 If this variable is nil, the value of `standard-display-table' is used.
5898 Each window can have its own, overriding display table, see
5899 `set-window-display-table' and `window-display-table'.
5901 The display table is a char-table created with `make-display-table'.
5902 A char-table is an array indexed by character codes. Normal array
5903 primitives `aref' and `aset' can be used to access elements of a char-table.
5905 Each of the char-table elements control how to display the corresponding
5906 text character: the element at index C in the table says how to display
5907 the character whose code is C. Each element should be a vector of
5908 characters or nil. The value nil means display the character in the
5909 default fashion; otherwise, the characters from the vector are delivered
5910 to the screen instead of the original character.
5912 For example, (aset buffer-display-table ?X [?Y]) tells Emacs
5913 to display a capital Y instead of each X character.
5915 In addition, a char-table has six extra slots to control the display of:
5917 the end of a truncated screen line (extra-slot 0, a single character);
5918 the end of a continued line (extra-slot 1, a single character);
5919 the escape character used to display character codes in octal
5920 (extra-slot 2, a single character);
5921 the character used as an arrow for control characters (extra-slot 3,
5922 a single character);
5923 the decoration indicating the presence of invisible lines (extra-slot 4,
5924 a vector of characters);
5925 the character used to draw the border between side-by-side windows
5926 (extra-slot 5, a single character).
5928 See also the functions `display-table-slot' and `set-display-table-slot'. */);
5930 DEFVAR_PER_BUFFER ("left-margin-width", &current_buffer->left_margin_cols,
5931 Qnil,
5932 doc: /* *Width of left marginal area for display of a buffer.
5933 A value of nil means no marginal area. */);
5935 DEFVAR_PER_BUFFER ("right-margin-width", &current_buffer->right_margin_cols,
5936 Qnil,
5937 doc: /* *Width of right marginal area for display of a buffer.
5938 A value of nil means no marginal area. */);
5940 DEFVAR_PER_BUFFER ("left-fringe-width", &current_buffer->left_fringe_width,
5941 Qnil,
5942 doc: /* *Width of this buffer's left fringe (in pixels).
5943 A value of 0 means no left fringe is shown in this buffer's window.
5944 A value of nil means to use the left fringe width from the window's frame. */);
5946 DEFVAR_PER_BUFFER ("right-fringe-width", &current_buffer->right_fringe_width,
5947 Qnil,
5948 doc: /* *Width of this buffer's right fringe (in pixels).
5949 A value of 0 means no right fringe is shown in this buffer's window.
5950 A value of nil means to use the right fringe width from the window's frame. */);
5952 DEFVAR_PER_BUFFER ("fringes-outside-margins", &current_buffer->fringes_outside_margins,
5953 Qnil,
5954 doc: /* *Non-nil means to display fringes outside display margins.
5955 A value of nil means to display fringes between margins and buffer text. */);
5957 DEFVAR_PER_BUFFER ("scroll-bar-width", &current_buffer->scroll_bar_width,
5958 Qnil,
5959 doc: /* *Width of this buffer's scroll bars in pixels.
5960 A value of nil means to use the scroll bar width from the window's frame. */);
5962 DEFVAR_PER_BUFFER ("vertical-scroll-bar", &current_buffer->vertical_scroll_bar_type,
5963 Qnil,
5964 doc: /* *Position of this buffer's vertical scroll bar.
5965 The value takes effect whenever you tell a window to display this buffer;
5966 for instance, with `set-window-buffer' or when `display-buffer' displays it.
5968 A value of `left' or `right' means put the vertical scroll bar at that side
5969 of the window; a value of nil means don't show any vertical scroll bars.
5970 A value of t (the default) means do whatever the window's frame specifies. */);
5972 DEFVAR_PER_BUFFER ("indicate-empty-lines",
5973 &current_buffer->indicate_empty_lines, Qnil,
5974 doc: /* *Visually indicate empty lines after the buffer end.
5975 If non-nil, a bitmap is displayed in the left fringe of a window on
5976 window-systems. */);
5978 DEFVAR_PER_BUFFER ("indicate-buffer-boundaries",
5979 &current_buffer->indicate_buffer_boundaries, Qnil,
5980 doc: /* *Visually indicate buffer boundaries and scrolling.
5981 If non-nil, the first and last line of the buffer are marked in the fringe
5982 of a window on window-systems with angle bitmaps, or if the window can be
5983 scrolled, the top and bottom line of the window are marked with up and down
5984 arrow bitmaps.
5986 If value is a symbol `left' or `right', both angle and arrow bitmaps
5987 are displayed in the left or right fringe, resp. Any other value
5988 that doesn't look like an alist means display the angle bitmaps in
5989 the left fringe but no arrows.
5991 You can exercise more precise control by using an alist as the
5992 value. Each alist element (INDICATOR . POSITION) specifies
5993 where to show one of the indicators. INDICATOR is one of `top',
5994 `bottom', `up', `down', or t, which specifies the default position,
5995 and POSITION is one of `left', `right', or nil, meaning do not show
5996 this indicator.
5998 For example, ((top . left) (t . right)) places the top angle bitmap in
5999 left fringe, the bottom angle bitmap in right fringe, and both arrow
6000 bitmaps in right fringe. To show just the angle bitmaps in the left
6001 fringe, but no arrow bitmaps, use ((top . left) (bottom . left)). */);
6003 DEFVAR_PER_BUFFER ("fringe-indicator-alist",
6004 &current_buffer->fringe_indicator_alist, Qnil,
6005 doc: /* *Mapping from logical to physical fringe indicator bitmaps.
6006 The value is an alist where each element (INDICATOR . BITMAPS)
6007 specifies the fringe bitmaps used to display a specific logical
6008 fringe indicator.
6010 INDICATOR specifies the logical indicator type which is one of the
6011 following symbols: `truncation' , `continuation', `overlay-arrow',
6012 `top', `bottom', `up', `down', `one-line', `empty-line', or `unknown'.
6014 BITMAPS is list of symbols (LEFT RIGHT [LEFT1 RIGHT1]) which specifies
6015 the actual bitmap shown in the left or right fringe for the logical
6016 indicator. LEFT and RIGHT are the bitmaps shown in the left and/or
6017 right fringe for the specific indicator. The LEFT1 or RIGHT1 bitmaps
6018 are used only for the `bottom' and `one-line' indicators when the last
6019 \(only) line in has no final newline. BITMAPS may also be a single
6020 symbol which is used in both left and right fringes. */);
6022 DEFVAR_PER_BUFFER ("fringe-cursor-alist",
6023 &current_buffer->fringe_cursor_alist, Qnil,
6024 doc: /* *Mapping from logical to physical fringe cursor bitmaps.
6025 The value is an alist where each element (CURSOR . BITMAP)
6026 specifies the fringe bitmaps used to display a specific logical
6027 cursor type in the fringe.
6029 CURSOR specifies the logical cursor type which is one of the following
6030 symbols: `box' , `hollow', `bar', `hbar', or `hollow-small'. The last
6031 one is used to show a hollow cursor on narrow lines display lines
6032 where the normal hollow cursor will not fit.
6034 BITMAP is the corresponding fringe bitmap shown for the logical
6035 cursor type. */);
6037 DEFVAR_PER_BUFFER ("scroll-up-aggressively",
6038 &current_buffer->scroll_up_aggressively, Qnil,
6039 doc: /* How far to scroll windows upward.
6040 If you move point off the bottom, the window scrolls automatically.
6041 This variable controls how far it scrolls. The value nil, the default,
6042 means scroll to center point. A fraction means scroll to put point
6043 that fraction of the window's height from the bottom of the window.
6044 When the value is 0.0, point goes at the bottom line, which in the
6045 simple case that you moved off with C-f means scrolling just one line.
6046 1.0 means point goes at the top, so that in that simple case, the
6047 window scrolls by a full window height. Meaningful values are
6048 between 0.0 and 1.0, inclusive. */);
6050 DEFVAR_PER_BUFFER ("scroll-down-aggressively",
6051 &current_buffer->scroll_down_aggressively, Qnil,
6052 doc: /* How far to scroll windows downward.
6053 If you move point off the top, the window scrolls automatically.
6054 This variable controls how far it scrolls. The value nil, the default,
6055 means scroll to center point. A fraction means scroll to put point
6056 that fraction of the window's height from the top of the window.
6057 When the value is 0.0, point goes at the top line, which in the
6058 simple case that you moved off with C-b means scrolling just one line.
6059 1.0 means point goes at the bottom, so that in that simple case, the
6060 window scrolls by a full window height. Meaningful values are
6061 between 0.0 and 1.0, inclusive. */);
6063 /*DEFVAR_LISP ("debug-check-symbol", &Vcheck_symbol,
6064 "Don't ask.");
6067 DEFVAR_LISP ("before-change-functions", &Vbefore_change_functions,
6068 doc: /* List of functions to call before each text change.
6069 Two arguments are passed to each function: the positions of
6070 the beginning and end of the range of old text to be changed.
6071 \(For an insertion, the beginning and end are at the same place.)
6072 No information is given about the length of the text after the change.
6074 Buffer changes made while executing the `before-change-functions'
6075 don't call any before-change or after-change functions.
6076 That's because these variables are temporarily set to nil.
6077 As a result, a hook function cannot straightforwardly alter the
6078 value of these variables. See the Emacs Lisp manual for a way of
6079 accomplishing an equivalent result by using other variables.
6081 If an unhandled error happens in running these functions,
6082 the variable's value remains nil. That prevents the error
6083 from happening repeatedly and making Emacs nonfunctional. */);
6084 Vbefore_change_functions = Qnil;
6086 DEFVAR_LISP ("after-change-functions", &Vafter_change_functions,
6087 doc: /* List of functions to call after each text change.
6088 Three arguments are passed to each function: the positions of
6089 the beginning and end of the range of changed text,
6090 and the length in bytes of the pre-change text replaced by that range.
6091 \(For an insertion, the pre-change length is zero;
6092 for a deletion, that length is the number of bytes deleted,
6093 and the post-change beginning and end are at the same place.)
6095 Buffer changes made while executing the `after-change-functions'
6096 don't call any before-change or after-change functions.
6097 That's because these variables are temporarily set to nil.
6098 As a result, a hook function cannot straightforwardly alter the
6099 value of these variables. See the Emacs Lisp manual for a way of
6100 accomplishing an equivalent result by using other variables.
6102 If an unhandled error happens in running these functions,
6103 the variable's value remains nil. That prevents the error
6104 from happening repeatedly and making Emacs nonfunctional. */);
6105 Vafter_change_functions = Qnil;
6107 DEFVAR_LISP ("first-change-hook", &Vfirst_change_hook,
6108 doc: /* A list of functions to call before changing a buffer which is unmodified.
6109 The functions are run using the `run-hooks' function. */);
6110 Vfirst_change_hook = Qnil;
6112 DEFVAR_PER_BUFFER ("buffer-undo-list", &current_buffer->undo_list, Qnil,
6113 doc: /* List of undo entries in current buffer.
6114 Recent changes come first; older changes follow newer.
6116 An entry (BEG . END) represents an insertion which begins at
6117 position BEG and ends at position END.
6119 An entry (TEXT . POSITION) represents the deletion of the string TEXT
6120 from (abs POSITION). If POSITION is positive, point was at the front
6121 of the text being deleted; if negative, point was at the end.
6123 An entry (t HIGH . LOW) indicates that the buffer previously had
6124 \"unmodified\" status. HIGH and LOW are the high and low 16-bit portions
6125 of the visited file's modification time, as of that time. If the
6126 modification time of the most recent save is different, this entry is
6127 obsolete.
6129 An entry (nil PROPERTY VALUE BEG . END) indicates that a text property
6130 was modified between BEG and END. PROPERTY is the property name,
6131 and VALUE is the old value.
6133 An entry (apply FUN-NAME . ARGS) means undo the change with
6134 \(apply FUN-NAME ARGS).
6136 An entry (apply DELTA BEG END FUN-NAME . ARGS) supports selective undo
6137 in the active region. BEG and END is the range affected by this entry
6138 and DELTA is the number of bytes added or deleted in that range by
6139 this change.
6141 An entry (MARKER . DISTANCE) indicates that the marker MARKER
6142 was adjusted in position by the offset DISTANCE (an integer).
6144 An entry of the form POSITION indicates that point was at the buffer
6145 location given by the integer. Undoing an entry of this form places
6146 point at POSITION.
6148 Entries with value `nil' mark undo boundaries. The undo command treats
6149 the changes between two undo boundaries as a single step to be undone.
6151 If the value of the variable is t, undo information is not recorded. */);
6153 DEFVAR_PER_BUFFER ("mark-active", &current_buffer->mark_active, Qnil,
6154 doc: /* Non-nil means the mark and region are currently active in this buffer. */);
6156 DEFVAR_PER_BUFFER ("cache-long-line-scans", &current_buffer->cache_long_line_scans, Qnil,
6157 doc: /* Non-nil means that Emacs should use caches to handle long lines more quickly.
6159 Normally, the line-motion functions work by scanning the buffer for
6160 newlines. Columnar operations (like `move-to-column' and
6161 `compute-motion') also work by scanning the buffer, summing character
6162 widths as they go. This works well for ordinary text, but if the
6163 buffer's lines are very long (say, more than 500 characters), these
6164 motion functions will take longer to execute. Emacs may also take
6165 longer to update the display.
6167 If `cache-long-line-scans' is non-nil, these motion functions cache the
6168 results of their scans, and consult the cache to avoid rescanning
6169 regions of the buffer until the text is modified. The caches are most
6170 beneficial when they prevent the most searching---that is, when the
6171 buffer contains long lines and large regions of characters with the
6172 same, fixed screen width.
6174 When `cache-long-line-scans' is non-nil, processing short lines will
6175 become slightly slower (because of the overhead of consulting the
6176 cache), and the caches will use memory roughly proportional to the
6177 number of newlines and characters whose screen width varies.
6179 The caches require no explicit maintenance; their accuracy is
6180 maintained internally by the Emacs primitives. Enabling or disabling
6181 the cache should not affect the behavior of any of the motion
6182 functions; it should only affect their performance. */);
6184 DEFVAR_PER_BUFFER ("point-before-scroll", &current_buffer->point_before_scroll, Qnil,
6185 doc: /* Value of point before the last series of scroll operations, or nil. */);
6187 DEFVAR_PER_BUFFER ("buffer-file-format", &current_buffer->file_format, Qnil,
6188 doc: /* List of formats to use when saving this buffer.
6189 Formats are defined by `format-alist'. This variable is
6190 set when a file is visited. */);
6192 DEFVAR_PER_BUFFER ("buffer-auto-save-file-format",
6193 &current_buffer->auto_save_file_format, Qnil,
6194 doc: /* *Format in which to write auto-save files.
6195 Should be a list of symbols naming formats that are defined in `format-alist'.
6196 If it is t, which is the default, auto-save files are written in the
6197 same format as a regular save would use. */);
6199 DEFVAR_PER_BUFFER ("buffer-invisibility-spec",
6200 &current_buffer->invisibility_spec, Qnil,
6201 doc: /* Invisibility spec of this buffer.
6202 The default is t, which means that text is invisible
6203 if it has a non-nil `invisible' property.
6204 If the value is a list, a text character is invisible if its `invisible'
6205 property is an element in that list (or is a list with members in common).
6206 If an element is a cons cell of the form (PROP . ELLIPSIS),
6207 then characters with property value PROP are invisible,
6208 and they have an ellipsis as well if ELLIPSIS is non-nil. */);
6210 DEFVAR_PER_BUFFER ("buffer-display-count",
6211 &current_buffer->display_count, Qnil,
6212 doc: /* A number incremented each time this buffer is displayed in a window.
6213 The function `set-window-buffer' increments it. */);
6215 DEFVAR_PER_BUFFER ("buffer-display-time",
6216 &current_buffer->display_time, Qnil,
6217 doc: /* Time stamp updated each time this buffer is displayed in a window.
6218 The function `set-window-buffer' updates this variable
6219 to the value obtained by calling `current-time'.
6220 If the buffer has never been shown in a window, the value is nil. */);
6222 DEFVAR_LISP ("transient-mark-mode", &Vtransient_mark_mode,
6223 doc: /* */);
6224 Vtransient_mark_mode = Qnil;
6225 /* The docstring is in simple.el. If we put it here, it would be
6226 overwritten when transient-mark-mode is defined using
6227 define-minor-mode. */
6229 DEFVAR_LISP ("inhibit-read-only", &Vinhibit_read_only,
6230 doc: /* *Non-nil means disregard read-only status of buffers or characters.
6231 If the value is t, disregard `buffer-read-only' and all `read-only'
6232 text properties. If the value is a list, disregard `buffer-read-only'
6233 and disregard a `read-only' text property if the property value
6234 is a member of the list. */);
6235 Vinhibit_read_only = Qnil;
6237 DEFVAR_PER_BUFFER ("cursor-type", &current_buffer->cursor_type, Qnil,
6238 doc: /* Cursor to use when this buffer is in the selected window.
6239 Values are interpreted as follows:
6241 t use the cursor specified for the frame
6242 nil don't display a cursor
6243 box display a filled box cursor
6244 hollow display a hollow box cursor
6245 bar display a vertical bar cursor with default width
6246 (bar . WIDTH) display a vertical bar cursor with width WIDTH
6247 hbar display a horizontal bar cursor with default height
6248 (hbar . HEIGHT) display a horizontal bar cursor with height HEIGHT
6249 ANYTHING ELSE display a hollow box cursor
6251 When the buffer is displayed in a non-selected window, the
6252 cursor's appearance is instead controlled by the variable
6253 `cursor-in-non-selected-windows'. */);
6255 DEFVAR_PER_BUFFER ("line-spacing",
6256 &current_buffer->extra_line_spacing, Qnil,
6257 doc: /* Additional space to put between lines when displaying a buffer.
6258 The space is measured in pixels, and put below lines on graphic displays,
6259 see `display-graphic-p'.
6260 If value is a floating point number, it specifies the spacing relative
6261 to the default frame line height. A value of nil means add no extra space. */);
6263 DEFVAR_PER_BUFFER ("cursor-in-non-selected-windows",
6264 &current_buffer->cursor_in_non_selected_windows, Qnil,
6265 doc: /* *Cursor type to display in non-selected windows.
6266 The value t means to use hollow box cursor. See `cursor-type' for other values. */);
6268 DEFVAR_LISP ("kill-buffer-query-functions", &Vkill_buffer_query_functions,
6269 doc: /* List of functions called with no args to query before killing a buffer.
6270 The buffer being killed will be current while the functions are running.
6271 If any of them returns nil, the buffer is not killed. */);
6272 Vkill_buffer_query_functions = Qnil;
6274 DEFVAR_LISP ("change-major-mode-hook", &Vchange_major_mode_hook,
6275 doc: /* Normal hook run before changing the major mode of a buffer.
6276 The function `kill-all-local-variables' runs this before doing anything else. */);
6277 Vchange_major_mode_hook = Qnil;
6278 Qchange_major_mode_hook = intern ("change-major-mode-hook");
6279 staticpro (&Qchange_major_mode_hook);
6281 defsubr (&Sbuffer_live_p);
6282 defsubr (&Sbuffer_list);
6283 defsubr (&Sget_buffer);
6284 defsubr (&Sget_file_buffer);
6285 defsubr (&Sget_buffer_create);
6286 defsubr (&Smake_indirect_buffer);
6287 defsubr (&Sgenerate_new_buffer_name);
6288 defsubr (&Sbuffer_name);
6289 /*defsubr (&Sbuffer_number);*/
6290 defsubr (&Sbuffer_file_name);
6291 defsubr (&Sbuffer_base_buffer);
6292 defsubr (&Sbuffer_local_value);
6293 defsubr (&Sbuffer_local_variables);
6294 defsubr (&Sbuffer_modified_p);
6295 defsubr (&Sset_buffer_modified_p);
6296 defsubr (&Sbuffer_modified_tick);
6297 defsubr (&Sbuffer_chars_modified_tick);
6298 defsubr (&Srename_buffer);
6299 defsubr (&Sother_buffer);
6300 defsubr (&Sbuffer_enable_undo);
6301 defsubr (&Skill_buffer);
6302 defsubr (&Sset_buffer_major_mode);
6303 defsubr (&Sswitch_to_buffer);
6304 defsubr (&Scurrent_buffer);
6305 defsubr (&Sset_buffer);
6306 defsubr (&Sbarf_if_buffer_read_only);
6307 defsubr (&Sbury_buffer);
6308 defsubr (&Serase_buffer);
6309 defsubr (&Sbuffer_swap_text);
6310 defsubr (&Sset_buffer_multibyte);
6311 defsubr (&Skill_all_local_variables);
6313 defsubr (&Soverlayp);
6314 defsubr (&Smake_overlay);
6315 defsubr (&Sdelete_overlay);
6316 defsubr (&Smove_overlay);
6317 defsubr (&Soverlay_start);
6318 defsubr (&Soverlay_end);
6319 defsubr (&Soverlay_buffer);
6320 defsubr (&Soverlay_properties);
6321 defsubr (&Soverlays_at);
6322 defsubr (&Soverlays_in);
6323 defsubr (&Snext_overlay_change);
6324 defsubr (&Sprevious_overlay_change);
6325 defsubr (&Soverlay_recenter);
6326 defsubr (&Soverlay_lists);
6327 defsubr (&Soverlay_get);
6328 defsubr (&Soverlay_put);
6329 defsubr (&Srestore_buffer_modified_p);
6332 void
6333 keys_of_buffer ()
6335 initial_define_key (control_x_map, 'b', "switch-to-buffer");
6336 initial_define_key (control_x_map, 'k', "kill-buffer");
6338 /* This must not be in syms_of_buffer, because Qdisabled is not
6339 initialized when that function gets called. */
6340 Fput (intern ("erase-buffer"), Qdisabled, Qt);
6343 /* arch-tag: e48569bf-69a9-4b65-a23b-8e68769436e1
6344 (do not change this comment) */