(tool-bar-images-pixel-height): New variable.
[emacs.git] / src / buffer.c
blobf019863e80b92fddf2af580496a39895106467a8
1 /* Buffer manipulation primitives for GNU Emacs.
2 Copyright (C) 1985,86,87,88,89,93,94,95,97,98, 1999, 2000
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
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
34 #ifndef MAXPATHLEN
35 /* in 4.1, param.h fails to define this. */
36 #define MAXPATHLEN 1024
37 #endif /* not MAXPATHLEN */
39 #ifdef HAVE_UNISTD_H
40 #include <unistd.h>
41 #endif
42 #include "lisp.h"
43 #include "intervals.h"
44 #include "window.h"
45 #include "commands.h"
46 #include "buffer.h"
47 #include "charset.h"
48 #include "region-cache.h"
49 #include "indent.h"
50 #include "blockinput.h"
51 #include "keyboard.h"
52 #include "frame.h"
54 struct buffer *current_buffer; /* the current buffer */
56 /* First buffer in chain of all buffers (in reverse order of creation).
57 Threaded through ->next. */
59 struct buffer *all_buffers;
61 /* This structure holds the default values of the buffer-local variables
62 defined with DEFVAR_PER_BUFFER, that have special slots in each buffer.
63 The default value occupies the same slot in this structure
64 as an individual buffer's value occupies in that buffer.
65 Setting the default value also goes through the alist of buffers
66 and stores into each buffer that does not say it has a local value. */
68 struct buffer buffer_defaults;
70 /* A Lisp_Object pointer to the above, used for staticpro */
72 static Lisp_Object Vbuffer_defaults;
74 /* This structure marks which slots in a buffer have corresponding
75 default values in buffer_defaults.
76 Each such slot has a nonzero value in this structure.
77 The value has only one nonzero bit.
79 When a buffer has its own local value for a slot,
80 the entry for that slot (found in the same slot in this structure)
81 is turned on in the buffer's local_flags array.
83 If a slot in this structure is -1, then even though there may
84 be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
85 and the corresponding slot in buffer_defaults is not used.
87 If a slot is -2, then there is no DEFVAR_PER_BUFFER for it,
88 but there is a default value which is copied into each buffer.
90 If a slot in this structure is negative, then even though there may
91 be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
92 and the corresponding slot in buffer_defaults is not used.
94 If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is
95 zero, that is a bug */
97 struct buffer buffer_local_flags;
99 /* This structure holds the names of symbols whose values may be
100 buffer-local. It is indexed and accessed in the same way as the above. */
102 struct buffer buffer_local_symbols;
103 /* A Lisp_Object pointer to the above, used for staticpro */
104 static Lisp_Object Vbuffer_local_symbols;
106 /* This structure holds the required types for the values in the
107 buffer-local slots. If a slot contains Qnil, then the
108 corresponding buffer slot may contain a value of any type. If a
109 slot contains an integer, then prospective values' tags must be
110 equal to that integer (except nil is always allowed).
111 When a tag does not match, the function
112 buffer_slot_type_mismatch will signal an error.
114 If a slot here contains -1, the corresponding variable is read-only. */
115 struct buffer buffer_local_types;
117 /* Flags indicating which built-in buffer-local variables
118 are permanent locals. */
119 static char buffer_permanent_local_flags[MAX_PER_BUFFER_VARS];
121 /* Number of per-buffer variables used. */
123 int last_per_buffer_idx;
125 Lisp_Object Fset_buffer ();
126 void set_buffer_internal ();
127 void set_buffer_internal_1 ();
128 static void call_overlay_mod_hooks ();
129 static void swap_out_buffer_local_variables ();
130 static void reset_buffer_local_variables ();
132 /* Alist of all buffer names vs the buffers. */
133 /* This used to be a variable, but is no longer,
134 to prevent lossage due to user rplac'ing this alist or its elements. */
135 Lisp_Object Vbuffer_alist;
137 /* Functions to call before and after each text change. */
138 Lisp_Object Vbefore_change_functions;
139 Lisp_Object Vafter_change_functions;
141 Lisp_Object Vtransient_mark_mode;
143 /* t means ignore all read-only text properties.
144 A list means ignore such a property if its value is a member of the list.
145 Any non-nil value means ignore buffer-read-only. */
146 Lisp_Object Vinhibit_read_only;
148 /* List of functions to call that can query about killing a buffer.
149 If any of these functions returns nil, we don't kill it. */
150 Lisp_Object Vkill_buffer_query_functions;
152 /* List of functions to call before changing an unmodified buffer. */
153 Lisp_Object Vfirst_change_hook;
155 Lisp_Object Qfirst_change_hook;
156 Lisp_Object Qbefore_change_functions;
157 Lisp_Object Qafter_change_functions;
159 /* If nonzero, all modification hooks are suppressed. */
160 int inhibit_modification_hooks;
162 Lisp_Object Qfundamental_mode, Qmode_class, Qpermanent_local;
164 Lisp_Object Qprotected_field;
166 Lisp_Object QSFundamental; /* A string "Fundamental" */
168 Lisp_Object Qkill_buffer_hook;
170 Lisp_Object Qget_file_buffer;
172 Lisp_Object Qoverlayp;
174 Lisp_Object Qpriority, Qwindow, Qevaporate, Qbefore_string, Qafter_string;
176 Lisp_Object Qmodification_hooks;
177 Lisp_Object Qinsert_in_front_hooks;
178 Lisp_Object Qinsert_behind_hooks;
180 static void alloc_buffer_text P_ ((struct buffer *, size_t));
181 static void free_buffer_text P_ ((struct buffer *b));
184 /* For debugging; temporary. See set_buffer_internal. */
185 /* Lisp_Object Qlisp_mode, Vcheck_symbol; */
187 void
188 nsberror (spec)
189 Lisp_Object spec;
191 if (STRINGP (spec))
192 error ("No buffer named %s", XSTRING (spec)->data);
193 error ("Invalid buffer argument");
196 DEFUN ("buffer-live-p", Fbuffer_live_p, Sbuffer_live_p, 1, 1, 0,
197 "Return non-nil if OBJECT is a buffer which has not been killed.\n\
198 Value is nil if OBJECT is not a buffer or if it has been killed.")
199 (object)
200 Lisp_Object object;
202 return ((BUFFERP (object) && ! NILP (XBUFFER (object)->name))
203 ? Qt : Qnil);
206 DEFUN ("buffer-list", Fbuffer_list, Sbuffer_list, 0, 1, 0,
207 "Return a list of all existing live buffers.\n\
208 If the optional arg FRAME is a frame, we return that frame's buffer list.")
209 (frame)
210 Lisp_Object frame;
212 Lisp_Object framelist, general;
213 general = Fmapcar (Qcdr, Vbuffer_alist);
215 if (FRAMEP (frame))
217 Lisp_Object tail;
219 CHECK_FRAME (frame, 1);
221 framelist = Fcopy_sequence (XFRAME (frame)->buffer_list);
223 /* Remove from GENERAL any buffer that duplicates one in FRAMELIST. */
224 tail = framelist;
225 while (! NILP (tail))
227 general = Fdelq (XCAR (tail), general);
228 tail = XCDR (tail);
230 return nconc2 (framelist, general);
233 return general;
236 /* Like Fassoc, but use Fstring_equal to compare
237 (which ignores text properties),
238 and don't ever QUIT. */
240 static Lisp_Object
241 assoc_ignore_text_properties (key, list)
242 register Lisp_Object key;
243 Lisp_Object list;
245 register Lisp_Object tail;
246 for (tail = list; !NILP (tail); tail = Fcdr (tail))
248 register Lisp_Object elt, tem;
249 elt = Fcar (tail);
250 tem = Fstring_equal (Fcar (elt), key);
251 if (!NILP (tem))
252 return elt;
254 return Qnil;
257 DEFUN ("get-buffer", Fget_buffer, Sget_buffer, 1, 1, 0,
258 "Return the buffer named NAME (a string).\n\
259 If there is no live buffer named NAME, return nil.\n\
260 NAME may also be a buffer; if so, the value is that buffer.")
261 (name)
262 register Lisp_Object name;
264 if (BUFFERP (name))
265 return name;
266 CHECK_STRING (name, 0);
268 return Fcdr (assoc_ignore_text_properties (name, Vbuffer_alist));
271 DEFUN ("get-file-buffer", Fget_file_buffer, Sget_file_buffer, 1, 1, 0,
272 "Return the buffer visiting file FILENAME (a string).\n\
273 The buffer's `buffer-file-name' must match exactly the expansion of FILENAME.\n\
274 If there is no such live buffer, return nil.\n\
275 See also `find-buffer-visiting'.")
276 (filename)
277 register Lisp_Object filename;
279 register Lisp_Object tail, buf, tem;
280 Lisp_Object handler;
282 CHECK_STRING (filename, 0);
283 filename = Fexpand_file_name (filename, Qnil);
285 /* If the file name has special constructs in it,
286 call the corresponding file handler. */
287 handler = Ffind_file_name_handler (filename, Qget_file_buffer);
288 if (!NILP (handler))
289 return call2 (handler, Qget_file_buffer, filename);
291 for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
293 buf = Fcdr (XCAR (tail));
294 if (!BUFFERP (buf)) continue;
295 if (!STRINGP (XBUFFER (buf)->filename)) continue;
296 tem = Fstring_equal (XBUFFER (buf)->filename, filename);
297 if (!NILP (tem))
298 return buf;
300 return Qnil;
303 Lisp_Object
304 get_truename_buffer (filename)
305 register Lisp_Object filename;
307 register Lisp_Object tail, buf, tem;
309 for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
311 buf = Fcdr (XCAR (tail));
312 if (!BUFFERP (buf)) continue;
313 if (!STRINGP (XBUFFER (buf)->file_truename)) continue;
314 tem = Fstring_equal (XBUFFER (buf)->file_truename, filename);
315 if (!NILP (tem))
316 return buf;
318 return Qnil;
321 /* Incremented for each buffer created, to assign the buffer number. */
322 int buffer_count;
324 DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 1, 0,
325 "Return the buffer named NAME, or create such a buffer and return it.\n\
326 A new buffer is created if there is no live buffer named NAME.\n\
327 If NAME starts with a space, the new buffer does not keep undo information.\n\
328 If NAME is a buffer instead of a string, then it is the value returned.\n\
329 The value is never nil.")
330 (name)
331 register Lisp_Object name;
333 register Lisp_Object buf;
334 register struct buffer *b;
336 buf = Fget_buffer (name);
337 if (!NILP (buf))
338 return buf;
340 if (XSTRING (name)->size == 0)
341 error ("Empty string for buffer name is not allowed");
343 b = (struct buffer *) allocate_buffer ();
345 b->size = sizeof (struct buffer) / sizeof (EMACS_INT);
347 /* An ordinary buffer uses its own struct buffer_text. */
348 b->text = &b->own_text;
349 b->base_buffer = 0;
351 BUF_GAP_SIZE (b) = 20;
352 BLOCK_INPUT;
353 /* We allocate extra 1-byte at the tail and keep it always '\0' for
354 anchoring a search. */
355 alloc_buffer_text (b, BUF_GAP_SIZE (b) + 1);
356 UNBLOCK_INPUT;
357 if (! BUF_BEG_ADDR (b))
358 buffer_memory_full ();
360 BUF_PT (b) = 1;
361 BUF_GPT (b) = 1;
362 BUF_BEGV (b) = 1;
363 BUF_ZV (b) = 1;
364 BUF_Z (b) = 1;
365 BUF_PT_BYTE (b) = 1;
366 BUF_GPT_BYTE (b) = 1;
367 BUF_BEGV_BYTE (b) = 1;
368 BUF_ZV_BYTE (b) = 1;
369 BUF_Z_BYTE (b) = 1;
370 BUF_MODIFF (b) = 1;
371 BUF_OVERLAY_MODIFF (b) = 1;
372 BUF_SAVE_MODIFF (b) = 1;
373 BUF_INTERVALS (b) = 0;
374 BUF_UNCHANGED_MODIFIED (b) = 1;
375 BUF_OVERLAY_UNCHANGED_MODIFIED (b) = 1;
376 BUF_END_UNCHANGED (b) = 0;
377 BUF_BEG_UNCHANGED (b) = 0;
378 *(BUF_GPT_ADDR (b)) = *(BUF_Z_ADDR (b)) = 0; /* Put an anchor '\0'. */
380 b->newline_cache = 0;
381 b->width_run_cache = 0;
382 b->width_table = Qnil;
383 b->prevent_redisplay_optimizations_p = 1;
385 /* Put this on the chain of all buffers including killed ones. */
386 b->next = all_buffers;
387 all_buffers = b;
389 /* An ordinary buffer normally doesn't need markers
390 to handle BEGV and ZV. */
391 b->pt_marker = Qnil;
392 b->begv_marker = Qnil;
393 b->zv_marker = Qnil;
395 name = Fcopy_sequence (name);
396 XSTRING (name)->intervals = NULL_INTERVAL;
397 b->name = name;
399 if (XSTRING (name)->data[0] != ' ')
400 b->undo_list = Qnil;
401 else
402 b->undo_list = Qt;
404 reset_buffer (b);
405 reset_buffer_local_variables (b, 1);
407 /* Put this in the alist of all live buffers. */
408 XSETBUFFER (buf, b);
409 Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));
411 b->mark = Fmake_marker ();
412 BUF_MARKERS (b) = Qnil;
413 b->name = name;
414 return buf;
418 /* Clone per-buffer values of buffer FROM.
420 Buffer TO gets the same per-buffer values as FROM, with the
421 following exceptions: (1) TO's name is left untouched, (2) markers
422 are copied and made to refer to TO, and (3) overlay lists are
423 copied. */
425 static void
426 clone_per_buffer_values (from, to)
427 struct buffer *from, *to;
429 Lisp_Object to_buffer;
430 int offset;
432 XSETBUFFER (to_buffer, to);
434 for (offset = PER_BUFFER_VAR_OFFSET (name) + sizeof (Lisp_Object);
435 offset < sizeof *to;
436 offset += sizeof (Lisp_Object))
438 Lisp_Object obj;
440 obj = PER_BUFFER_VALUE (from, offset);
441 if (MARKERP (obj))
443 struct Lisp_Marker *m = XMARKER (obj);
444 obj = Fmake_marker ();
445 XMARKER (obj)->insertion_type = m->insertion_type;
446 set_marker_both (obj, to_buffer, m->charpos, m->bytepos);
449 PER_BUFFER_VALUE (to, offset) = obj;
452 to->overlays_after = Fcopy_sequence (from->overlays_after);
453 to->overlays_before = Fcopy_sequence (to->overlays_before);
454 bcopy (from->local_flags, to->local_flags, sizeof to->local_flags);
458 DEFUN ("make-indirect-buffer", Fmake_indirect_buffer, Smake_indirect_buffer,
459 2, 3,
460 "bMake indirect buffer (to buffer): \nBName of indirect buffer: ",
461 "Create and return an indirect buffer for buffer BASE-BUFFER, named NAME.\n\
462 BASE-BUFFER should be an existing buffer (or buffer name).\n\
463 NAME should be a string which is not the name of an existing buffer.\n\
464 Optional argument CLONE non-nil means preserve BASE-BUFFER's state,\n\
465 such as major and minor modes, in the indirect buffer.\n\
466 CLONE nil means the indirect buffer's state is reset to default values.")
467 (base_buffer, name, clone)
468 Lisp_Object base_buffer, name, clone;
470 Lisp_Object buf;
471 struct buffer *b;
473 buf = Fget_buffer (name);
474 if (!NILP (buf))
475 error ("Buffer name `%s' is in use", XSTRING (name)->data);
477 base_buffer = Fget_buffer (base_buffer);
478 if (NILP (base_buffer))
479 error ("No such buffer: `%s'", XSTRING (name)->data);
481 if (XSTRING (name)->size == 0)
482 error ("Empty string for buffer name is not allowed");
484 b = (struct buffer *) allocate_buffer ();
485 b->size = sizeof (struct buffer) / sizeof (EMACS_INT);
487 if (XBUFFER (base_buffer)->base_buffer)
488 b->base_buffer = XBUFFER (base_buffer)->base_buffer;
489 else
490 b->base_buffer = XBUFFER (base_buffer);
492 /* Use the base buffer's text object. */
493 b->text = b->base_buffer->text;
495 BUF_BEGV (b) = BUF_BEGV (b->base_buffer);
496 BUF_ZV (b) = BUF_ZV (b->base_buffer);
497 BUF_PT (b) = BUF_PT (b->base_buffer);
498 BUF_BEGV_BYTE (b) = BUF_BEGV_BYTE (b->base_buffer);
499 BUF_ZV_BYTE (b) = BUF_ZV_BYTE (b->base_buffer);
500 BUF_PT_BYTE (b) = BUF_PT_BYTE (b->base_buffer);
502 b->newline_cache = 0;
503 b->width_run_cache = 0;
504 b->width_table = Qnil;
506 /* Put this on the chain of all buffers including killed ones. */
507 b->next = all_buffers;
508 all_buffers = b;
510 name = Fcopy_sequence (name);
511 XSTRING (name)->intervals = NULL_INTERVAL;
512 b->name = name;
514 reset_buffer (b);
515 reset_buffer_local_variables (b, 1);
517 /* Put this in the alist of all live buffers. */
518 XSETBUFFER (buf, b);
519 Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));
521 b->mark = Fmake_marker ();
522 b->name = name;
524 /* The multibyte status belongs to the base buffer. */
525 b->enable_multibyte_characters = b->base_buffer->enable_multibyte_characters;
527 /* Make sure the base buffer has markers for its narrowing. */
528 if (NILP (b->base_buffer->pt_marker))
530 b->base_buffer->pt_marker = Fmake_marker ();
531 set_marker_both (b->base_buffer->pt_marker, base_buffer,
532 BUF_PT (b->base_buffer),
533 BUF_PT_BYTE (b->base_buffer));
535 if (NILP (b->base_buffer->begv_marker))
537 b->base_buffer->begv_marker = Fmake_marker ();
538 set_marker_both (b->base_buffer->begv_marker, base_buffer,
539 BUF_BEGV (b->base_buffer),
540 BUF_BEGV_BYTE (b->base_buffer));
542 if (NILP (b->base_buffer->zv_marker))
544 b->base_buffer->zv_marker = Fmake_marker ();
545 set_marker_both (b->base_buffer->zv_marker, base_buffer,
546 BUF_ZV (b->base_buffer),
547 BUF_ZV_BYTE (b->base_buffer));
548 XMARKER (b->base_buffer->zv_marker)->insertion_type = 1;
551 if (NILP (clone))
553 /* Give the indirect buffer markers for its narrowing. */
554 b->pt_marker = Fmake_marker ();
555 set_marker_both (b->pt_marker, buf, BUF_PT (b), BUF_PT_BYTE (b));
556 b->begv_marker = Fmake_marker ();
557 set_marker_both (b->begv_marker, buf, BUF_BEGV (b), BUF_BEGV_BYTE (b));
558 b->zv_marker = Fmake_marker ();
559 set_marker_both (b->zv_marker, buf, BUF_ZV (b), BUF_ZV_BYTE (b));
560 XMARKER (b->zv_marker)->insertion_type = 1;
562 else
563 clone_per_buffer_values (b->base_buffer, b);
565 return buf;
568 /* Reinitialize everything about a buffer except its name and contents
569 and local variables. */
571 void
572 reset_buffer (b)
573 register struct buffer *b;
575 b->filename = Qnil;
576 b->file_truename = Qnil;
577 b->directory = (current_buffer) ? current_buffer->directory : Qnil;
578 b->modtime = 0;
579 XSETFASTINT (b->save_length, 0);
580 b->last_window_start = 1;
581 /* It is more conservative to start out "changed" than "unchanged". */
582 b->clip_changed = 0;
583 b->prevent_redisplay_optimizations_p = 1;
584 b->backed_up = Qnil;
585 b->auto_save_modified = 0;
586 b->auto_save_failure_time = -1;
587 b->auto_save_file_name = Qnil;
588 b->read_only = Qnil;
589 b->overlays_before = Qnil;
590 b->overlays_after = Qnil;
591 XSETFASTINT (b->overlay_center, 1);
592 b->mark_active = Qnil;
593 b->point_before_scroll = Qnil;
594 b->file_format = Qnil;
595 b->last_selected_window = Qnil;
596 XSETINT (b->display_count, 0);
597 b->display_time = Qnil;
598 b->enable_multibyte_characters = buffer_defaults.enable_multibyte_characters;
599 b->cursor_type = buffer_defaults.cursor_type;
600 b->extra_line_spacing = buffer_defaults.extra_line_spacing;
603 /* Reset buffer B's local variables info.
604 Don't use this on a buffer that has already been in use;
605 it does not treat permanent locals consistently.
606 Instead, use Fkill_all_local_variables.
608 If PERMANENT_TOO is 1, then we reset permanent built-in
609 buffer-local variables. If PERMANENT_TOO is 0,
610 we preserve those. */
612 static void
613 reset_buffer_local_variables (b, permanent_too)
614 register struct buffer *b;
615 int permanent_too;
617 register int offset;
618 int i;
620 /* Reset the major mode to Fundamental, together with all the
621 things that depend on the major mode.
622 default-major-mode is handled at a higher level.
623 We ignore it here. */
624 b->major_mode = Qfundamental_mode;
625 b->keymap = Qnil;
626 b->abbrev_table = Vfundamental_mode_abbrev_table;
627 b->mode_name = QSFundamental;
628 b->minor_modes = Qnil;
630 /* If the standard case table has been altered and invalidated,
631 fix up its insides first. */
632 if (! (CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[0])
633 && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[1])
634 && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[2])))
635 Fset_standard_case_table (Vascii_downcase_table);
637 b->downcase_table = Vascii_downcase_table;
638 b->upcase_table = XCHAR_TABLE (Vascii_downcase_table)->extras[0];
639 b->case_canon_table = XCHAR_TABLE (Vascii_downcase_table)->extras[1];
640 b->case_eqv_table = XCHAR_TABLE (Vascii_downcase_table)->extras[2];
641 b->invisibility_spec = Qt;
642 #ifndef DOS_NT
643 b->buffer_file_type = Qnil;
644 #endif
646 #if 0
647 b->sort_table = XSTRING (Vascii_sort_table);
648 b->folding_sort_table = XSTRING (Vascii_folding_sort_table);
649 #endif /* 0 */
651 /* Reset all (or most) per-buffer variables to their defaults. */
652 b->local_var_alist = Qnil;
653 for (i = 0; i < last_per_buffer_idx; ++i)
654 if (permanent_too || buffer_permanent_local_flags[i] == 0)
655 SET_PER_BUFFER_VALUE_P (b, i, 0);
657 /* For each slot that has a default value,
658 copy that into the slot. */
660 for (offset = PER_BUFFER_VAR_OFFSET (name);
661 offset < sizeof *b;
662 offset += sizeof (Lisp_Object))
664 int idx = PER_BUFFER_IDX (offset);
665 if ((idx > 0
666 && (permanent_too
667 || buffer_permanent_local_flags[idx] == 0))
668 /* Is -2 used anywhere? */
669 || idx == -2)
670 PER_BUFFER_VALUE (b, offset) = PER_BUFFER_DEFAULT (offset);
674 /* We split this away from generate-new-buffer, because rename-buffer
675 and set-visited-file-name ought to be able to use this to really
676 rename the buffer properly. */
678 DEFUN ("generate-new-buffer-name", Fgenerate_new_buffer_name, Sgenerate_new_buffer_name,
679 1, 2, 0,
680 "Return a string that is the name of no existing buffer based on NAME.\n\
681 If there is no live buffer named NAME, then return NAME.\n\
682 Otherwise modify name by appending `<NUMBER>', incrementing NUMBER\n\
683 until an unused name is found, and then return that name.\n\
684 Optional second argument IGNORE specifies a name that is okay to use\n\
685 \(if it is in the sequence to be tried)\n\
686 even if a buffer with that name exists.")
687 (name, ignore)
688 register Lisp_Object name, ignore;
690 register Lisp_Object gentemp, tem;
691 int count;
692 char number[10];
694 CHECK_STRING (name, 0);
696 tem = Fget_buffer (name);
697 if (NILP (tem))
698 return name;
700 count = 1;
701 while (1)
703 sprintf (number, "<%d>", ++count);
704 gentemp = concat2 (name, build_string (number));
705 tem = Fstring_equal (gentemp, ignore);
706 if (!NILP (tem))
707 return gentemp;
708 tem = Fget_buffer (gentemp);
709 if (NILP (tem))
710 return gentemp;
715 DEFUN ("buffer-name", Fbuffer_name, Sbuffer_name, 0, 1, 0,
716 "Return the name of BUFFER, as a string.\n\
717 With no argument or nil as argument, return the name of the current buffer.")
718 (buffer)
719 register Lisp_Object buffer;
721 if (NILP (buffer))
722 return current_buffer->name;
723 CHECK_BUFFER (buffer, 0);
724 return XBUFFER (buffer)->name;
727 DEFUN ("buffer-file-name", Fbuffer_file_name, Sbuffer_file_name, 0, 1, 0,
728 "Return name of file BUFFER is visiting, or nil if none.\n\
729 No argument or nil as argument means use the current buffer.")
730 (buffer)
731 register Lisp_Object buffer;
733 if (NILP (buffer))
734 return current_buffer->filename;
735 CHECK_BUFFER (buffer, 0);
736 return XBUFFER (buffer)->filename;
739 DEFUN ("buffer-base-buffer", Fbuffer_base_buffer, Sbuffer_base_buffer,
740 0, 1, 0,
741 "Return the base buffer of indirect buffer BUFFER.\n\
742 If BUFFER is not indirect, return nil.")
743 (buffer)
744 register Lisp_Object buffer;
746 struct buffer *base;
747 Lisp_Object base_buffer;
749 if (NILP (buffer))
750 base = current_buffer->base_buffer;
751 else
753 CHECK_BUFFER (buffer, 0);
754 base = XBUFFER (buffer)->base_buffer;
757 if (! base)
758 return Qnil;
759 XSETBUFFER (base_buffer, base);
760 return base_buffer;
763 DEFUN ("buffer-local-variables", Fbuffer_local_variables,
764 Sbuffer_local_variables, 0, 1, 0,
765 "Return an alist of variables that are buffer-local in BUFFER.\n\
766 Most elements look like (SYMBOL . VALUE), describing one variable.\n\
767 For a symbol that is locally unbound, just the symbol appears in the value.\n\
768 Note that storing new VALUEs in these elements doesn't change the variables.\n\
769 No argument or nil as argument means use current buffer as BUFFER.")
770 (buffer)
771 register Lisp_Object buffer;
773 register struct buffer *buf;
774 register Lisp_Object result;
776 if (NILP (buffer))
777 buf = current_buffer;
778 else
780 CHECK_BUFFER (buffer, 0);
781 buf = XBUFFER (buffer);
784 result = Qnil;
787 register Lisp_Object tail;
788 for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail))
790 Lisp_Object val, elt;
792 elt = XCAR (tail);
794 /* Reference each variable in the alist in buf.
795 If inquiring about the current buffer, this gets the current values,
796 so store them into the alist so the alist is up to date.
797 If inquiring about some other buffer, this swaps out any values
798 for that buffer, making the alist up to date automatically. */
799 val = find_symbol_value (XCAR (elt));
800 /* Use the current buffer value only if buf is the current buffer. */
801 if (buf != current_buffer)
802 val = XCDR (elt);
804 /* If symbol is unbound, put just the symbol in the list. */
805 if (EQ (val, Qunbound))
806 result = Fcons (XCAR (elt), result);
807 /* Otherwise, put (symbol . value) in the list. */
808 else
809 result = Fcons (Fcons (XCAR (elt), val), result);
813 /* Add on all the variables stored in special slots. */
815 int offset, idx;
817 for (offset = PER_BUFFER_VAR_OFFSET (name);
818 offset < sizeof (struct buffer);
819 /* sizeof EMACS_INT == sizeof Lisp_Object */
820 offset += (sizeof (EMACS_INT)))
822 idx = PER_BUFFER_IDX (offset);
823 if ((idx == -1 || PER_BUFFER_VALUE_P (buf, idx))
824 && SYMBOLP (PER_BUFFER_SYMBOL (offset)))
825 result = Fcons (Fcons (PER_BUFFER_SYMBOL (offset),
826 PER_BUFFER_VALUE (buf, offset)),
827 result);
831 return result;
835 DEFUN ("buffer-modified-p", Fbuffer_modified_p, Sbuffer_modified_p,
836 0, 1, 0,
837 "Return t if BUFFER was modified since its file was last read or saved.\n\
838 No argument or nil as argument means use current buffer as BUFFER.")
839 (buffer)
840 register Lisp_Object buffer;
842 register struct buffer *buf;
843 if (NILP (buffer))
844 buf = current_buffer;
845 else
847 CHECK_BUFFER (buffer, 0);
848 buf = XBUFFER (buffer);
851 return BUF_SAVE_MODIFF (buf) < BUF_MODIFF (buf) ? Qt : Qnil;
854 DEFUN ("set-buffer-modified-p", Fset_buffer_modified_p, Sset_buffer_modified_p,
855 1, 1, 0,
856 "Mark current buffer as modified or unmodified according to FLAG.\n\
857 A non-nil FLAG means mark the buffer modified.")
858 (flag)
859 register Lisp_Object flag;
861 register int already;
862 register Lisp_Object fn;
863 Lisp_Object buffer, window;
865 #ifdef CLASH_DETECTION
866 /* If buffer becoming modified, lock the file.
867 If buffer becoming unmodified, unlock the file. */
869 fn = current_buffer->file_truename;
870 /* Test buffer-file-name so that binding it to nil is effective. */
871 if (!NILP (fn) && ! NILP (current_buffer->filename))
873 already = SAVE_MODIFF < MODIFF;
874 if (!already && !NILP (flag))
875 lock_file (fn);
876 else if (already && NILP (flag))
877 unlock_file (fn);
879 #endif /* CLASH_DETECTION */
881 SAVE_MODIFF = NILP (flag) ? MODIFF : 0;
883 /* Set update_mode_lines only if buffer is displayed in some window.
884 Packages like jit-lock or lazy-lock preserve a buffer's modified
885 state by recording/restoring the state around blocks of code.
886 Setting update_mode_lines makes redisplay consider all windows
887 (on all frames). Stealth fontification of buffers not displayed
888 would incur additional redisplay costs if we'd set
889 update_modes_lines unconditionally.
891 Ideally, I think there should be another mechanism for fontifying
892 buffers without "modifying" buffers, or redisplay should be
893 smarter about updating the `*' in mode lines. --gerd */
894 XSETBUFFER (buffer, current_buffer);
895 window = Fget_buffer_window (buffer, Qt);
896 if (WINDOWP (window))
898 ++update_mode_lines;
899 current_buffer->prevent_redisplay_optimizations_p = 1;
902 return flag;
905 DEFUN ("restore-buffer-modified-p", Frestore_buffer_modified_p,
906 Srestore_buffer_modified_p, 1, 1, 0,
907 "Like `set-buffer-modified-p', with a differences concerning redisplay.\n\
908 It is not ensured that mode lines will be updated to show the modified\n\
909 state of the current buffer. Use with care.")
910 (flag)
911 Lisp_Object flag;
913 #ifdef CLASH_DETECTION
914 Lisp_Object fn;
916 /* If buffer becoming modified, lock the file.
917 If buffer becoming unmodified, unlock the file. */
919 fn = current_buffer->file_truename;
920 /* Test buffer-file-name so that binding it to nil is effective. */
921 if (!NILP (fn) && ! NILP (current_buffer->filename))
923 int already = SAVE_MODIFF < MODIFF;
924 if (!already && !NILP (flag))
925 lock_file (fn);
926 else if (already && NILP (flag))
927 unlock_file (fn);
929 #endif /* CLASH_DETECTION */
931 SAVE_MODIFF = NILP (flag) ? MODIFF : 0;
932 return flag;
935 DEFUN ("buffer-modified-tick", Fbuffer_modified_tick, Sbuffer_modified_tick,
936 0, 1, 0,
937 "Return BUFFER's tick counter, incremented for each change in text.\n\
938 Each buffer has a tick counter which is incremented each time the text in\n\
939 that buffer is changed. It wraps around occasionally.\n\
940 No argument or nil as argument means use current buffer as BUFFER.")
941 (buffer)
942 register Lisp_Object buffer;
944 register struct buffer *buf;
945 if (NILP (buffer))
946 buf = current_buffer;
947 else
949 CHECK_BUFFER (buffer, 0);
950 buf = XBUFFER (buffer);
953 return make_number (BUF_MODIFF (buf));
956 DEFUN ("rename-buffer", Frename_buffer, Srename_buffer, 1, 2,
957 "sRename buffer (to new name): \nP",
958 "Change current buffer's name to NEWNAME (a string).\n\
959 If second arg UNIQUE is nil or omitted, it is an error if a\n\
960 buffer named NEWNAME already exists.\n\
961 If UNIQUE is non-nil, come up with a new name using\n\
962 `generate-new-buffer-name'.\n\
963 Interactively, you can set UNIQUE with a prefix argument.\n\
964 We return the name we actually gave the buffer.\n\
965 This does not change the name of the visited file (if any).")
966 (newname, unique)
967 register Lisp_Object newname, unique;
969 register Lisp_Object tem, buf;
971 CHECK_STRING (newname, 0);
973 if (XSTRING (newname)->size == 0)
974 error ("Empty string is invalid as a buffer name");
976 tem = Fget_buffer (newname);
977 if (!NILP (tem))
979 /* Don't short-circuit if UNIQUE is t. That is a useful way to
980 rename the buffer automatically so you can create another
981 with the original name. It makes UNIQUE equivalent to
982 (rename-buffer (generate-new-buffer-name NEWNAME)). */
983 if (NILP (unique) && XBUFFER (tem) == current_buffer)
984 return current_buffer->name;
985 if (!NILP (unique))
986 newname = Fgenerate_new_buffer_name (newname, current_buffer->name);
987 else
988 error ("Buffer name `%s' is in use", XSTRING (newname)->data);
991 current_buffer->name = newname;
993 /* Catch redisplay's attention. Unless we do this, the mode lines for
994 any windows displaying current_buffer will stay unchanged. */
995 update_mode_lines++;
997 XSETBUFFER (buf, current_buffer);
998 Fsetcar (Frassq (buf, Vbuffer_alist), newname);
999 if (NILP (current_buffer->filename)
1000 && !NILP (current_buffer->auto_save_file_name))
1001 call0 (intern ("rename-auto-save-file"));
1002 /* Refetch since that last call may have done GC. */
1003 return current_buffer->name;
1006 DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 3, 0,
1007 "Return most recently selected buffer other than BUFFER.\n\
1008 Buffers not visible in windows are preferred to visible buffers,\n\
1009 unless optional second argument VISIBLE-OK is non-nil.\n\
1010 If the optional third argument FRAME is non-nil, use that frame's\n\
1011 buffer list instead of the selected frame's buffer list.\n\
1012 If no other buffer exists, the buffer `*scratch*' is returned.\n\
1013 If BUFFER is omitted or nil, some interesting buffer is returned.")
1014 (buffer, visible_ok, frame)
1015 register Lisp_Object buffer, visible_ok, frame;
1017 Lisp_Object Fset_buffer_major_mode ();
1018 register Lisp_Object tail, buf, notsogood, tem, pred, add_ons;
1019 notsogood = Qnil;
1021 if (NILP (frame))
1022 frame = selected_frame;
1024 tail = Vbuffer_alist;
1025 pred = frame_buffer_predicate (frame);
1027 /* Consider buffers that have been seen in the selected frame
1028 before other buffers. */
1030 tem = frame_buffer_list (frame);
1031 add_ons = Qnil;
1032 while (CONSP (tem))
1034 if (BUFFERP (XCAR (tem)))
1035 add_ons = Fcons (Fcons (Qnil, XCAR (tem)), add_ons);
1036 tem = XCDR (tem);
1038 tail = nconc2 (Fnreverse (add_ons), tail);
1040 for (; !NILP (tail); tail = Fcdr (tail))
1042 buf = Fcdr (Fcar (tail));
1043 if (EQ (buf, buffer))
1044 continue;
1045 if (XSTRING (XBUFFER (buf)->name)->data[0] == ' ')
1046 continue;
1047 /* If the selected frame has a buffer_predicate,
1048 disregard buffers that don't fit the predicate. */
1049 if (!NILP (pred))
1051 tem = call1 (pred, buf);
1052 if (NILP (tem))
1053 continue;
1056 if (NILP (visible_ok))
1057 tem = Fget_buffer_window (buf, Qvisible);
1058 else
1059 tem = Qnil;
1060 if (NILP (tem))
1061 return buf;
1062 if (NILP (notsogood))
1063 notsogood = buf;
1065 if (!NILP (notsogood))
1066 return notsogood;
1067 buf = Fget_buffer (build_string ("*scratch*"));
1068 if (NILP (buf))
1070 buf = Fget_buffer_create (build_string ("*scratch*"));
1071 Fset_buffer_major_mode (buf);
1073 return buf;
1076 DEFUN ("buffer-disable-undo", Fbuffer_disable_undo, Sbuffer_disable_undo,
1077 0, 1, "",
1078 "Make BUFFER stop keeping undo information.\n\
1079 No argument or nil as argument means do this for the current buffer.")
1080 (buffer)
1081 register Lisp_Object buffer;
1083 Lisp_Object real_buffer;
1085 if (NILP (buffer))
1086 XSETBUFFER (real_buffer, current_buffer);
1087 else
1089 real_buffer = Fget_buffer (buffer);
1090 if (NILP (real_buffer))
1091 nsberror (buffer);
1094 XBUFFER (real_buffer)->undo_list = Qt;
1096 return Qnil;
1099 DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, Sbuffer_enable_undo,
1100 0, 1, "",
1101 "Start keeping undo information for buffer BUFFER.\n\
1102 No argument or nil as argument means do this for the current buffer.")
1103 (buffer)
1104 register Lisp_Object buffer;
1106 Lisp_Object real_buffer;
1108 if (NILP (buffer))
1109 XSETBUFFER (real_buffer, current_buffer);
1110 else
1112 real_buffer = Fget_buffer (buffer);
1113 if (NILP (real_buffer))
1114 nsberror (buffer);
1117 if (EQ (XBUFFER (real_buffer)->undo_list, Qt))
1118 XBUFFER (real_buffer)->undo_list = Qnil;
1120 return Qnil;
1124 DEFVAR_LISP ("kill-buffer-hook", no_cell, "\
1125 Hook to be run (by `run-hooks', which see) when a buffer is killed.\n\
1126 The buffer being killed will be current while the hook is running.\n\
1127 See `kill-buffer'."
1129 DEFUN ("kill-buffer", Fkill_buffer, Skill_buffer, 1, 1, "bKill buffer: ",
1130 "Kill the buffer BUFFER.\n\
1131 The argument may be a buffer or may be the name of a buffer.\n\
1132 An argument of nil means kill the current buffer.\n\n\
1133 Value is t if the buffer is actually killed, nil if user says no.\n\n\
1134 The value of `kill-buffer-hook' (which may be local to that buffer),\n\
1135 if not void, is a list of functions to be called, with no arguments,\n\
1136 before the buffer is actually killed. The buffer to be killed is current\n\
1137 when the hook functions are called.\n\n\
1138 Any processes that have this buffer as the `process-buffer' are killed\n\
1139 with SIGHUP.")
1140 (buffer)
1141 Lisp_Object buffer;
1143 Lisp_Object buf;
1144 register struct buffer *b;
1145 register Lisp_Object tem;
1146 register struct Lisp_Marker *m;
1147 struct gcpro gcpro1;
1149 if (NILP (buffer))
1150 buf = Fcurrent_buffer ();
1151 else
1152 buf = Fget_buffer (buffer);
1153 if (NILP (buf))
1154 nsberror (buffer);
1156 b = XBUFFER (buf);
1158 /* Avoid trouble for buffer already dead. */
1159 if (NILP (b->name))
1160 return Qnil;
1162 /* Query if the buffer is still modified. */
1163 if (INTERACTIVE && !NILP (b->filename)
1164 && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b))
1166 GCPRO1 (buf);
1167 tem = do_yes_or_no_p (format1 ("Buffer %s modified; kill anyway? ",
1168 XSTRING (b->name)->data));
1169 UNGCPRO;
1170 if (NILP (tem))
1171 return Qnil;
1174 /* Run hooks with the buffer to be killed the current buffer. */
1176 int count = specpdl_ptr - specpdl;
1177 Lisp_Object list;
1179 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1180 set_buffer_internal (b);
1182 /* First run the query functions; if any query is answered no,
1183 don't kill the buffer. */
1184 for (list = Vkill_buffer_query_functions; !NILP (list); list = Fcdr (list))
1186 tem = call0 (Fcar (list));
1187 if (NILP (tem))
1188 return unbind_to (count, Qnil);
1191 /* Then run the hooks. */
1192 if (!NILP (Vrun_hooks))
1193 call1 (Vrun_hooks, Qkill_buffer_hook);
1194 unbind_to (count, Qnil);
1197 /* We have no more questions to ask. Verify that it is valid
1198 to kill the buffer. This must be done after the questions
1199 since anything can happen within do_yes_or_no_p. */
1201 /* Don't kill the minibuffer now current. */
1202 if (EQ (buf, XWINDOW (minibuf_window)->buffer))
1203 return Qnil;
1205 if (NILP (b->name))
1206 return Qnil;
1208 /* When we kill a base buffer, kill all its indirect buffers.
1209 We do it at this stage so nothing terrible happens if they
1210 ask questions or their hooks get errors. */
1211 if (! b->base_buffer)
1213 struct buffer *other;
1215 GCPRO1 (buf);
1217 for (other = all_buffers; other; other = other->next)
1218 /* all_buffers contains dead buffers too;
1219 don't re-kill them. */
1220 if (other->base_buffer == b && !NILP (other->name))
1222 Lisp_Object buf;
1223 XSETBUFFER (buf, other);
1224 Fkill_buffer (buf);
1227 UNGCPRO;
1230 /* Make this buffer not be current.
1231 In the process, notice if this is the sole visible buffer
1232 and give up if so. */
1233 if (b == current_buffer)
1235 tem = Fother_buffer (buf, Qnil, Qnil);
1236 Fset_buffer (tem);
1237 if (b == current_buffer)
1238 return Qnil;
1241 /* Notice if the buffer to kill is the sole visible buffer
1242 when we're currently in the mini-buffer, and give up if so. */
1243 XSETBUFFER (tem, current_buffer);
1244 if (EQ (tem, XWINDOW (minibuf_window)->buffer))
1246 tem = Fother_buffer (buf, Qnil, Qnil);
1247 if (EQ (buf, tem))
1248 return Qnil;
1251 /* Now there is no question: we can kill the buffer. */
1253 #ifdef CLASH_DETECTION
1254 /* Unlock this buffer's file, if it is locked. */
1255 unlock_buffer (b);
1256 #endif /* CLASH_DETECTION */
1258 kill_buffer_processes (buf);
1260 tem = Vinhibit_quit;
1261 Vinhibit_quit = Qt;
1262 replace_buffer_in_all_windows (buf);
1263 Vbuffer_alist = Fdelq (Frassq (buf, Vbuffer_alist), Vbuffer_alist);
1264 frames_discard_buffer (buf);
1265 Vinhibit_quit = tem;
1267 /* Delete any auto-save file, if we saved it in this session. */
1268 if (STRINGP (b->auto_save_file_name)
1269 && b->auto_save_modified != 0
1270 && BUF_SAVE_MODIFF (b) < b->auto_save_modified)
1272 Lisp_Object tem;
1273 tem = Fsymbol_value (intern ("delete-auto-save-files"));
1274 if (! NILP (tem))
1275 internal_delete_file (b->auto_save_file_name);
1278 if (b->base_buffer)
1280 /* Unchain all markers that belong to this indirect buffer.
1281 Don't unchain the markers that belong to the base buffer
1282 or its other indirect buffers. */
1283 for (tem = BUF_MARKERS (b); !NILP (tem); )
1285 Lisp_Object next;
1286 m = XMARKER (tem);
1287 next = m->chain;
1288 if (m->buffer == b)
1289 unchain_marker (tem);
1290 tem = next;
1293 else
1295 /* Unchain all markers of this buffer and its indirect buffers.
1296 and leave them pointing nowhere. */
1297 for (tem = BUF_MARKERS (b); !NILP (tem); )
1299 m = XMARKER (tem);
1300 m->buffer = 0;
1301 tem = m->chain;
1302 m->chain = Qnil;
1304 BUF_MARKERS (b) = Qnil;
1305 BUF_INTERVALS (b) = NULL_INTERVAL;
1307 /* Perhaps we should explicitly free the interval tree here... */
1310 /* Reset the local variables, so that this buffer's local values
1311 won't be protected from GC. They would be protected
1312 if they happened to remain encached in their symbols.
1313 This gets rid of them for certain. */
1314 swap_out_buffer_local_variables (b);
1315 reset_buffer_local_variables (b, 1);
1317 b->name = Qnil;
1319 BLOCK_INPUT;
1320 if (! b->base_buffer)
1321 free_buffer_text (b);
1323 if (b->newline_cache)
1325 free_region_cache (b->newline_cache);
1326 b->newline_cache = 0;
1328 if (b->width_run_cache)
1330 free_region_cache (b->width_run_cache);
1331 b->width_run_cache = 0;
1333 b->width_table = Qnil;
1334 UNBLOCK_INPUT;
1335 b->undo_list = Qnil;
1337 return Qt;
1340 /* Move the assoc for buffer BUF to the front of buffer-alist. Since
1341 we do this each time BUF is selected visibly, the more recently
1342 selected buffers are always closer to the front of the list. This
1343 means that other_buffer is more likely to choose a relevant buffer. */
1345 void
1346 record_buffer (buf)
1347 Lisp_Object buf;
1349 register Lisp_Object link, prev;
1350 Lisp_Object frame;
1351 frame = selected_frame;
1353 prev = Qnil;
1354 for (link = Vbuffer_alist; CONSP (link); link = XCDR (link))
1356 if (EQ (XCDR (XCAR (link)), buf))
1357 break;
1358 prev = link;
1361 /* Effectively do Vbuffer_alist = Fdelq (link, Vbuffer_alist);
1362 we cannot use Fdelq itself here because it allows quitting. */
1364 if (NILP (prev))
1365 Vbuffer_alist = XCDR (Vbuffer_alist);
1366 else
1367 XCDR (prev) = XCDR (XCDR (prev));
1369 XCDR (link) = Vbuffer_alist;
1370 Vbuffer_alist = link;
1372 /* Now move this buffer to the front of frame_buffer_list also. */
1374 prev = Qnil;
1375 for (link = frame_buffer_list (frame); CONSP (link);
1376 link = XCDR (link))
1378 if (EQ (XCAR (link), buf))
1379 break;
1380 prev = link;
1383 /* Effectively do delq. */
1385 if (CONSP (link))
1387 if (NILP (prev))
1388 set_frame_buffer_list (frame,
1389 XCDR (frame_buffer_list (frame)));
1390 else
1391 XCDR (prev) = XCDR (XCDR (prev));
1393 XCDR (link) = frame_buffer_list (frame);
1394 set_frame_buffer_list (frame, link);
1396 else
1397 set_frame_buffer_list (frame, Fcons (buf, frame_buffer_list (frame)));
1400 DEFUN ("set-buffer-major-mode", Fset_buffer_major_mode, Sset_buffer_major_mode, 1, 1, 0,
1401 "Set an appropriate major mode for BUFFER, according to `default-major-mode'.\n\
1402 Use this function before selecting the buffer, since it may need to inspect\n\
1403 the current buffer's major mode.")
1404 (buffer)
1405 Lisp_Object buffer;
1407 int count;
1408 Lisp_Object function;
1410 function = buffer_defaults.major_mode;
1411 if (NILP (function) && NILP (Fget (current_buffer->major_mode, Qmode_class)))
1412 function = current_buffer->major_mode;
1414 if (NILP (function) || EQ (function, Qfundamental_mode))
1415 return Qnil;
1417 count = specpdl_ptr - specpdl;
1419 /* To select a nonfundamental mode,
1420 select the buffer temporarily and then call the mode function. */
1422 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1424 Fset_buffer (buffer);
1425 call0 (function);
1427 return unbind_to (count, Qnil);
1430 /* If switching buffers in WINDOW would be an error, return
1431 a C string saying what the error would be. */
1433 char *
1434 no_switch_window (window)
1435 Lisp_Object window;
1437 Lisp_Object tem;
1438 if (EQ (minibuf_window, window))
1439 return "Cannot switch buffers in minibuffer window";
1440 tem = Fwindow_dedicated_p (window);
1441 if (!NILP (tem))
1442 return "Cannot switch buffers in a dedicated window";
1443 return NULL;
1446 /* Switch to buffer BUFFER in the selected window.
1447 If NORECORD is non-nil, don't call record_buffer. */
1449 Lisp_Object
1450 switch_to_buffer_1 (buffer, norecord)
1451 Lisp_Object buffer, norecord;
1453 register Lisp_Object buf;
1455 if (NILP (buffer))
1456 buf = Fother_buffer (Fcurrent_buffer (), Qnil, Qnil);
1457 else
1459 buf = Fget_buffer (buffer);
1460 if (NILP (buf))
1462 buf = Fget_buffer_create (buffer);
1463 Fset_buffer_major_mode (buf);
1466 Fset_buffer (buf);
1467 if (NILP (norecord))
1468 record_buffer (buf);
1470 Fset_window_buffer (EQ (selected_window, minibuf_window)
1471 ? Fnext_window (minibuf_window, Qnil, Qnil)
1472 : selected_window,
1473 buf);
1475 return buf;
1478 DEFUN ("switch-to-buffer", Fswitch_to_buffer, Sswitch_to_buffer, 1, 2, "BSwitch to buffer: ",
1479 "Select buffer BUFFER in the current window.\n\
1480 BUFFER may be a buffer or a buffer name.\n\
1481 Optional second arg NORECORD non-nil means\n\
1482 do not put this buffer at the front of the list of recently selected ones.\n\
1484 WARNING: This is NOT the way to work on another buffer temporarily\n\
1485 within a Lisp program! Use `set-buffer' instead. That avoids messing with\n\
1486 the window-buffer correspondences.")
1487 (buffer, norecord)
1488 Lisp_Object buffer, norecord;
1490 char *err;
1492 err = no_switch_window (selected_window);
1493 if (err) error (err);
1495 return switch_to_buffer_1 (buffer, norecord);
1498 DEFUN ("pop-to-buffer", Fpop_to_buffer, Spop_to_buffer, 1, 3, 0,
1499 "Select buffer BUFFER in some window, preferably a different one.\n\
1500 If BUFFER is nil, then some other buffer is chosen.\n\
1501 If `pop-up-windows' is non-nil, windows can be split to do this.\n\
1502 If optional second arg OTHER-WINDOW is non-nil, insist on finding another\n\
1503 window even if BUFFER is already visible in the selected window.\n\
1504 This uses the function `display-buffer' as a subroutine; see the documentation\n\
1505 of `display-buffer' for additional customization information.\n\
1507 Optional third arg NORECORD non-nil means\n\
1508 do not put this buffer at the front of the list of recently selected ones.")
1509 (buffer, other_window, norecord)
1510 Lisp_Object buffer, other_window, norecord;
1512 register Lisp_Object buf;
1513 if (NILP (buffer))
1514 buf = Fother_buffer (Fcurrent_buffer (), Qnil, Qnil);
1515 else
1517 buf = Fget_buffer (buffer);
1518 if (NILP (buf))
1520 buf = Fget_buffer_create (buffer);
1521 Fset_buffer_major_mode (buf);
1524 Fset_buffer (buf);
1525 if (NILP (norecord))
1526 record_buffer (buf);
1527 Fselect_window (Fdisplay_buffer (buf, other_window, Qnil));
1528 return buf;
1531 DEFUN ("current-buffer", Fcurrent_buffer, Scurrent_buffer, 0, 0, 0,
1532 "Return the current buffer as a Lisp object.")
1535 register Lisp_Object buf;
1536 XSETBUFFER (buf, current_buffer);
1537 return buf;
1540 /* Set the current buffer to B.
1542 We previously set windows_or_buffers_changed here to invalidate
1543 global unchanged information in beg_unchanged and end_unchanged.
1544 This is no longer necessary because we now compute unchanged
1545 information on a buffer-basis. Every action affecting other
1546 windows than the selected one requires a select_window at some
1547 time, and that increments windows_or_buffers_changed. */
1549 void
1550 set_buffer_internal (b)
1551 register struct buffer *b;
1553 if (current_buffer != b)
1554 set_buffer_internal_1 (b);
1557 /* Set the current buffer to B, and do not set windows_or_buffers_changed.
1558 This is used by redisplay. */
1560 void
1561 set_buffer_internal_1 (b)
1562 register struct buffer *b;
1564 register struct buffer *old_buf;
1565 register Lisp_Object tail, valcontents;
1566 Lisp_Object tem;
1568 #ifdef USE_MMAP_FOR_BUFFERS
1569 if (b->text->beg == NULL)
1570 enlarge_buffer_text (b, 0);
1571 #endif /* USE_MMAP_FOR_BUFFERS */
1573 if (current_buffer == b)
1574 return;
1576 old_buf = current_buffer;
1577 current_buffer = b;
1578 last_known_column_point = -1; /* invalidate indentation cache */
1580 if (old_buf)
1582 /* Put the undo list back in the base buffer, so that it appears
1583 that an indirect buffer shares the undo list of its base. */
1584 if (old_buf->base_buffer)
1585 old_buf->base_buffer->undo_list = old_buf->undo_list;
1587 /* If the old current buffer has markers to record PT, BEGV and ZV
1588 when it is not current, update them now. */
1589 if (! NILP (old_buf->pt_marker))
1591 Lisp_Object obuf;
1592 XSETBUFFER (obuf, old_buf);
1593 set_marker_both (old_buf->pt_marker, obuf,
1594 BUF_PT (old_buf), BUF_PT_BYTE (old_buf));
1596 if (! NILP (old_buf->begv_marker))
1598 Lisp_Object obuf;
1599 XSETBUFFER (obuf, old_buf);
1600 set_marker_both (old_buf->begv_marker, obuf,
1601 BUF_BEGV (old_buf), BUF_BEGV_BYTE (old_buf));
1603 if (! NILP (old_buf->zv_marker))
1605 Lisp_Object obuf;
1606 XSETBUFFER (obuf, old_buf);
1607 set_marker_both (old_buf->zv_marker, obuf,
1608 BUF_ZV (old_buf), BUF_ZV_BYTE (old_buf));
1612 /* Get the undo list from the base buffer, so that it appears
1613 that an indirect buffer shares the undo list of its base. */
1614 if (b->base_buffer)
1615 b->undo_list = b->base_buffer->undo_list;
1617 /* If the new current buffer has markers to record PT, BEGV and ZV
1618 when it is not current, fetch them now. */
1619 if (! NILP (b->pt_marker))
1621 BUF_PT (b) = marker_position (b->pt_marker);
1622 BUF_PT_BYTE (b) = marker_byte_position (b->pt_marker);
1624 if (! NILP (b->begv_marker))
1626 BUF_BEGV (b) = marker_position (b->begv_marker);
1627 BUF_BEGV_BYTE (b) = marker_byte_position (b->begv_marker);
1629 if (! NILP (b->zv_marker))
1631 BUF_ZV (b) = marker_position (b->zv_marker);
1632 BUF_ZV_BYTE (b) = marker_byte_position (b->zv_marker);
1635 /* Look down buffer's list of local Lisp variables
1636 to find and update any that forward into C variables. */
1638 for (tail = b->local_var_alist; !NILP (tail); tail = XCDR (tail))
1640 valcontents = XSYMBOL (XCAR (XCAR (tail)))->value;
1641 if ((BUFFER_LOCAL_VALUEP (valcontents)
1642 || SOME_BUFFER_LOCAL_VALUEP (valcontents))
1643 && (tem = XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
1644 (BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem))))
1645 /* Just reference the variable
1646 to cause it to become set for this buffer. */
1647 Fsymbol_value (XCAR (XCAR (tail)));
1650 /* Do the same with any others that were local to the previous buffer */
1652 if (old_buf)
1653 for (tail = old_buf->local_var_alist; !NILP (tail); tail = XCDR (tail))
1655 valcontents = XSYMBOL (XCAR (XCAR (tail)))->value;
1656 if ((BUFFER_LOCAL_VALUEP (valcontents)
1657 || SOME_BUFFER_LOCAL_VALUEP (valcontents))
1658 && (tem = XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
1659 (BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem))))
1660 /* Just reference the variable
1661 to cause it to become set for this buffer. */
1662 Fsymbol_value (XCAR (XCAR (tail)));
1666 /* Switch to buffer B temporarily for redisplay purposes.
1667 This avoids certain things that don't need to be done within redisplay. */
1669 void
1670 set_buffer_temp (b)
1671 struct buffer *b;
1673 register struct buffer *old_buf;
1675 if (current_buffer == b)
1676 return;
1678 old_buf = current_buffer;
1679 current_buffer = b;
1681 if (old_buf)
1683 /* If the old current buffer has markers to record PT, BEGV and ZV
1684 when it is not current, update them now. */
1685 if (! NILP (old_buf->pt_marker))
1687 Lisp_Object obuf;
1688 XSETBUFFER (obuf, old_buf);
1689 set_marker_both (old_buf->pt_marker, obuf,
1690 BUF_PT (old_buf), BUF_PT_BYTE (old_buf));
1692 if (! NILP (old_buf->begv_marker))
1694 Lisp_Object obuf;
1695 XSETBUFFER (obuf, old_buf);
1696 set_marker_both (old_buf->begv_marker, obuf,
1697 BUF_BEGV (old_buf), BUF_BEGV_BYTE (old_buf));
1699 if (! NILP (old_buf->zv_marker))
1701 Lisp_Object obuf;
1702 XSETBUFFER (obuf, old_buf);
1703 set_marker_both (old_buf->zv_marker, obuf,
1704 BUF_ZV (old_buf), BUF_ZV_BYTE (old_buf));
1708 /* If the new current buffer has markers to record PT, BEGV and ZV
1709 when it is not current, fetch them now. */
1710 if (! NILP (b->pt_marker))
1712 BUF_PT (b) = marker_position (b->pt_marker);
1713 BUF_PT_BYTE (b) = marker_byte_position (b->pt_marker);
1715 if (! NILP (b->begv_marker))
1717 BUF_BEGV (b) = marker_position (b->begv_marker);
1718 BUF_BEGV_BYTE (b) = marker_byte_position (b->begv_marker);
1720 if (! NILP (b->zv_marker))
1722 BUF_ZV (b) = marker_position (b->zv_marker);
1723 BUF_ZV_BYTE (b) = marker_byte_position (b->zv_marker);
1727 DEFUN ("set-buffer", Fset_buffer, Sset_buffer, 1, 1, 0,
1728 "Make the buffer BUFFER current for editing operations.\n\
1729 BUFFER may be a buffer or the name of an existing buffer.\n\
1730 See also `save-excursion' when you want to make a buffer current temporarily.\n\
1731 This function does not display the buffer, so its effect ends\n\
1732 when the current command terminates.\n\
1733 Use `switch-to-buffer' or `pop-to-buffer' to switch buffers permanently.")
1734 (buffer)
1735 register Lisp_Object buffer;
1737 register Lisp_Object buf;
1738 buf = Fget_buffer (buffer);
1739 if (NILP (buf))
1740 nsberror (buffer);
1741 if (NILP (XBUFFER (buf)->name))
1742 error ("Selecting deleted buffer");
1743 set_buffer_internal (XBUFFER (buf));
1744 return buf;
1747 /* Set the current buffer to BUFFER provided it is alive. */
1749 Lisp_Object
1750 set_buffer_if_live (buffer)
1751 Lisp_Object buffer;
1753 if (! NILP (XBUFFER (buffer)->name))
1754 Fset_buffer (buffer);
1755 return Qnil;
1758 DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only,
1759 Sbarf_if_buffer_read_only, 0, 0, 0,
1760 "Signal a `buffer-read-only' error if the current buffer is read-only.")
1763 if (!NILP (current_buffer->read_only)
1764 && NILP (Vinhibit_read_only))
1765 Fsignal (Qbuffer_read_only, (Fcons (Fcurrent_buffer (), Qnil)));
1766 return Qnil;
1769 DEFUN ("bury-buffer", Fbury_buffer, Sbury_buffer, 0, 1, "",
1770 "Put BUFFER at the end of the list of all buffers.\n\
1771 There it is the least likely candidate for `other-buffer' to return;\n\
1772 thus, the least likely buffer for \\[switch-to-buffer] to select by default.\n\
1773 If BUFFER is nil or omitted, bury the current buffer.\n\
1774 Also, if BUFFER is nil or omitted, remove the current buffer from the\n\
1775 selected window if it is displayed there.")
1776 (buffer)
1777 register Lisp_Object buffer;
1779 /* Figure out what buffer we're going to bury. */
1780 if (NILP (buffer))
1782 XSETBUFFER (buffer, current_buffer);
1784 /* If we're burying the current buffer, unshow it. */
1785 Fswitch_to_buffer (Fother_buffer (buffer, Qnil, Qnil), Qnil);
1787 else
1789 Lisp_Object buf1;
1791 buf1 = Fget_buffer (buffer);
1792 if (NILP (buf1))
1793 nsberror (buffer);
1794 buffer = buf1;
1797 /* Move buffer to the end of the buffer list. Do nothing if the
1798 buffer is killed. */
1799 if (!NILP (XBUFFER (buffer)->name))
1801 Lisp_Object aelt, link;
1803 aelt = Frassq (buffer, Vbuffer_alist);
1804 link = Fmemq (aelt, Vbuffer_alist);
1805 Vbuffer_alist = Fdelq (aelt, Vbuffer_alist);
1806 XCDR (link) = Qnil;
1807 Vbuffer_alist = nconc2 (Vbuffer_alist, link);
1809 frames_bury_buffer (buffer);
1812 return Qnil;
1815 DEFUN ("erase-buffer", Ferase_buffer, Serase_buffer, 0, 0, "*",
1816 "Delete the entire contents of the current buffer.\n\
1817 Any narrowing restriction in effect (see `narrow-to-region') is removed,\n\
1818 so the buffer is truly empty after this.")
1821 Fwiden ();
1823 del_range (BEG, Z);
1825 current_buffer->last_window_start = 1;
1826 /* Prevent warnings, or suspension of auto saving, that would happen
1827 if future size is less than past size. Use of erase-buffer
1828 implies that the future text is not really related to the past text. */
1829 XSETFASTINT (current_buffer->save_length, 0);
1830 return Qnil;
1833 void
1834 validate_region (b, e)
1835 register Lisp_Object *b, *e;
1837 CHECK_NUMBER_COERCE_MARKER (*b, 0);
1838 CHECK_NUMBER_COERCE_MARKER (*e, 1);
1840 if (XINT (*b) > XINT (*e))
1842 Lisp_Object tem;
1843 tem = *b; *b = *e; *e = tem;
1846 if (!(BEGV <= XINT (*b) && XINT (*b) <= XINT (*e)
1847 && XINT (*e) <= ZV))
1848 args_out_of_range (*b, *e);
1851 /* Advance BYTE_POS up to a character boundary
1852 and return the adjusted position. */
1854 static int
1855 advance_to_char_boundary (byte_pos)
1856 int byte_pos;
1858 int c;
1860 if (byte_pos == BEG)
1861 /* Beginning of buffer is always a character boundary. */
1862 return 1;
1864 c = FETCH_BYTE (byte_pos);
1865 if (! CHAR_HEAD_P (c))
1867 /* We should advance BYTE_POS only when C is a constituent of a
1868 multibyte sequence. */
1869 int orig_byte_pos = byte_pos;
1873 byte_pos--;
1874 c = FETCH_BYTE (byte_pos);
1876 while (! CHAR_HEAD_P (c) && byte_pos > BEG);
1877 INC_POS (byte_pos);
1878 if (byte_pos < orig_byte_pos)
1879 byte_pos = orig_byte_pos;
1880 /* If C is a constituent of a multibyte sequence, BYTE_POS was
1881 surely advance to the correct character boundary. If C is
1882 not, BYTE_POS was unchanged. */
1885 return byte_pos;
1888 DEFUN ("set-buffer-multibyte", Fset_buffer_multibyte, Sset_buffer_multibyte,
1889 1, 1, 0,
1890 "Set the multibyte flag of the current buffer to FLAG.\n\
1891 If FLAG is t, this makes the buffer a multibyte buffer.\n\
1892 If FLAG is nil, this makes the buffer a single-byte buffer.\n\
1893 The buffer contents remain unchanged as a sequence of bytes\n\
1894 but the contents viewed as characters do change.")
1895 (flag)
1896 Lisp_Object flag;
1898 Lisp_Object tail, markers;
1899 struct buffer *other;
1900 int undo_enabled_p = !EQ (current_buffer->undo_list, Qt);
1901 int begv = BEGV, zv = ZV;
1902 int narrowed = (BEG != begv || Z != zv);
1903 int modified_p = !NILP (Fbuffer_modified_p (Qnil));
1905 if (current_buffer->base_buffer)
1906 error ("Cannot do `set-buffer-multibyte' on an indirect buffer");
1908 /* Do nothing if nothing actually changes. */
1909 if (NILP (flag) == NILP (current_buffer->enable_multibyte_characters))
1910 return flag;
1912 /* It would be better to update the list,
1913 but this is good enough for now. */
1914 if (undo_enabled_p)
1915 current_buffer->undo_list = Qt;
1917 /* If the cached position is for this buffer, clear it out. */
1918 clear_charpos_cache (current_buffer);
1920 if (narrowed)
1921 Fwiden ();
1923 if (NILP (flag))
1925 int pos, stop;
1926 unsigned char *p;
1928 /* Do this first, so it can use CHAR_TO_BYTE
1929 to calculate the old correspondences. */
1930 set_intervals_multibyte (0);
1932 current_buffer->enable_multibyte_characters = Qnil;
1934 Z = Z_BYTE;
1935 BEGV = BEGV_BYTE;
1936 ZV = ZV_BYTE;
1937 GPT = GPT_BYTE;
1938 TEMP_SET_PT_BOTH (PT_BYTE, PT_BYTE);
1940 tail = BUF_MARKERS (current_buffer);
1941 while (! NILP (tail))
1943 XMARKER (tail)->charpos = XMARKER (tail)->bytepos;
1944 tail = XMARKER (tail)->chain;
1947 /* Convert multibyte form of 8-bit characters to unibyte. */
1948 pos = BEG;
1949 stop = GPT;
1950 p = BEG_ADDR;
1951 while (1)
1953 int c, bytes;
1955 if (pos == stop)
1957 if (pos == Z)
1958 break;
1959 p = GAP_END_ADDR;
1960 stop = Z;
1962 if (MULTIBYTE_STR_AS_UNIBYTE_P (p, bytes))
1963 p += bytes, pos += bytes;
1964 else
1966 c = STRING_CHAR (p, stop - pos);
1967 /* Delete all bytes for this 8-bit character but the
1968 last one, and change the last one to the charcter
1969 code. */
1970 bytes--;
1971 del_range_2 (pos, pos, pos + bytes, pos + bytes, 0);
1972 p = GAP_END_ADDR;
1973 *p++ = c;
1974 pos++;
1975 if (begv > pos)
1976 begv -= bytes;
1977 if (zv > pos)
1978 zv -= bytes;
1979 stop = Z;
1982 if (narrowed)
1983 Fnarrow_to_region (make_number (begv), make_number (zv));
1985 else
1987 int pt = PT;
1988 int pos, stop;
1989 unsigned char *p;
1991 /* Be sure not to have a multibyte sequence striding over the GAP.
1992 Ex: We change this: "...abc\201 _GAP_ \241def..."
1993 to: "...abc _GAP_ \201\241def..." */
1995 if (GPT_BYTE > 1 && GPT_BYTE < Z_BYTE
1996 && ! CHAR_HEAD_P (*(GAP_END_ADDR)))
1998 unsigned char *p = GPT_ADDR - 1;
2000 while (! CHAR_HEAD_P (*p) && p > BEG_ADDR) p--;
2001 if (BASE_LEADING_CODE_P (*p))
2003 int new_gpt = GPT_BYTE - (GPT_ADDR - p);
2005 move_gap_both (new_gpt, new_gpt);
2009 /* Make the buffer contents valid as multibyte by converting
2010 8-bit characters to multibyte form. */
2011 pos = BEG;
2012 stop = GPT;
2013 p = BEG_ADDR;
2014 while (1)
2016 int bytes;
2018 if (pos == stop)
2020 if (pos == Z)
2021 break;
2022 p = GAP_END_ADDR;
2023 stop = Z;
2026 if (UNIBYTE_STR_AS_MULTIBYTE_P (p, stop - pos, bytes))
2027 p += bytes, pos += bytes;
2028 else
2030 unsigned char tmp[MAX_MULTIBYTE_LENGTH];
2032 bytes = CHAR_STRING (*p, tmp);
2033 *p = tmp[0];
2034 TEMP_SET_PT_BOTH (pos + 1, pos + 1);
2035 bytes--;
2036 insert_1_both (tmp + 1, bytes, bytes, 1, 0, 0);
2037 /* Now the gap is after the just inserted data. */
2038 pos = GPT;
2039 p = GAP_END_ADDR;
2040 if (pos <= begv)
2041 begv += bytes;
2042 if (pos <= zv)
2043 zv += bytes;
2044 if (pos <= pt)
2045 pt += bytes;
2046 stop = Z;
2050 if (pt != PT)
2051 TEMP_SET_PT (pt);
2053 if (narrowed)
2054 Fnarrow_to_region (make_number (begv), make_number (zv));
2056 /* Do this first, so that chars_in_text asks the right question.
2057 set_intervals_multibyte needs it too. */
2058 current_buffer->enable_multibyte_characters = Qt;
2060 GPT_BYTE = advance_to_char_boundary (GPT_BYTE);
2061 GPT = chars_in_text (BEG_ADDR, GPT_BYTE - BEG_BYTE) + BEG;
2063 Z = chars_in_text (GAP_END_ADDR, Z_BYTE - GPT_BYTE) + GPT;
2065 BEGV_BYTE = advance_to_char_boundary (BEGV_BYTE);
2066 if (BEGV_BYTE > GPT_BYTE)
2067 BEGV = chars_in_text (GAP_END_ADDR, BEGV_BYTE - GPT_BYTE) + GPT;
2068 else
2069 BEGV = chars_in_text (BEG_ADDR, BEGV_BYTE - BEG_BYTE) + BEG;
2071 ZV_BYTE = advance_to_char_boundary (ZV_BYTE);
2072 if (ZV_BYTE > GPT_BYTE)
2073 ZV = chars_in_text (GAP_END_ADDR, ZV_BYTE - GPT_BYTE) + GPT;
2074 else
2075 ZV = chars_in_text (BEG_ADDR, ZV_BYTE - BEG_BYTE) + BEG;
2078 int pt_byte = advance_to_char_boundary (PT_BYTE);
2079 int pt;
2081 if (pt_byte > GPT_BYTE)
2082 pt = chars_in_text (GAP_END_ADDR, pt_byte - GPT_BYTE) + GPT;
2083 else
2084 pt = chars_in_text (BEG_ADDR, pt_byte - BEG_BYTE) + BEG;
2085 TEMP_SET_PT_BOTH (pt, pt_byte);
2088 tail = markers = BUF_MARKERS (current_buffer);
2090 /* This prevents BYTE_TO_CHAR (that is, buf_bytepos_to_charpos) from
2091 getting confused by the markers that have not yet been updated.
2092 It is also a signal that it should never create a marker. */
2093 BUF_MARKERS (current_buffer) = Qnil;
2095 while (! NILP (tail))
2097 XMARKER (tail)->bytepos
2098 = advance_to_char_boundary (XMARKER (tail)->bytepos);
2099 XMARKER (tail)->charpos = BYTE_TO_CHAR (XMARKER (tail)->bytepos);
2101 tail = XMARKER (tail)->chain;
2104 /* Make sure no markers were put on the chain
2105 while the chain value was incorrect. */
2106 if (! EQ (BUF_MARKERS (current_buffer), Qnil))
2107 abort ();
2109 BUF_MARKERS (current_buffer) = markers;
2111 /* Do this last, so it can calculate the new correspondences
2112 between chars and bytes. */
2113 set_intervals_multibyte (1);
2116 if (undo_enabled_p)
2117 current_buffer->undo_list = Qnil;
2119 /* Changing the multibyteness of a buffer means that all windows
2120 showing that buffer must be updated thoroughly. */
2121 current_buffer->prevent_redisplay_optimizations_p = 1;
2122 ++windows_or_buffers_changed;
2124 /* Copy this buffer's new multibyte status
2125 into all of its indirect buffers. */
2126 for (other = all_buffers; other; other = other->next)
2127 if (other->base_buffer == current_buffer && !NILP (other->name))
2129 other->enable_multibyte_characters
2130 = current_buffer->enable_multibyte_characters;
2131 other->prevent_redisplay_optimizations_p = 1;
2134 /* Restore the modifiedness of the buffer. */
2135 if (!modified_p && !NILP (Fbuffer_modified_p (Qnil)))
2136 Fset_buffer_modified_p (Qnil);
2138 return flag;
2141 DEFUN ("kill-all-local-variables", Fkill_all_local_variables, Skill_all_local_variables,
2142 0, 0, 0,
2143 "Switch to Fundamental mode by killing current buffer's local variables.\n\
2144 Most local variable bindings are eliminated so that the default values\n\
2145 become effective once more. Also, the syntax table is set from\n\
2146 `standard-syntax-table', the local keymap is set to nil,\n\
2147 and the abbrev table from `fundamental-mode-abbrev-table'.\n\
2148 This function also forces redisplay of the mode line.\n\
2150 Every function to select a new major mode starts by\n\
2151 calling this function.\n\n\
2152 As a special exception, local variables whose names have\n\
2153 a non-nil `permanent-local' property are not eliminated by this function.\n\
2155 The first thing this function does is run\n\
2156 the normal hook `change-major-mode-hook'.")
2159 register Lisp_Object alist, sym, tem;
2160 Lisp_Object oalist;
2162 if (!NILP (Vrun_hooks))
2163 call1 (Vrun_hooks, intern ("change-major-mode-hook"));
2164 oalist = current_buffer->local_var_alist;
2166 /* Make sure none of the bindings in oalist
2167 remain swapped in, in their symbols. */
2169 swap_out_buffer_local_variables (current_buffer);
2171 /* Actually eliminate all local bindings of this buffer. */
2173 reset_buffer_local_variables (current_buffer, 0);
2175 /* Redisplay mode lines; we are changing major mode. */
2177 update_mode_lines++;
2179 /* Any which are supposed to be permanent,
2180 make local again, with the same values they had. */
2182 for (alist = oalist; !NILP (alist); alist = XCDR (alist))
2184 sym = XCAR (XCAR (alist));
2185 tem = Fget (sym, Qpermanent_local);
2186 if (! NILP (tem))
2188 Fmake_local_variable (sym);
2189 Fset (sym, XCDR (XCAR (alist)));
2193 /* Force mode-line redisplay. Useful here because all major mode
2194 commands call this function. */
2195 update_mode_lines++;
2197 return Qnil;
2200 /* Make sure no local variables remain set up with buffer B
2201 for their current values. */
2203 static void
2204 swap_out_buffer_local_variables (b)
2205 struct buffer *b;
2207 Lisp_Object oalist, alist, sym, tem, buffer;
2209 XSETBUFFER (buffer, b);
2210 oalist = b->local_var_alist;
2212 for (alist = oalist; !NILP (alist); alist = XCDR (alist))
2214 sym = XCAR (XCAR (alist));
2216 /* Need not do anything if some other buffer's binding is now encached. */
2217 tem = XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->buffer;
2218 if (BUFFERP (tem) && XBUFFER (tem) == current_buffer)
2220 /* Symbol is set up for this buffer's old local value.
2221 Set it up for the current buffer with the default value. */
2223 tem = XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->cdr;
2224 /* Store the symbol's current value into the alist entry
2225 it is currently set up for. This is so that, if the
2226 local is marked permanent, and we make it local again
2227 later in Fkill_all_local_variables, we don't lose the value. */
2228 XCDR (XCAR (tem))
2229 = do_symval_forwarding (XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->realvalue);
2230 /* Switch to the symbol's default-value alist entry. */
2231 XCAR (tem) = tem;
2232 /* Mark it as current for buffer B. */
2233 XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->buffer = buffer;
2234 /* Store the current value into any forwarding in the symbol. */
2235 store_symval_forwarding (sym,
2236 XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->realvalue,
2237 XCDR (tem));
2242 /* Find all the overlays in the current buffer that contain position POS.
2243 Return the number found, and store them in a vector in *VEC_PTR.
2244 Store in *LEN_PTR the size allocated for the vector.
2245 Store in *NEXT_PTR the next position after POS where an overlay starts,
2246 or ZV if there are no more overlays.
2247 Store in *PREV_PTR the previous position before POS where an overlay ends,
2248 or where an overlay starts which ends at or after POS;
2249 or BEGV if there are no such overlays.
2250 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
2252 *VEC_PTR and *LEN_PTR should contain a valid vector and size
2253 when this function is called.
2255 If EXTEND is non-zero, we make the vector bigger if necessary.
2256 If EXTEND is zero, we never extend the vector,
2257 and we store only as many overlays as will fit.
2258 But we still return the total number of overlays.
2260 If CHANGE_REQ is true, then any position written into *PREV_PTR or
2261 *NEXT_PTR is guaranteed to be not equal to POS, unless it is the
2262 default (BEGV or ZV). */
2265 overlays_at (pos, extend, vec_ptr, len_ptr, next_ptr, prev_ptr, change_req)
2266 int pos;
2267 int extend;
2268 Lisp_Object **vec_ptr;
2269 int *len_ptr;
2270 int *next_ptr;
2271 int *prev_ptr;
2272 int change_req;
2274 Lisp_Object tail, overlay, start, end;
2275 int idx = 0;
2276 int len = *len_ptr;
2277 Lisp_Object *vec = *vec_ptr;
2278 int next = ZV;
2279 int prev = BEGV;
2280 int inhibit_storing = 0;
2282 for (tail = current_buffer->overlays_before;
2283 GC_CONSP (tail);
2284 tail = XCDR (tail))
2286 int startpos, endpos;
2288 overlay = XCAR (tail);
2290 start = OVERLAY_START (overlay);
2291 end = OVERLAY_END (overlay);
2292 endpos = OVERLAY_POSITION (end);
2293 if (endpos < pos)
2295 if (prev < endpos)
2296 prev = endpos;
2297 break;
2299 startpos = OVERLAY_POSITION (start);
2300 /* This one ends at or after POS
2301 so its start counts for PREV_PTR if it's before POS. */
2302 if (prev < startpos && startpos < pos)
2303 prev = startpos;
2304 if (endpos == pos)
2305 continue;
2306 if (startpos <= pos)
2308 if (idx == len)
2310 /* The supplied vector is full.
2311 Either make it bigger, or don't store any more in it. */
2312 if (extend)
2314 /* Make it work with an initial len == 0. */
2315 len *= 2;
2316 if (len == 0)
2317 len = 4;
2318 *len_ptr = len;
2319 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2320 *vec_ptr = vec;
2322 else
2323 inhibit_storing = 1;
2326 if (!inhibit_storing)
2327 vec[idx] = overlay;
2328 /* Keep counting overlays even if we can't return them all. */
2329 idx++;
2331 else if (startpos < next)
2332 next = startpos;
2335 for (tail = current_buffer->overlays_after;
2336 GC_CONSP (tail);
2337 tail = XCDR (tail))
2339 int startpos, endpos;
2341 overlay = XCAR (tail);
2343 start = OVERLAY_START (overlay);
2344 end = OVERLAY_END (overlay);
2345 startpos = OVERLAY_POSITION (start);
2346 if (pos < startpos)
2348 if (startpos < next)
2349 next = startpos;
2350 break;
2352 endpos = OVERLAY_POSITION (end);
2353 if (pos < endpos)
2355 if (idx == len)
2357 if (extend)
2359 *len_ptr = len *= 2;
2360 if (len == 0)
2361 len = *len_ptr = 4;
2362 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2363 *vec_ptr = vec;
2365 else
2366 inhibit_storing = 1;
2369 if (!inhibit_storing)
2370 vec[idx] = overlay;
2371 idx++;
2373 if (startpos < pos && startpos > prev)
2374 prev = startpos;
2376 else if (endpos < pos && endpos > prev)
2377 prev = endpos;
2378 else if (endpos == pos && startpos > prev
2379 && (!change_req || startpos < pos))
2380 prev = startpos;
2383 if (next_ptr)
2384 *next_ptr = next;
2385 if (prev_ptr)
2386 *prev_ptr = prev;
2387 return idx;
2390 /* Find all the overlays in the current buffer that overlap the range BEG-END
2391 or are empty at BEG.
2393 Return the number found, and store them in a vector in *VEC_PTR.
2394 Store in *LEN_PTR the size allocated for the vector.
2395 Store in *NEXT_PTR the next position after POS where an overlay starts,
2396 or ZV if there are no more overlays.
2397 Store in *PREV_PTR the previous position before POS where an overlay ends,
2398 or BEGV if there are no previous overlays.
2399 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
2401 *VEC_PTR and *LEN_PTR should contain a valid vector and size
2402 when this function is called.
2404 If EXTEND is non-zero, we make the vector bigger if necessary.
2405 If EXTEND is zero, we never extend the vector,
2406 and we store only as many overlays as will fit.
2407 But we still return the total number of overlays. */
2410 overlays_in (beg, end, extend, vec_ptr, len_ptr, next_ptr, prev_ptr)
2411 int beg, end;
2412 int extend;
2413 Lisp_Object **vec_ptr;
2414 int *len_ptr;
2415 int *next_ptr;
2416 int *prev_ptr;
2418 Lisp_Object tail, overlay, ostart, oend;
2419 int idx = 0;
2420 int len = *len_ptr;
2421 Lisp_Object *vec = *vec_ptr;
2422 int next = ZV;
2423 int prev = BEGV;
2424 int inhibit_storing = 0;
2426 for (tail = current_buffer->overlays_before;
2427 GC_CONSP (tail);
2428 tail = XCDR (tail))
2430 int startpos, endpos;
2432 overlay = XCAR (tail);
2434 ostart = OVERLAY_START (overlay);
2435 oend = OVERLAY_END (overlay);
2436 endpos = OVERLAY_POSITION (oend);
2437 if (endpos < beg)
2439 if (prev < endpos)
2440 prev = endpos;
2441 break;
2443 startpos = OVERLAY_POSITION (ostart);
2444 /* Count an interval if it either overlaps the range
2445 or is empty at the start of the range. */
2446 if ((beg < endpos && startpos < end)
2447 || (startpos == endpos && beg == endpos))
2449 if (idx == len)
2451 /* The supplied vector is full.
2452 Either make it bigger, or don't store any more in it. */
2453 if (extend)
2455 *len_ptr = len *= 2;
2456 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2457 *vec_ptr = vec;
2459 else
2460 inhibit_storing = 1;
2463 if (!inhibit_storing)
2464 vec[idx] = overlay;
2465 /* Keep counting overlays even if we can't return them all. */
2466 idx++;
2468 else if (startpos < next)
2469 next = startpos;
2472 for (tail = current_buffer->overlays_after;
2473 GC_CONSP (tail);
2474 tail = XCDR (tail))
2476 int startpos, endpos;
2478 overlay = XCAR (tail);
2480 ostart = OVERLAY_START (overlay);
2481 oend = OVERLAY_END (overlay);
2482 startpos = OVERLAY_POSITION (ostart);
2483 if (end < startpos)
2485 if (startpos < next)
2486 next = startpos;
2487 break;
2489 endpos = OVERLAY_POSITION (oend);
2490 /* Count an interval if it either overlaps the range
2491 or is empty at the start of the range. */
2492 if ((beg < endpos && startpos < end)
2493 || (startpos == endpos && beg == endpos))
2495 if (idx == len)
2497 if (extend)
2499 *len_ptr = len *= 2;
2500 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2501 *vec_ptr = vec;
2503 else
2504 inhibit_storing = 1;
2507 if (!inhibit_storing)
2508 vec[idx] = overlay;
2509 idx++;
2511 else if (endpos < beg && endpos > prev)
2512 prev = endpos;
2515 if (next_ptr)
2516 *next_ptr = next;
2517 if (prev_ptr)
2518 *prev_ptr = prev;
2519 return idx;
2522 /* Fast function to just test if we're at an overlay boundary. */
2524 overlay_touches_p (pos)
2525 int pos;
2527 Lisp_Object tail, overlay;
2529 for (tail = current_buffer->overlays_before; GC_CONSP (tail);
2530 tail = XCDR (tail))
2532 int endpos;
2534 overlay = XCAR (tail);
2535 if (!GC_OVERLAYP (overlay))
2536 abort ();
2538 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2539 if (endpos < pos)
2540 break;
2541 if (endpos == pos || OVERLAY_POSITION (OVERLAY_START (overlay)) == pos)
2542 return 1;
2545 for (tail = current_buffer->overlays_after; GC_CONSP (tail);
2546 tail = XCDR (tail))
2548 int startpos;
2550 overlay = XCAR (tail);
2551 if (!GC_OVERLAYP (overlay))
2552 abort ();
2554 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2555 if (pos < startpos)
2556 break;
2557 if (startpos == pos || OVERLAY_POSITION (OVERLAY_END (overlay)) == pos)
2558 return 1;
2560 return 0;
2563 struct sortvec
2565 Lisp_Object overlay;
2566 int beg, end;
2567 int priority;
2570 static int
2571 compare_overlays (v1, v2)
2572 const void *v1, *v2;
2574 const struct sortvec *s1 = (const struct sortvec *) v1;
2575 const struct sortvec *s2 = (const struct sortvec *) v2;
2576 if (s1->priority != s2->priority)
2577 return s1->priority - s2->priority;
2578 if (s1->beg != s2->beg)
2579 return s1->beg - s2->beg;
2580 if (s1->end != s2->end)
2581 return s2->end - s1->end;
2582 return 0;
2585 /* Sort an array of overlays by priority. The array is modified in place.
2586 The return value is the new size; this may be smaller than the original
2587 size if some of the overlays were invalid or were window-specific. */
2589 sort_overlays (overlay_vec, noverlays, w)
2590 Lisp_Object *overlay_vec;
2591 int noverlays;
2592 struct window *w;
2594 int i, j;
2595 struct sortvec *sortvec;
2596 sortvec = (struct sortvec *) alloca (noverlays * sizeof (struct sortvec));
2598 /* Put the valid and relevant overlays into sortvec. */
2600 for (i = 0, j = 0; i < noverlays; i++)
2602 Lisp_Object tem;
2603 Lisp_Object overlay;
2605 overlay = overlay_vec[i];
2606 if (OVERLAY_VALID (overlay)
2607 && OVERLAY_POSITION (OVERLAY_START (overlay)) > 0
2608 && OVERLAY_POSITION (OVERLAY_END (overlay)) > 0)
2610 /* If we're interested in a specific window, then ignore
2611 overlays that are limited to some other window. */
2612 if (w)
2614 Lisp_Object window;
2616 window = Foverlay_get (overlay, Qwindow);
2617 if (WINDOWP (window) && XWINDOW (window) != w)
2618 continue;
2621 /* This overlay is good and counts: put it into sortvec. */
2622 sortvec[j].overlay = overlay;
2623 sortvec[j].beg = OVERLAY_POSITION (OVERLAY_START (overlay));
2624 sortvec[j].end = OVERLAY_POSITION (OVERLAY_END (overlay));
2625 tem = Foverlay_get (overlay, Qpriority);
2626 if (INTEGERP (tem))
2627 sortvec[j].priority = XINT (tem);
2628 else
2629 sortvec[j].priority = 0;
2630 j++;
2633 noverlays = j;
2635 /* Sort the overlays into the proper order: increasing priority. */
2637 if (noverlays > 1)
2638 qsort (sortvec, noverlays, sizeof (struct sortvec), compare_overlays);
2640 for (i = 0; i < noverlays; i++)
2641 overlay_vec[i] = sortvec[i].overlay;
2642 return (noverlays);
2645 struct sortstr
2647 Lisp_Object string, string2;
2648 int size;
2649 int priority;
2652 struct sortstrlist
2654 struct sortstr *buf; /* An array that expands as needed; never freed. */
2655 int size; /* Allocated length of that array. */
2656 int used; /* How much of the array is currently in use. */
2657 int bytes; /* Total length of the strings in buf. */
2660 /* Buffers for storing information about the overlays touching a given
2661 position. These could be automatic variables in overlay_strings, but
2662 it's more efficient to hold onto the memory instead of repeatedly
2663 allocating and freeing it. */
2664 static struct sortstrlist overlay_heads, overlay_tails;
2665 static unsigned char *overlay_str_buf;
2667 /* Allocated length of overlay_str_buf. */
2668 static int overlay_str_len;
2670 /* A comparison function suitable for passing to qsort. */
2671 static int
2672 cmp_for_strings (as1, as2)
2673 char *as1, *as2;
2675 struct sortstr *s1 = (struct sortstr *)as1;
2676 struct sortstr *s2 = (struct sortstr *)as2;
2677 if (s1->size != s2->size)
2678 return s2->size - s1->size;
2679 if (s1->priority != s2->priority)
2680 return s1->priority - s2->priority;
2681 return 0;
2684 static void
2685 record_overlay_string (ssl, str, str2, pri, size)
2686 struct sortstrlist *ssl;
2687 Lisp_Object str, str2, pri;
2688 int size;
2690 int nbytes;
2692 if (ssl->used == ssl->size)
2694 if (ssl->buf)
2695 ssl->size *= 2;
2696 else
2697 ssl->size = 5;
2698 ssl->buf = ((struct sortstr *)
2699 xrealloc (ssl->buf, ssl->size * sizeof (struct sortstr)));
2701 ssl->buf[ssl->used].string = str;
2702 ssl->buf[ssl->used].string2 = str2;
2703 ssl->buf[ssl->used].size = size;
2704 ssl->buf[ssl->used].priority = (INTEGERP (pri) ? XINT (pri) : 0);
2705 ssl->used++;
2707 if (NILP (current_buffer->enable_multibyte_characters))
2708 nbytes = XSTRING (str)->size;
2709 else if (! STRING_MULTIBYTE (str))
2710 nbytes = count_size_as_multibyte (XSTRING (str)->data,
2711 STRING_BYTES (XSTRING (str)));
2712 else
2713 nbytes = STRING_BYTES (XSTRING (str));
2715 ssl->bytes += nbytes;
2717 if (STRINGP (str2))
2719 if (NILP (current_buffer->enable_multibyte_characters))
2720 nbytes = XSTRING (str2)->size;
2721 else if (! STRING_MULTIBYTE (str2))
2722 nbytes = count_size_as_multibyte (XSTRING (str2)->data,
2723 STRING_BYTES (XSTRING (str2)));
2724 else
2725 nbytes = STRING_BYTES (XSTRING (str2));
2727 ssl->bytes += nbytes;
2731 /* Return the concatenation of the strings associated with overlays that
2732 begin or end at POS, ignoring overlays that are specific to a window
2733 other than W. The strings are concatenated in the appropriate order:
2734 shorter overlays nest inside longer ones, and higher priority inside
2735 lower. Normally all of the after-strings come first, but zero-sized
2736 overlays have their after-strings ride along with the before-strings
2737 because it would look strange to print them inside-out.
2739 Returns the string length, and stores the contents indirectly through
2740 PSTR, if that variable is non-null. The string may be overwritten by
2741 subsequent calls. */
2744 overlay_strings (pos, w, pstr)
2745 int pos;
2746 struct window *w;
2747 unsigned char **pstr;
2749 Lisp_Object ov, overlay, window, str;
2750 int startpos, endpos;
2751 int multibyte = ! NILP (current_buffer->enable_multibyte_characters);
2753 overlay_heads.used = overlay_heads.bytes = 0;
2754 overlay_tails.used = overlay_tails.bytes = 0;
2755 for (ov = current_buffer->overlays_before; CONSP (ov); ov = XCDR (ov))
2757 overlay = XCAR (ov);
2758 if (!OVERLAYP (overlay))
2759 abort ();
2761 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2762 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2763 if (endpos < pos)
2764 break;
2765 if (endpos != pos && startpos != pos)
2766 continue;
2767 window = Foverlay_get (overlay, Qwindow);
2768 if (WINDOWP (window) && XWINDOW (window) != w)
2769 continue;
2770 if (startpos == pos
2771 && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
2772 record_overlay_string (&overlay_heads, str,
2773 (startpos == endpos
2774 ? Foverlay_get (overlay, Qafter_string)
2775 : Qnil),
2776 Foverlay_get (overlay, Qpriority),
2777 endpos - startpos);
2778 else if (endpos == pos
2779 && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
2780 record_overlay_string (&overlay_tails, str, Qnil,
2781 Foverlay_get (overlay, Qpriority),
2782 endpos - startpos);
2784 for (ov = current_buffer->overlays_after; CONSP (ov); ov = XCDR (ov))
2786 overlay = XCAR (ov);
2787 if (!OVERLAYP (overlay))
2788 abort ();
2790 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2791 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2792 if (startpos > pos)
2793 break;
2794 if (endpos != pos && startpos != pos)
2795 continue;
2796 window = Foverlay_get (overlay, Qwindow);
2797 if (WINDOWP (window) && XWINDOW (window) != w)
2798 continue;
2799 if (startpos == pos
2800 && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
2801 record_overlay_string (&overlay_heads, str,
2802 (startpos == endpos
2803 ? Foverlay_get (overlay, Qafter_string)
2804 : Qnil),
2805 Foverlay_get (overlay, Qpriority),
2806 endpos - startpos);
2807 else if (endpos == pos
2808 && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
2809 record_overlay_string (&overlay_tails, str, Qnil,
2810 Foverlay_get (overlay, Qpriority),
2811 endpos - startpos);
2813 if (overlay_tails.used > 1)
2814 qsort (overlay_tails.buf, overlay_tails.used, sizeof (struct sortstr),
2815 cmp_for_strings);
2816 if (overlay_heads.used > 1)
2817 qsort (overlay_heads.buf, overlay_heads.used, sizeof (struct sortstr),
2818 cmp_for_strings);
2819 if (overlay_heads.bytes || overlay_tails.bytes)
2821 Lisp_Object tem;
2822 int i;
2823 unsigned char *p;
2824 int total = overlay_heads.bytes + overlay_tails.bytes;
2826 if (total > overlay_str_len)
2828 overlay_str_len = total;
2829 overlay_str_buf = (unsigned char *)xrealloc (overlay_str_buf,
2830 total);
2832 p = overlay_str_buf;
2833 for (i = overlay_tails.used; --i >= 0;)
2835 int nbytes;
2836 tem = overlay_tails.buf[i].string;
2837 nbytes = copy_text (XSTRING (tem)->data, p,
2838 STRING_BYTES (XSTRING (tem)),
2839 STRING_MULTIBYTE (tem), multibyte);
2840 p += nbytes;
2842 for (i = 0; i < overlay_heads.used; ++i)
2844 int nbytes;
2845 tem = overlay_heads.buf[i].string;
2846 nbytes = copy_text (XSTRING (tem)->data, p,
2847 STRING_BYTES (XSTRING (tem)),
2848 STRING_MULTIBYTE (tem), multibyte);
2849 p += nbytes;
2850 tem = overlay_heads.buf[i].string2;
2851 if (STRINGP (tem))
2853 nbytes = copy_text (XSTRING (tem)->data, p,
2854 STRING_BYTES (XSTRING (tem)),
2855 STRING_MULTIBYTE (tem), multibyte);
2856 p += nbytes;
2859 if (p != overlay_str_buf + total)
2860 abort ();
2861 if (pstr)
2862 *pstr = overlay_str_buf;
2863 return total;
2865 return 0;
2868 /* Shift overlays in BUF's overlay lists, to center the lists at POS. */
2870 void
2871 recenter_overlay_lists (buf, pos)
2872 struct buffer *buf;
2873 int pos;
2875 Lisp_Object overlay, tail, next, prev, beg, end;
2877 /* See if anything in overlays_before should move to overlays_after. */
2879 /* We don't strictly need prev in this loop; it should always be nil.
2880 But we use it for symmetry and in case that should cease to be true
2881 with some future change. */
2882 prev = Qnil;
2883 for (tail = buf->overlays_before;
2884 CONSP (tail);
2885 prev = tail, tail = next)
2887 next = XCDR (tail);
2888 overlay = XCAR (tail);
2890 /* If the overlay is not valid, get rid of it. */
2891 if (!OVERLAY_VALID (overlay))
2892 #if 1
2893 abort ();
2894 #else
2896 /* Splice the cons cell TAIL out of overlays_before. */
2897 if (!NILP (prev))
2898 XCDR (prev) = next;
2899 else
2900 buf->overlays_before = next;
2901 tail = prev;
2902 continue;
2904 #endif
2906 beg = OVERLAY_START (overlay);
2907 end = OVERLAY_END (overlay);
2909 if (OVERLAY_POSITION (end) > pos)
2911 /* OVERLAY needs to be moved. */
2912 int where = OVERLAY_POSITION (beg);
2913 Lisp_Object other, other_prev;
2915 /* Splice the cons cell TAIL out of overlays_before. */
2916 if (!NILP (prev))
2917 XCDR (prev) = next;
2918 else
2919 buf->overlays_before = next;
2921 /* Search thru overlays_after for where to put it. */
2922 other_prev = Qnil;
2923 for (other = buf->overlays_after;
2924 CONSP (other);
2925 other_prev = other, other = XCDR (other))
2927 Lisp_Object otherbeg, otheroverlay;
2929 otheroverlay = XCAR (other);
2930 if (! OVERLAY_VALID (otheroverlay))
2931 abort ();
2933 otherbeg = OVERLAY_START (otheroverlay);
2934 if (OVERLAY_POSITION (otherbeg) >= where)
2935 break;
2938 /* Add TAIL to overlays_after before OTHER. */
2939 XCDR (tail) = other;
2940 if (!NILP (other_prev))
2941 XCDR (other_prev) = tail;
2942 else
2943 buf->overlays_after = tail;
2944 tail = prev;
2946 else
2947 /* We've reached the things that should stay in overlays_before.
2948 All the rest of overlays_before must end even earlier,
2949 so stop now. */
2950 break;
2953 /* See if anything in overlays_after should be in overlays_before. */
2954 prev = Qnil;
2955 for (tail = buf->overlays_after;
2956 CONSP (tail);
2957 prev = tail, tail = next)
2959 next = XCDR (tail);
2960 overlay = XCAR (tail);
2962 /* If the overlay is not valid, get rid of it. */
2963 if (!OVERLAY_VALID (overlay))
2964 #if 1
2965 abort ();
2966 #else
2968 /* Splice the cons cell TAIL out of overlays_after. */
2969 if (!NILP (prev))
2970 XCDR (prev) = next;
2971 else
2972 buf->overlays_after = next;
2973 tail = prev;
2974 continue;
2976 #endif
2978 beg = OVERLAY_START (overlay);
2979 end = OVERLAY_END (overlay);
2981 /* Stop looking, when we know that nothing further
2982 can possibly end before POS. */
2983 if (OVERLAY_POSITION (beg) > pos)
2984 break;
2986 if (OVERLAY_POSITION (end) <= pos)
2988 /* OVERLAY needs to be moved. */
2989 int where = OVERLAY_POSITION (end);
2990 Lisp_Object other, other_prev;
2992 /* Splice the cons cell TAIL out of overlays_after. */
2993 if (!NILP (prev))
2994 XCDR (prev) = next;
2995 else
2996 buf->overlays_after = next;
2998 /* Search thru overlays_before for where to put it. */
2999 other_prev = Qnil;
3000 for (other = buf->overlays_before;
3001 CONSP (other);
3002 other_prev = other, other = XCDR (other))
3004 Lisp_Object otherend, otheroverlay;
3006 otheroverlay = XCAR (other);
3007 if (! OVERLAY_VALID (otheroverlay))
3008 abort ();
3010 otherend = OVERLAY_END (otheroverlay);
3011 if (OVERLAY_POSITION (otherend) <= where)
3012 break;
3015 /* Add TAIL to overlays_before before OTHER. */
3016 XCDR (tail) = other;
3017 if (!NILP (other_prev))
3018 XCDR (other_prev) = tail;
3019 else
3020 buf->overlays_before = tail;
3021 tail = prev;
3025 XSETFASTINT (buf->overlay_center, pos);
3028 void
3029 adjust_overlays_for_insert (pos, length)
3030 int pos;
3031 int length;
3033 /* After an insertion, the lists are still sorted properly,
3034 but we may need to update the value of the overlay center. */
3035 if (XFASTINT (current_buffer->overlay_center) >= pos)
3036 XSETFASTINT (current_buffer->overlay_center,
3037 XFASTINT (current_buffer->overlay_center) + length);
3040 void
3041 adjust_overlays_for_delete (pos, length)
3042 int pos;
3043 int length;
3045 if (XFASTINT (current_buffer->overlay_center) < pos)
3046 /* The deletion was to our right. No change needed; the before- and
3047 after-lists are still consistent. */
3049 else if (XFASTINT (current_buffer->overlay_center) > pos + length)
3050 /* The deletion was to our left. We need to adjust the center value
3051 to account for the change in position, but the lists are consistent
3052 given the new value. */
3053 XSETFASTINT (current_buffer->overlay_center,
3054 XFASTINT (current_buffer->overlay_center) - length);
3055 else
3056 /* We're right in the middle. There might be things on the after-list
3057 that now belong on the before-list. Recentering will move them,
3058 and also update the center point. */
3059 recenter_overlay_lists (current_buffer, pos);
3062 /* Fix up overlays that were garbled as a result of permuting markers
3063 in the range START through END. Any overlay with at least one
3064 endpoint in this range will need to be unlinked from the overlay
3065 list and reinserted in its proper place.
3066 Such an overlay might even have negative size at this point.
3067 If so, we'll reverse the endpoints. Can you think of anything
3068 better to do in this situation? */
3069 void
3070 fix_overlays_in_range (start, end)
3071 register int start, end;
3073 Lisp_Object overlay;
3074 Lisp_Object before_list, after_list;
3075 Lisp_Object *ptail, *pbefore = &before_list, *pafter = &after_list;
3076 int startpos, endpos;
3078 /* This algorithm shifts links around instead of consing and GCing.
3079 The loop invariant is that before_list (resp. after_list) is a
3080 well-formed list except that its last element, the one that
3081 *pbefore (resp. *pafter) points to, is still uninitialized.
3082 So it's not a bug that before_list isn't initialized, although
3083 it may look strange. */
3084 for (ptail = &current_buffer->overlays_before; CONSP (*ptail);)
3086 overlay = XCAR (*ptail);
3087 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3088 if (endpos < start)
3089 break;
3090 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3091 if (endpos < end
3092 || (startpos >= start && startpos < end))
3094 /* If the overlay is backwards, fix that now. */
3095 if (startpos > endpos)
3097 int tem;
3098 Fset_marker (OVERLAY_START (overlay), make_number (endpos),
3099 Qnil);
3100 Fset_marker (OVERLAY_END (overlay), make_number (startpos),
3101 Qnil);
3102 tem = startpos; startpos = endpos; endpos = tem;
3104 /* Add it to the end of the wrong list. Later on,
3105 recenter_overlay_lists will move it to the right place. */
3106 if (endpos < XINT (current_buffer->overlay_center))
3108 *pafter = *ptail;
3109 pafter = &XCDR (*ptail);
3111 else
3113 *pbefore = *ptail;
3114 pbefore = &XCDR (*ptail);
3116 *ptail = XCDR (*ptail);
3118 else
3119 ptail = &XCDR (*ptail);
3121 for (ptail = &current_buffer->overlays_after; CONSP (*ptail);)
3123 overlay = XCAR (*ptail);
3124 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3125 if (startpos >= end)
3126 break;
3127 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3128 if (startpos >= start
3129 || (endpos >= start && endpos < end))
3131 if (startpos > endpos)
3133 int tem;
3134 Fset_marker (OVERLAY_START (overlay), make_number (endpos),
3135 Qnil);
3136 Fset_marker (OVERLAY_END (overlay), make_number (startpos),
3137 Qnil);
3138 tem = startpos; startpos = endpos; endpos = tem;
3140 if (endpos < XINT (current_buffer->overlay_center))
3142 *pafter = *ptail;
3143 pafter = &XCDR (*ptail);
3145 else
3147 *pbefore = *ptail;
3148 pbefore = &XCDR (*ptail);
3150 *ptail = XCDR (*ptail);
3152 else
3153 ptail = &XCDR (*ptail);
3156 /* Splice the constructed (wrong) lists into the buffer's lists,
3157 and let the recenter function make it sane again. */
3158 *pbefore = current_buffer->overlays_before;
3159 current_buffer->overlays_before = before_list;
3160 recenter_overlay_lists (current_buffer,
3161 XINT (current_buffer->overlay_center));
3163 *pafter = current_buffer->overlays_after;
3164 current_buffer->overlays_after = after_list;
3165 recenter_overlay_lists (current_buffer,
3166 XINT (current_buffer->overlay_center));
3169 /* We have two types of overlay: the one whose ending marker is
3170 after-insertion-marker (this is the usual case) and the one whose
3171 ending marker is before-insertion-marker. When `overlays_before'
3172 contains overlays of the latter type and the former type in this
3173 order and both overlays end at inserting position, inserting a text
3174 increases only the ending marker of the latter type, which results
3175 in incorrect ordering of `overlays_before'.
3177 This function fixes ordering of overlays in the slot
3178 `overlays_before' of the buffer *BP. Before the insertion, `point'
3179 was at PREV, and now is at POS. */
3181 void
3182 fix_overlays_before (bp, prev, pos)
3183 struct buffer *bp;
3184 int prev, pos;
3186 Lisp_Object *tailp = &bp->overlays_before;
3187 Lisp_Object *right_place;
3188 int end;
3190 /* After the insertion, the several overlays may be in incorrect
3191 order. The possibility is that, in the list `overlays_before',
3192 an overlay which ends at POS appears after an overlay which ends
3193 at PREV. Since POS is greater than PREV, we must fix the
3194 ordering of these overlays, by moving overlays ends at POS before
3195 the overlays ends at PREV. */
3197 /* At first, find a place where disordered overlays should be linked
3198 in. It is where an overlay which end before POS exists. (i.e. an
3199 overlay whose ending marker is after-insertion-marker if disorder
3200 exists). */
3201 while (!NILP (*tailp)
3202 && ((end = OVERLAY_POSITION (OVERLAY_END (XCAR (*tailp))))
3203 >= pos))
3204 tailp = &XCDR (*tailp);
3206 /* If we don't find such an overlay,
3207 or the found one ends before PREV,
3208 or the found one is the last one in the list,
3209 we don't have to fix anything. */
3210 if (NILP (*tailp)
3211 || end < prev
3212 || NILP (XCDR (*tailp)))
3213 return;
3215 right_place = tailp;
3216 tailp = &XCDR (*tailp);
3218 /* Now, end position of overlays in the list *TAILP should be before
3219 or equal to PREV. In the loop, an overlay which ends at POS is
3220 moved ahead to the place pointed by RIGHT_PLACE. If we found an
3221 overlay which ends before PREV, the remaining overlays are in
3222 correct order. */
3223 while (!NILP (*tailp))
3225 end = OVERLAY_POSITION (OVERLAY_END (XCAR (*tailp)));
3227 if (end == pos)
3228 { /* This overlay is disordered. */
3229 Lisp_Object found = *tailp;
3231 /* Unlink the found overlay. */
3232 *tailp = XCDR (found);
3233 /* Move an overlay at RIGHT_PLACE to the next of the found one. */
3234 XCDR (found) = *right_place;
3235 /* Link it into the right place. */
3236 *right_place = found;
3238 else if (end == prev)
3239 tailp = &XCDR (*tailp);
3240 else /* No more disordered overlay. */
3241 break;
3245 DEFUN ("overlayp", Foverlayp, Soverlayp, 1, 1, 0,
3246 "Return t if OBJECT is an overlay.")
3247 (object)
3248 Lisp_Object object;
3250 return (OVERLAYP (object) ? Qt : Qnil);
3253 DEFUN ("make-overlay", Fmake_overlay, Smake_overlay, 2, 5, 0,
3254 "Create a new overlay with range BEG to END in BUFFER.\n\
3255 If omitted, BUFFER defaults to the current buffer.\n\
3256 BEG and END may be integers or markers.\n\
3257 The fourth arg FRONT-ADVANCE, if non-nil, makes the\n\
3258 front delimiter advance when text is inserted there.\n\
3259 The fifth arg REAR-ADVANCE, if non-nil, makes the\n\
3260 rear delimiter advance when text is inserted there.")
3261 (beg, end, buffer, front_advance, rear_advance)
3262 Lisp_Object beg, end, buffer;
3263 Lisp_Object front_advance, rear_advance;
3265 Lisp_Object overlay;
3266 struct buffer *b;
3268 if (NILP (buffer))
3269 XSETBUFFER (buffer, current_buffer);
3270 else
3271 CHECK_BUFFER (buffer, 2);
3272 if (MARKERP (beg)
3273 && ! EQ (Fmarker_buffer (beg), buffer))
3274 error ("Marker points into wrong buffer");
3275 if (MARKERP (end)
3276 && ! EQ (Fmarker_buffer (end), buffer))
3277 error ("Marker points into wrong buffer");
3279 CHECK_NUMBER_COERCE_MARKER (beg, 1);
3280 CHECK_NUMBER_COERCE_MARKER (end, 1);
3282 if (XINT (beg) > XINT (end))
3284 Lisp_Object temp;
3285 temp = beg; beg = end; end = temp;
3288 b = XBUFFER (buffer);
3290 beg = Fset_marker (Fmake_marker (), beg, buffer);
3291 end = Fset_marker (Fmake_marker (), end, buffer);
3293 if (!NILP (front_advance))
3294 XMARKER (beg)->insertion_type = 1;
3295 if (!NILP (rear_advance))
3296 XMARKER (end)->insertion_type = 1;
3298 overlay = allocate_misc ();
3299 XMISCTYPE (overlay) = Lisp_Misc_Overlay;
3300 XOVERLAY (overlay)->start = beg;
3301 XOVERLAY (overlay)->end = end;
3302 XOVERLAY (overlay)->plist = Qnil;
3304 /* Put the new overlay on the wrong list. */
3305 end = OVERLAY_END (overlay);
3306 if (OVERLAY_POSITION (end) < XINT (b->overlay_center))
3307 b->overlays_after = Fcons (overlay, b->overlays_after);
3308 else
3309 b->overlays_before = Fcons (overlay, b->overlays_before);
3311 /* This puts it in the right list, and in the right order. */
3312 recenter_overlay_lists (b, XINT (b->overlay_center));
3314 /* We don't need to redisplay the region covered by the overlay, because
3315 the overlay has no properties at the moment. */
3317 return overlay;
3320 /* Mark a section of BUF as needing redisplay because of overlays changes. */
3322 static void
3323 modify_overlay (buf, start, end)
3324 struct buffer *buf;
3325 int start, end;
3327 if (start == end)
3328 return;
3330 if (start > end)
3332 int temp = start;
3333 start = end; end = temp;
3336 BUF_COMPUTE_UNCHANGED (buf, start, end);
3338 /* If this is a buffer not in the selected window,
3339 we must do other windows. */
3340 if (buf != XBUFFER (XWINDOW (selected_window)->buffer))
3341 windows_or_buffers_changed = 1;
3342 /* If multiple windows show this buffer, we must do other windows. */
3343 else if (buffer_shared > 1)
3344 windows_or_buffers_changed = 1;
3346 ++BUF_OVERLAY_MODIFF (buf);
3349 \f\f
3350 Lisp_Object Fdelete_overlay ();
3352 DEFUN ("move-overlay", Fmove_overlay, Smove_overlay, 3, 4, 0,
3353 "Set the endpoints of OVERLAY to BEG and END in BUFFER.\n\
3354 If BUFFER is omitted, leave OVERLAY in the same buffer it inhabits now.\n\
3355 If BUFFER is omitted, and OVERLAY is in no buffer, put it in the current\n\
3356 buffer.")
3357 (overlay, beg, end, buffer)
3358 Lisp_Object overlay, beg, end, buffer;
3360 struct buffer *b, *ob;
3361 Lisp_Object obuffer;
3362 int count = specpdl_ptr - specpdl;
3364 CHECK_OVERLAY (overlay, 0);
3365 if (NILP (buffer))
3366 buffer = Fmarker_buffer (OVERLAY_START (overlay));
3367 if (NILP (buffer))
3368 XSETBUFFER (buffer, current_buffer);
3369 CHECK_BUFFER (buffer, 3);
3371 if (MARKERP (beg)
3372 && ! EQ (Fmarker_buffer (beg), buffer))
3373 error ("Marker points into wrong buffer");
3374 if (MARKERP (end)
3375 && ! EQ (Fmarker_buffer (end), buffer))
3376 error ("Marker points into wrong buffer");
3378 CHECK_NUMBER_COERCE_MARKER (beg, 1);
3379 CHECK_NUMBER_COERCE_MARKER (end, 1);
3381 if (XINT (beg) == XINT (end) && ! NILP (Foverlay_get (overlay, Qevaporate)))
3382 return Fdelete_overlay (overlay);
3384 if (XINT (beg) > XINT (end))
3386 Lisp_Object temp;
3387 temp = beg; beg = end; end = temp;
3390 specbind (Qinhibit_quit, Qt);
3392 obuffer = Fmarker_buffer (OVERLAY_START (overlay));
3393 b = XBUFFER (buffer);
3394 ob = BUFFERP (obuffer) ? XBUFFER (obuffer) : (struct buffer *) 0;
3396 /* If the overlay has changed buffers, do a thorough redisplay. */
3397 if (!EQ (buffer, obuffer))
3399 /* Redisplay where the overlay was. */
3400 if (!NILP (obuffer))
3402 int o_beg;
3403 int o_end;
3405 o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
3406 o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
3408 modify_overlay (ob, o_beg, o_end);
3411 /* Redisplay where the overlay is going to be. */
3412 modify_overlay (b, XINT (beg), XINT (end));
3414 else
3415 /* Redisplay the area the overlay has just left, or just enclosed. */
3417 int o_beg, o_end;
3419 o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
3420 o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
3422 if (o_beg == XINT (beg))
3423 modify_overlay (b, o_end, XINT (end));
3424 else if (o_end == XINT (end))
3425 modify_overlay (b, o_beg, XINT (beg));
3426 else
3428 if (XINT (beg) < o_beg) o_beg = XINT (beg);
3429 if (XINT (end) > o_end) o_end = XINT (end);
3430 modify_overlay (b, o_beg, o_end);
3434 if (!NILP (obuffer))
3436 ob->overlays_before = Fdelq (overlay, ob->overlays_before);
3437 ob->overlays_after = Fdelq (overlay, ob->overlays_after);
3440 Fset_marker (OVERLAY_START (overlay), beg, buffer);
3441 Fset_marker (OVERLAY_END (overlay), end, buffer);
3443 /* Put the overlay on the wrong list. */
3444 end = OVERLAY_END (overlay);
3445 if (OVERLAY_POSITION (end) < XINT (b->overlay_center))
3446 b->overlays_after = Fcons (overlay, b->overlays_after);
3447 else
3448 b->overlays_before = Fcons (overlay, b->overlays_before);
3450 /* This puts it in the right list, and in the right order. */
3451 recenter_overlay_lists (b, XINT (b->overlay_center));
3453 return unbind_to (count, overlay);
3456 DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0,
3457 "Delete the overlay OVERLAY from its buffer.")
3458 (overlay)
3459 Lisp_Object overlay;
3461 Lisp_Object buffer;
3462 struct buffer *b;
3463 int count = specpdl_ptr - specpdl;
3465 CHECK_OVERLAY (overlay, 0);
3467 buffer = Fmarker_buffer (OVERLAY_START (overlay));
3468 if (NILP (buffer))
3469 return Qnil;
3471 b = XBUFFER (buffer);
3473 specbind (Qinhibit_quit, Qt);
3475 b->overlays_before = Fdelq (overlay, b->overlays_before);
3476 b->overlays_after = Fdelq (overlay, b->overlays_after);
3478 modify_overlay (b,
3479 marker_position (OVERLAY_START (overlay)),
3480 marker_position (OVERLAY_END (overlay)));
3482 Fset_marker (OVERLAY_START (overlay), Qnil, Qnil);
3483 Fset_marker (OVERLAY_END (overlay), Qnil, Qnil);
3485 return unbind_to (count, Qnil);
3488 /* Overlay dissection functions. */
3490 DEFUN ("overlay-start", Foverlay_start, Soverlay_start, 1, 1, 0,
3491 "Return the position at which OVERLAY starts.")
3492 (overlay)
3493 Lisp_Object overlay;
3495 CHECK_OVERLAY (overlay, 0);
3497 return (Fmarker_position (OVERLAY_START (overlay)));
3500 DEFUN ("overlay-end", Foverlay_end, Soverlay_end, 1, 1, 0,
3501 "Return the position at which OVERLAY ends.")
3502 (overlay)
3503 Lisp_Object overlay;
3505 CHECK_OVERLAY (overlay, 0);
3507 return (Fmarker_position (OVERLAY_END (overlay)));
3510 DEFUN ("overlay-buffer", Foverlay_buffer, Soverlay_buffer, 1, 1, 0,
3511 "Return the buffer OVERLAY belongs to.")
3512 (overlay)
3513 Lisp_Object overlay;
3515 CHECK_OVERLAY (overlay, 0);
3517 return Fmarker_buffer (OVERLAY_START (overlay));
3520 DEFUN ("overlay-properties", Foverlay_properties, Soverlay_properties, 1, 1, 0,
3521 "Return a list of the properties on OVERLAY.\n\
3522 This is a copy of OVERLAY's plist; modifying its conses has no effect on\n\
3523 OVERLAY.")
3524 (overlay)
3525 Lisp_Object overlay;
3527 CHECK_OVERLAY (overlay, 0);
3529 return Fcopy_sequence (XOVERLAY (overlay)->plist);
3533 DEFUN ("overlays-at", Foverlays_at, Soverlays_at, 1, 1, 0,
3534 "Return a list of the overlays that contain position POS.")
3535 (pos)
3536 Lisp_Object pos;
3538 int noverlays;
3539 Lisp_Object *overlay_vec;
3540 int len;
3541 Lisp_Object result;
3543 CHECK_NUMBER_COERCE_MARKER (pos, 0);
3545 len = 10;
3546 /* We can't use alloca here because overlays_at can call xrealloc. */
3547 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
3549 /* Put all the overlays we want in a vector in overlay_vec.
3550 Store the length in len. */
3551 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
3552 (int *) 0, (int *) 0, 0);
3554 /* Make a list of them all. */
3555 result = Flist (noverlays, overlay_vec);
3557 xfree (overlay_vec);
3558 return result;
3561 DEFUN ("overlays-in", Foverlays_in, Soverlays_in, 2, 2, 0,
3562 "Return a list of the overlays that overlap the region BEG ... END.\n\
3563 Overlap means that at least one character is contained within the overlay\n\
3564 and also contained within the specified region.\n\
3565 Empty overlays are included in the result if they are located at BEG\n\
3566 or between BEG and END.")
3567 (beg, end)
3568 Lisp_Object beg, end;
3570 int noverlays;
3571 Lisp_Object *overlay_vec;
3572 int len;
3573 Lisp_Object result;
3575 CHECK_NUMBER_COERCE_MARKER (beg, 0);
3576 CHECK_NUMBER_COERCE_MARKER (end, 0);
3578 len = 10;
3579 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
3581 /* Put all the overlays we want in a vector in overlay_vec.
3582 Store the length in len. */
3583 noverlays = overlays_in (XINT (beg), XINT (end), 1, &overlay_vec, &len,
3584 (int *) 0, (int *) 0);
3586 /* Make a list of them all. */
3587 result = Flist (noverlays, overlay_vec);
3589 xfree (overlay_vec);
3590 return result;
3593 DEFUN ("next-overlay-change", Fnext_overlay_change, Snext_overlay_change,
3594 1, 1, 0,
3595 "Return the next position after POS where an overlay starts or ends.\n\
3596 If there are no more overlay boundaries after POS, return (point-max).")
3597 (pos)
3598 Lisp_Object pos;
3600 int noverlays;
3601 int endpos;
3602 Lisp_Object *overlay_vec;
3603 int len;
3604 int i;
3606 CHECK_NUMBER_COERCE_MARKER (pos, 0);
3608 len = 10;
3609 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
3611 /* Put all the overlays we want in a vector in overlay_vec.
3612 Store the length in len.
3613 endpos gets the position where the next overlay starts. */
3614 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
3615 &endpos, (int *) 0, 1);
3617 /* If any of these overlays ends before endpos,
3618 use its ending point instead. */
3619 for (i = 0; i < noverlays; i++)
3621 Lisp_Object oend;
3622 int oendpos;
3624 oend = OVERLAY_END (overlay_vec[i]);
3625 oendpos = OVERLAY_POSITION (oend);
3626 if (oendpos < endpos)
3627 endpos = oendpos;
3630 xfree (overlay_vec);
3631 return make_number (endpos);
3634 DEFUN ("previous-overlay-change", Fprevious_overlay_change,
3635 Sprevious_overlay_change, 1, 1, 0,
3636 "Return the previous position before POS where an overlay starts or ends.\n\
3637 If there are no more overlay boundaries before POS, return (point-min).")
3638 (pos)
3639 Lisp_Object pos;
3641 int noverlays;
3642 int prevpos;
3643 Lisp_Object *overlay_vec;
3644 int len;
3646 CHECK_NUMBER_COERCE_MARKER (pos, 0);
3648 /* At beginning of buffer, we know the answer;
3649 avoid bug subtracting 1 below. */
3650 if (XINT (pos) == BEGV)
3651 return pos;
3653 len = 10;
3654 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
3656 /* Put all the overlays we want in a vector in overlay_vec.
3657 Store the length in len.
3658 prevpos gets the position of the previous change. */
3659 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
3660 (int *) 0, &prevpos, 1);
3662 xfree (overlay_vec);
3663 return make_number (prevpos);
3666 /* These functions are for debugging overlays. */
3668 DEFUN ("overlay-lists", Foverlay_lists, Soverlay_lists, 0, 0, 0,
3669 "Return a pair of lists giving all the overlays of the current buffer.\n\
3670 The car has all the overlays before the overlay center;\n\
3671 the cdr has all the overlays after the overlay center.\n\
3672 Recentering overlays moves overlays between these lists.\n\
3673 The lists you get are copies, so that changing them has no effect.\n\
3674 However, the overlays you get are the real objects that the buffer uses.")
3677 Lisp_Object before, after;
3678 before = current_buffer->overlays_before;
3679 if (CONSP (before))
3680 before = Fcopy_sequence (before);
3681 after = current_buffer->overlays_after;
3682 if (CONSP (after))
3683 after = Fcopy_sequence (after);
3685 return Fcons (before, after);
3688 DEFUN ("overlay-recenter", Foverlay_recenter, Soverlay_recenter, 1, 1, 0,
3689 "Recenter the overlays of the current buffer around position POS.")
3690 (pos)
3691 Lisp_Object pos;
3693 CHECK_NUMBER_COERCE_MARKER (pos, 0);
3695 recenter_overlay_lists (current_buffer, XINT (pos));
3696 return Qnil;
3699 DEFUN ("overlay-get", Foverlay_get, Soverlay_get, 2, 2, 0,
3700 "Get the property of overlay OVERLAY with property name PROP.")
3701 (overlay, prop)
3702 Lisp_Object overlay, prop;
3704 Lisp_Object plist, fallback;
3706 CHECK_OVERLAY (overlay, 0);
3708 fallback = Qnil;
3710 for (plist = XOVERLAY (overlay)->plist;
3711 CONSP (plist) && CONSP (XCDR (plist));
3712 plist = XCDR (XCDR (plist)))
3714 if (EQ (XCAR (plist), prop))
3715 return XCAR (XCDR (plist));
3716 else if (EQ (XCAR (plist), Qcategory))
3718 Lisp_Object tem;
3719 tem = Fcar (Fcdr (plist));
3720 if (SYMBOLP (tem))
3721 fallback = Fget (tem, prop);
3725 return fallback;
3728 DEFUN ("overlay-put", Foverlay_put, Soverlay_put, 3, 3, 0,
3729 "Set one property of overlay OVERLAY: give property PROP value VALUE.")
3730 (overlay, prop, value)
3731 Lisp_Object overlay, prop, value;
3733 Lisp_Object tail, buffer;
3734 int changed;
3736 CHECK_OVERLAY (overlay, 0);
3738 buffer = Fmarker_buffer (OVERLAY_START (overlay));
3740 for (tail = XOVERLAY (overlay)->plist;
3741 CONSP (tail) && CONSP (XCDR (tail));
3742 tail = XCDR (XCDR (tail)))
3743 if (EQ (XCAR (tail), prop))
3745 changed = !EQ (XCAR (XCDR (tail)), value);
3746 XCAR (XCDR (tail)) = value;
3747 goto found;
3749 /* It wasn't in the list, so add it to the front. */
3750 changed = !NILP (value);
3751 XOVERLAY (overlay)->plist
3752 = Fcons (prop, Fcons (value, XOVERLAY (overlay)->plist));
3753 found:
3754 if (! NILP (buffer))
3756 if (changed)
3757 modify_overlay (XBUFFER (buffer),
3758 marker_position (OVERLAY_START (overlay)),
3759 marker_position (OVERLAY_END (overlay)));
3760 if (EQ (prop, Qevaporate) && ! NILP (value)
3761 && (OVERLAY_POSITION (OVERLAY_START (overlay))
3762 == OVERLAY_POSITION (OVERLAY_END (overlay))))
3763 Fdelete_overlay (overlay);
3765 return value;
3768 /* Subroutine of report_overlay_modification. */
3770 /* Lisp vector holding overlay hook functions to call.
3771 Vector elements come in pairs.
3772 Each even-index element is a list of hook functions.
3773 The following odd-index element is the overlay they came from.
3775 Before the buffer change, we fill in this vector
3776 as we call overlay hook functions.
3777 After the buffer change, we get the functions to call from this vector.
3778 This way we always call the same functions before and after the change. */
3779 static Lisp_Object last_overlay_modification_hooks;
3781 /* Number of elements actually used in last_overlay_modification_hooks. */
3782 static int last_overlay_modification_hooks_used;
3784 /* Add one functionlist/overlay pair
3785 to the end of last_overlay_modification_hooks. */
3787 static void
3788 add_overlay_mod_hooklist (functionlist, overlay)
3789 Lisp_Object functionlist, overlay;
3791 int oldsize = XVECTOR (last_overlay_modification_hooks)->size;
3793 if (last_overlay_modification_hooks_used == oldsize)
3795 Lisp_Object old;
3796 old = last_overlay_modification_hooks;
3797 last_overlay_modification_hooks
3798 = Fmake_vector (make_number (oldsize * 2), Qnil);
3799 bcopy (XVECTOR (old)->contents,
3800 XVECTOR (last_overlay_modification_hooks)->contents,
3801 sizeof (Lisp_Object) * oldsize);
3803 XVECTOR (last_overlay_modification_hooks)->contents[last_overlay_modification_hooks_used++] = functionlist;
3804 XVECTOR (last_overlay_modification_hooks)->contents[last_overlay_modification_hooks_used++] = overlay;
3807 /* Run the modification-hooks of overlays that include
3808 any part of the text in START to END.
3809 If this change is an insertion, also
3810 run the insert-before-hooks of overlay starting at END,
3811 and the insert-after-hooks of overlay ending at START.
3813 This is called both before and after the modification.
3814 AFTER is nonzero when we call after the modification.
3816 ARG1, ARG2, ARG3 are arguments to pass to the hook functions.
3817 When AFTER is nonzero, they are the start position,
3818 the position after the inserted new text,
3819 and the length of deleted or replaced old text. */
3821 void
3822 report_overlay_modification (start, end, after, arg1, arg2, arg3)
3823 Lisp_Object start, end;
3824 int after;
3825 Lisp_Object arg1, arg2, arg3;
3827 Lisp_Object prop, overlay, tail;
3828 /* 1 if this change is an insertion. */
3829 int insertion = (after ? XFASTINT (arg3) == 0 : EQ (start, end));
3830 int tail_copied;
3831 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
3833 overlay = Qnil;
3834 tail = Qnil;
3835 GCPRO5 (overlay, tail, arg1, arg2, arg3);
3837 if (after)
3839 /* Call the functions recorded in last_overlay_modification_hooks
3840 rather than scanning the overlays again.
3841 First copy the vector contents, in case some of these hooks
3842 do subsequent modification of the buffer. */
3843 int size = last_overlay_modification_hooks_used;
3844 Lisp_Object *copy = (Lisp_Object *) alloca (size * sizeof (Lisp_Object));
3845 int i;
3847 bcopy (XVECTOR (last_overlay_modification_hooks)->contents,
3848 copy, size * sizeof (Lisp_Object));
3849 gcpro1.var = copy;
3850 gcpro1.nvars = size;
3852 for (i = 0; i < size;)
3854 Lisp_Object prop, overlay;
3855 prop = copy[i++];
3856 overlay = copy[i++];
3857 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
3859 UNGCPRO;
3860 return;
3863 /* We are being called before a change.
3864 Scan the overlays to find the functions to call. */
3865 last_overlay_modification_hooks_used = 0;
3866 tail_copied = 0;
3867 for (tail = current_buffer->overlays_before;
3868 CONSP (tail);
3869 tail = XCDR (tail))
3871 int startpos, endpos;
3872 Lisp_Object ostart, oend;
3874 overlay = XCAR (tail);
3876 ostart = OVERLAY_START (overlay);
3877 oend = OVERLAY_END (overlay);
3878 endpos = OVERLAY_POSITION (oend);
3879 if (XFASTINT (start) > endpos)
3880 break;
3881 startpos = OVERLAY_POSITION (ostart);
3882 if (insertion && (XFASTINT (start) == startpos
3883 || XFASTINT (end) == startpos))
3885 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
3886 if (!NILP (prop))
3888 /* Copy TAIL in case the hook recenters the overlay lists. */
3889 if (!tail_copied)
3890 tail = Fcopy_sequence (tail);
3891 tail_copied = 1;
3892 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
3895 if (insertion && (XFASTINT (start) == endpos
3896 || XFASTINT (end) == endpos))
3898 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
3899 if (!NILP (prop))
3901 if (!tail_copied)
3902 tail = Fcopy_sequence (tail);
3903 tail_copied = 1;
3904 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
3907 /* Test for intersecting intervals. This does the right thing
3908 for both insertion and deletion. */
3909 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
3911 prop = Foverlay_get (overlay, Qmodification_hooks);
3912 if (!NILP (prop))
3914 if (!tail_copied)
3915 tail = Fcopy_sequence (tail);
3916 tail_copied = 1;
3917 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
3922 tail_copied = 0;
3923 for (tail = current_buffer->overlays_after;
3924 CONSP (tail);
3925 tail = XCDR (tail))
3927 int startpos, endpos;
3928 Lisp_Object ostart, oend;
3930 overlay = XCAR (tail);
3932 ostart = OVERLAY_START (overlay);
3933 oend = OVERLAY_END (overlay);
3934 startpos = OVERLAY_POSITION (ostart);
3935 endpos = OVERLAY_POSITION (oend);
3936 if (XFASTINT (end) < startpos)
3937 break;
3938 if (insertion && (XFASTINT (start) == startpos
3939 || XFASTINT (end) == startpos))
3941 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
3942 if (!NILP (prop))
3944 if (!tail_copied)
3945 tail = Fcopy_sequence (tail);
3946 tail_copied = 1;
3947 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
3950 if (insertion && (XFASTINT (start) == endpos
3951 || XFASTINT (end) == endpos))
3953 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
3954 if (!NILP (prop))
3956 if (!tail_copied)
3957 tail = Fcopy_sequence (tail);
3958 tail_copied = 1;
3959 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
3962 /* Test for intersecting intervals. This does the right thing
3963 for both insertion and deletion. */
3964 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
3966 prop = Foverlay_get (overlay, Qmodification_hooks);
3967 if (!NILP (prop))
3969 if (!tail_copied)
3970 tail = Fcopy_sequence (tail);
3971 tail_copied = 1;
3972 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
3977 UNGCPRO;
3980 static void
3981 call_overlay_mod_hooks (list, overlay, after, arg1, arg2, arg3)
3982 Lisp_Object list, overlay;
3983 int after;
3984 Lisp_Object arg1, arg2, arg3;
3986 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3988 GCPRO4 (list, arg1, arg2, arg3);
3989 if (! after)
3990 add_overlay_mod_hooklist (list, overlay);
3992 while (!NILP (list))
3994 if (NILP (arg3))
3995 call4 (Fcar (list), overlay, after ? Qt : Qnil, arg1, arg2);
3996 else
3997 call5 (Fcar (list), overlay, after ? Qt : Qnil, arg1, arg2, arg3);
3998 list = Fcdr (list);
4000 UNGCPRO;
4003 /* Delete any zero-sized overlays at position POS, if the `evaporate'
4004 property is set. */
4005 void
4006 evaporate_overlays (pos)
4007 int pos;
4009 Lisp_Object tail, overlay, hit_list;
4011 hit_list = Qnil;
4012 if (pos <= XFASTINT (current_buffer->overlay_center))
4013 for (tail = current_buffer->overlays_before; CONSP (tail);
4014 tail = XCDR (tail))
4016 int endpos;
4017 overlay = XCAR (tail);
4018 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
4019 if (endpos < pos)
4020 break;
4021 if (endpos == pos && OVERLAY_POSITION (OVERLAY_START (overlay)) == pos
4022 && ! NILP (Foverlay_get (overlay, Qevaporate)))
4023 hit_list = Fcons (overlay, hit_list);
4025 else
4026 for (tail = current_buffer->overlays_after; CONSP (tail);
4027 tail = XCDR (tail))
4029 int startpos;
4030 overlay = XCAR (tail);
4031 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
4032 if (startpos > pos)
4033 break;
4034 if (startpos == pos && OVERLAY_POSITION (OVERLAY_END (overlay)) == pos
4035 && ! NILP (Foverlay_get (overlay, Qevaporate)))
4036 hit_list = Fcons (overlay, hit_list);
4038 for (; CONSP (hit_list); hit_list = XCDR (hit_list))
4039 Fdelete_overlay (XCAR (hit_list));
4042 /* Somebody has tried to store a value with an unacceptable type
4043 in the slot with offset OFFSET. */
4045 void
4046 buffer_slot_type_mismatch (offset)
4047 int offset;
4049 Lisp_Object sym;
4050 char *type_name;
4052 switch (XINT (PER_BUFFER_TYPE (offset)))
4054 case Lisp_Int:
4055 type_name = "integers";
4056 break;
4058 case Lisp_String:
4059 type_name = "strings";
4060 break;
4062 case Lisp_Symbol:
4063 type_name = "symbols";
4064 break;
4066 default:
4067 abort ();
4070 sym = PER_BUFFER_SYMBOL (offset);
4071 error ("Only %s should be stored in the buffer-local variable %s",
4072 type_name, XSYMBOL (sym)->name->data);
4076 /***********************************************************************
4077 Allocation with mmap
4078 ***********************************************************************/
4080 #ifdef USE_MMAP_FOR_BUFFERS
4082 #include <sys/types.h>
4083 #include <sys/mman.h>
4085 #ifndef MAP_ANON
4086 #ifdef MAP_ANONYMOUS
4087 #define MAP_ANON MAP_ANONYMOUS
4088 #else
4089 #define MAP_ANON 0
4090 #endif
4091 #endif
4093 #ifndef MAP_FAILED
4094 #define MAP_FAILED ((void *) -1)
4095 #endif
4097 #include <stdio.h>
4098 #include <errno.h>
4100 #if MAP_ANON == 0
4101 #include <fcntl.h>
4102 #endif
4104 #include "coding.h"
4107 /* Memory is allocated in regions which are mapped using mmap(2).
4108 The current implementation lets the system select mapped
4109 addresses; we're not using MAP_FIXED in general, except when
4110 trying to enlarge regions.
4112 Each mapped region starts with a mmap_region structure, the user
4113 area starts after that structure, aligned to MEM_ALIGN.
4115 +-----------------------+
4116 | struct mmap_info + |
4117 | padding |
4118 +-----------------------+
4119 | user data |
4122 +-----------------------+ */
4124 struct mmap_region
4126 /* User-specified size. */
4127 size_t nbytes_specified;
4129 /* Number of bytes mapped */
4130 size_t nbytes_mapped;
4132 /* Pointer to the location holding the address of the memory
4133 allocated with the mmap'd block. The variable actually points
4134 after this structure. */
4135 POINTER_TYPE **var;
4137 /* Next and previous in list of all mmap'd regions. */
4138 struct mmap_region *next, *prev;
4141 /* Doubly-linked list of mmap'd regions. */
4143 static struct mmap_region *mmap_regions;
4145 /* File descriptor for mmap. If we don't have anonymous mapping,
4146 /dev/zero will be opened on it. */
4148 static int mmap_fd;
4150 /* Temporary storage for mmap_set_vars, see there. */
4152 static struct mmap_region *mmap_regions_1;
4153 static int mmap_fd_1;
4155 /* Page size on this system. */
4157 static int mmap_page_size;
4159 /* 1 means mmap has been intialized. */
4161 static int mmap_initialized_p;
4163 /* Value is X rounded up to the next multiple of N. */
4165 #define ROUND(X, N) (((X) + (N) - 1) / (N) * (N))
4167 /* Size of mmap_region structure plus padding. */
4169 #define MMAP_REGION_STRUCT_SIZE \
4170 ROUND (sizeof (struct mmap_region), MEM_ALIGN)
4172 /* Given a pointer P to the start of the user-visible part of a mapped
4173 region, return a pointer to the start of the region. */
4175 #define MMAP_REGION(P) \
4176 ((struct mmap_region *) ((char *) (P) - MMAP_REGION_STRUCT_SIZE))
4178 /* Given a pointer P to the start of a mapped region, return a pointer
4179 to the start of the user-visible part of the region. */
4181 #define MMAP_USER_AREA(P) \
4182 ((POINTER_TYPE *) ((char *) (P) + MMAP_REGION_STRUCT_SIZE))
4184 #define MEM_ALIGN sizeof (double)
4186 /* Function prototypes. */
4188 static int mmap_free_1 P_ ((struct mmap_region *));
4189 static int mmap_enlarge P_ ((struct mmap_region *, int));
4190 static struct mmap_region *mmap_find P_ ((POINTER_TYPE *, POINTER_TYPE *));
4191 static POINTER_TYPE *mmap_alloc P_ ((POINTER_TYPE **, size_t));
4192 static POINTER_TYPE *mmap_realloc P_ ((POINTER_TYPE **, size_t));
4193 static void mmap_free P_ ((POINTER_TYPE **ptr));
4194 static void mmap_init P_ ((void));
4197 /* Return a region overlapping address range START...END, or null if
4198 none. END is not including, i.e. the last byte in the range
4199 is at END - 1. */
4201 static struct mmap_region *
4202 mmap_find (start, end)
4203 POINTER_TYPE *start, *end;
4205 struct mmap_region *r;
4206 char *s = (char *) start, *e = (char *) end;
4208 for (r = mmap_regions; r; r = r->next)
4210 char *rstart = (char *) r;
4211 char *rend = rstart + r->nbytes_mapped;
4213 if (/* First byte of range, i.e. START, in this region? */
4214 (s >= rstart && s < rend)
4215 /* Last byte of range, i.e. END - 1, in this region? */
4216 || (e > rstart && e <= rend)
4217 /* First byte of this region in the range? */
4218 || (rstart >= s && rstart < e)
4219 /* Last byte of this region in the range? */
4220 || (rend > s && rend <= e))
4221 break;
4224 return r;
4228 /* Unmap a region. P is a pointer to the start of the user-araa of
4229 the region. Value is non-zero if successful. */
4231 static int
4232 mmap_free_1 (r)
4233 struct mmap_region *r;
4235 if (r->next)
4236 r->next->prev = r->prev;
4237 if (r->prev)
4238 r->prev->next = r->next;
4239 else
4240 mmap_regions = r->next;
4242 if (munmap ((POINTER_TYPE *) r, r->nbytes_mapped) == -1)
4244 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4245 return 0;
4248 return 1;
4252 /* Enlarge region R by NPAGES pages. NPAGES < 0 means shrink R.
4253 Value is non-zero if successful. */
4255 static int
4256 mmap_enlarge (r, npages)
4257 struct mmap_region *r;
4258 int npages;
4260 char *region_end = (char *) r + r->nbytes_mapped;
4261 size_t nbytes;
4262 int success = 0;
4264 if (npages < 0)
4266 /* Unmap pages at the end of the region. */
4267 nbytes = - npages * mmap_page_size;
4268 if (munmap (region_end - nbytes, nbytes) == -1)
4269 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4270 else
4272 r->nbytes_mapped -= nbytes;
4273 success = 1;
4276 else if (npages > 0)
4278 struct mmap_region *r2;
4280 nbytes = npages * mmap_page_size;
4282 /* Try to map additional pages at the end of the region. We
4283 cannot do this if the address range is already occupied by
4284 something else because mmap deletes any previous mapping.
4285 I'm not sure this is worth doing, let's see. */
4286 r2 = mmap_find (region_end, region_end + nbytes);
4287 if (r2 == NULL)
4289 POINTER_TYPE *p;
4291 p = mmap (region_end, nbytes, PROT_READ | PROT_WRITE,
4292 MAP_ANON | MAP_PRIVATE | MAP_FIXED, mmap_fd, 0);
4293 if (p == MAP_FAILED)
4294 ; /* fprintf (stderr, "mmap: %s\n", emacs_strerror (errno)); */
4295 else if (p != (POINTER_TYPE *) region_end)
4297 /* Kernels are free to choose a different address. In
4298 that case, unmap what we've mapped above; we have
4299 no use for it. */
4300 if (munmap (p, nbytes) == -1)
4301 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4303 else
4305 r->nbytes_mapped += nbytes;
4306 success = 1;
4311 return success;
4315 /* Set or reset variables holding references to mapped regions. If
4316 RESTORE_P is zero, set all variables to null. If RESTORE_P is
4317 non-zero, set all variables to the start of the user-areas
4318 of mapped regions.
4320 This function is called from Fdump_emacs to ensure that the dumped
4321 Emacs doesn't contain references to memory that won't be mapped
4322 when Emacs starts. */
4324 void
4325 mmap_set_vars (restore_p)
4326 int restore_p;
4328 struct mmap_region *r;
4330 if (restore_p)
4332 mmap_regions = mmap_regions_1;
4333 mmap_fd = mmap_fd_1;
4334 for (r = mmap_regions; r; r = r->next)
4335 *r->var = MMAP_USER_AREA (r);
4337 else
4339 for (r = mmap_regions; r; r = r->next)
4340 *r->var = NULL;
4341 mmap_regions_1 = mmap_regions;
4342 mmap_regions = NULL;
4343 mmap_fd_1 = mmap_fd;
4344 mmap_fd = -1;
4349 /* Allocate a block of storage large enough to hold NBYTES bytes of
4350 data. A pointer to the data is returned in *VAR. VAR is thus the
4351 address of some variable which will use the data area.
4353 The allocation of 0 bytes is valid.
4355 If we can't allocate the necessary memory, set *VAR to null, and
4356 return null. */
4358 static POINTER_TYPE *
4359 mmap_alloc (var, nbytes)
4360 POINTER_TYPE **var;
4361 size_t nbytes;
4363 void *p;
4364 size_t map;
4366 mmap_init ();
4368 map = ROUND (nbytes + MMAP_REGION_STRUCT_SIZE, mmap_page_size);
4369 p = mmap (NULL, map, PROT_READ | PROT_WRITE, MAP_ANON | MAP_PRIVATE,
4370 mmap_fd, 0);
4372 if (p == MAP_FAILED)
4374 if (errno != ENOMEM)
4375 fprintf (stderr, "mmap: %s\n", emacs_strerror (errno));
4376 p = NULL;
4378 else
4380 struct mmap_region *r = (struct mmap_region *) p;
4382 r->nbytes_specified = nbytes;
4383 r->nbytes_mapped = map;
4384 r->var = var;
4385 r->prev = NULL;
4386 r->next = mmap_regions;
4387 if (r->next)
4388 r->next->prev = r;
4389 mmap_regions = r;
4391 p = MMAP_USER_AREA (p);
4394 return *var = p;
4398 /* Given a pointer at address VAR to data allocated with mmap_alloc,
4399 resize it to size NBYTES. Change *VAR to reflect the new block,
4400 and return this value. If more memory cannot be allocated, then
4401 leave *VAR unchanged, and return null. */
4403 static POINTER_TYPE *
4404 mmap_realloc (var, nbytes)
4405 POINTER_TYPE **var;
4406 size_t nbytes;
4408 POINTER_TYPE *result;
4410 mmap_init ();
4412 if (*var == NULL)
4413 result = mmap_alloc (var, nbytes);
4414 else if (nbytes == 0)
4416 mmap_free (var);
4417 result = mmap_alloc (var, nbytes);
4419 else
4421 struct mmap_region *r = MMAP_REGION (*var);
4422 size_t room = r->nbytes_mapped - MMAP_REGION_STRUCT_SIZE;
4424 if (room < nbytes)
4426 /* Must enlarge. */
4427 POINTER_TYPE *old_ptr = *var;
4429 /* Try to map additional pages at the end of the region.
4430 If that fails, allocate a new region, copy data
4431 from the old region, then free it. */
4432 if (mmap_enlarge (r, (ROUND (nbytes - room, mmap_page_size)
4433 / mmap_page_size)))
4435 r->nbytes_specified = nbytes;
4436 *var = result = old_ptr;
4438 else if (mmap_alloc (var, nbytes))
4440 bcopy (old_ptr, *var, r->nbytes_specified);
4441 mmap_free_1 (MMAP_REGION (old_ptr));
4442 result = *var;
4443 r = MMAP_REGION (result);
4444 r->nbytes_specified = nbytes;
4446 else
4448 *var = old_ptr;
4449 result = NULL;
4452 else if (room - nbytes >= mmap_page_size)
4454 /* Shrinking by at least a page. Let's give some
4455 memory back to the system. */
4456 mmap_enlarge (r, - (room - nbytes) / mmap_page_size);
4457 result = *var;
4458 r->nbytes_specified = nbytes;
4460 else
4462 /* Leave it alone. */
4463 result = *var;
4464 r->nbytes_specified = nbytes;
4468 return result;
4472 /* Free a block of relocatable storage whose data is pointed to by
4473 PTR. Store 0 in *PTR to show there's no block allocated. */
4475 static void
4476 mmap_free (var)
4477 POINTER_TYPE **var;
4479 mmap_init ();
4481 if (*var)
4483 mmap_free_1 (MMAP_REGION (*var));
4484 *var = NULL;
4489 /* Perform necessary intializations for the use of mmap. */
4491 static void
4492 mmap_init ()
4494 #if MAP_ANON == 0
4495 /* The value of mmap_fd is initially 0 in temacs, and -1
4496 in a dumped Emacs. */
4497 if (mmap_fd <= 0)
4499 /* No anonymous mmap -- we need the file descriptor. */
4500 mmap_fd = open ("/dev/zero", O_RDONLY);
4501 if (mmap_fd == -1)
4502 fatal ("Cannot open /dev/zero: %s", emacs_strerror (errno));
4504 #endif /* MAP_ANON == 0 */
4506 if (mmap_initialized_p)
4507 return;
4508 mmap_initialized_p = 1;
4510 #if MAP_ANON != 0
4511 mmap_fd = -1;
4512 #endif
4514 mmap_page_size = getpagesize ();
4517 #endif /* USE_MMAP_FOR_BUFFERS */
4521 /***********************************************************************
4522 Buffer-text Allocation
4523 ***********************************************************************/
4525 #ifdef REL_ALLOC
4526 extern POINTER_TYPE *r_alloc P_ ((POINTER_TYPE **, size_t));
4527 extern POINTER_TYPE *r_re_alloc P_ ((POINTER_TYPE **, size_t));
4528 extern void r_alloc_free P_ ((POINTER_TYPE **ptr));
4529 #endif /* REL_ALLOC */
4532 /* Allocate NBYTES bytes for buffer B's text buffer. */
4534 static void
4535 alloc_buffer_text (b, nbytes)
4536 struct buffer *b;
4537 size_t nbytes;
4539 POINTER_TYPE *p;
4541 BLOCK_INPUT;
4542 #if defined USE_MMAP_FOR_BUFFERS
4543 p = mmap_alloc ((POINTER_TYPE **) &b->text->beg, nbytes);
4544 #elif defined REL_ALLOC
4545 p = r_alloc ((POINTER_TYPE **) &b->text->beg, nbytes);
4546 #else
4547 p = xmalloc (nbytes);
4548 #endif
4550 if (p == NULL)
4552 UNBLOCK_INPUT;
4553 memory_full ();
4556 b->text->beg = (unsigned char *) p;
4557 UNBLOCK_INPUT;
4560 /* Enlarge buffer B's text buffer by DELTA bytes. DELTA < 0 means
4561 shrink it. */
4563 void
4564 enlarge_buffer_text (b, delta)
4565 struct buffer *b;
4566 int delta;
4568 POINTER_TYPE *p;
4569 size_t nbytes = (BUF_Z_BYTE (b) - BUF_BEG_BYTE (b) + BUF_GAP_SIZE (b) + 1
4570 + delta);
4571 BLOCK_INPUT;
4572 #if defined USE_MMAP_FOR_BUFFERS
4573 p = mmap_realloc ((POINTER_TYPE **) &b->text->beg, nbytes);
4574 #elif defined REL_ALLOC
4575 p = r_re_alloc ((POINTER_TYPE **) &b->text->beg, nbytes);
4576 #else
4577 p = xrealloc (b->text->beg, nbytes);
4578 #endif
4580 if (p == NULL)
4582 UNBLOCK_INPUT;
4583 memory_full ();
4586 BUF_BEG_ADDR (b) = (unsigned char *) p;
4587 UNBLOCK_INPUT;
4591 /* Free buffer B's text buffer. */
4593 static void
4594 free_buffer_text (b)
4595 struct buffer *b;
4597 BLOCK_INPUT;
4599 #if defined USE_MMAP_FOR_BUFFERS
4600 mmap_free ((POINTER_TYPE **) &b->text->beg);
4601 #elif defined REL_ALLOC
4602 r_alloc_free ((POINTER_TYPE **) &b->text->beg);
4603 #else
4604 xfree (b->text->beg);
4605 #endif
4607 BUF_BEG_ADDR (b) = NULL;
4608 UNBLOCK_INPUT;
4613 /***********************************************************************
4614 Initialization
4615 ***********************************************************************/
4617 void
4618 init_buffer_once ()
4620 int idx;
4622 bzero (buffer_permanent_local_flags, sizeof buffer_permanent_local_flags);
4624 /* Make sure all markable slots in buffer_defaults
4625 are initialized reasonably, so mark_buffer won't choke. */
4626 reset_buffer (&buffer_defaults);
4627 reset_buffer_local_variables (&buffer_defaults, 1);
4628 reset_buffer (&buffer_local_symbols);
4629 reset_buffer_local_variables (&buffer_local_symbols, 1);
4630 /* Prevent GC from getting confused. */
4631 buffer_defaults.text = &buffer_defaults.own_text;
4632 buffer_local_symbols.text = &buffer_local_symbols.own_text;
4633 BUF_INTERVALS (&buffer_defaults) = 0;
4634 BUF_INTERVALS (&buffer_local_symbols) = 0;
4635 XSETBUFFER (Vbuffer_defaults, &buffer_defaults);
4636 XSETBUFFER (Vbuffer_local_symbols, &buffer_local_symbols);
4638 /* Set up the default values of various buffer slots. */
4639 /* Must do these before making the first buffer! */
4641 /* real setup is done in bindings.el */
4642 buffer_defaults.mode_line_format = build_string ("%-");
4643 buffer_defaults.header_line_format = Qnil;
4644 buffer_defaults.abbrev_mode = Qnil;
4645 buffer_defaults.overwrite_mode = Qnil;
4646 buffer_defaults.case_fold_search = Qt;
4647 buffer_defaults.auto_fill_function = Qnil;
4648 buffer_defaults.selective_display = Qnil;
4649 #ifndef old
4650 buffer_defaults.selective_display_ellipses = Qt;
4651 #endif
4652 buffer_defaults.abbrev_table = Qnil;
4653 buffer_defaults.display_table = Qnil;
4654 buffer_defaults.undo_list = Qnil;
4655 buffer_defaults.mark_active = Qnil;
4656 buffer_defaults.file_format = Qnil;
4657 buffer_defaults.overlays_before = Qnil;
4658 buffer_defaults.overlays_after = Qnil;
4659 XSETFASTINT (buffer_defaults.overlay_center, BEG);
4661 XSETFASTINT (buffer_defaults.tab_width, 8);
4662 buffer_defaults.truncate_lines = Qnil;
4663 buffer_defaults.ctl_arrow = Qt;
4664 buffer_defaults.direction_reversed = Qnil;
4665 buffer_defaults.cursor_type = Qt;
4666 buffer_defaults.extra_line_spacing = Qnil;
4668 #ifdef DOS_NT
4669 buffer_defaults.buffer_file_type = Qnil; /* TEXT */
4670 #endif
4671 buffer_defaults.enable_multibyte_characters = Qt;
4672 buffer_defaults.buffer_file_coding_system = Qnil;
4673 XSETFASTINT (buffer_defaults.fill_column, 70);
4674 XSETFASTINT (buffer_defaults.left_margin, 0);
4675 buffer_defaults.cache_long_line_scans = Qnil;
4676 buffer_defaults.file_truename = Qnil;
4677 XSETFASTINT (buffer_defaults.display_count, 0);
4678 buffer_defaults.indicate_empty_lines = Qnil;
4679 buffer_defaults.scroll_up_aggressively = Qnil;
4680 buffer_defaults.scroll_down_aggressively = Qnil;
4681 buffer_defaults.display_time = Qnil;
4683 /* Assign the local-flags to the slots that have default values.
4684 The local flag is a bit that is used in the buffer
4685 to say that it has its own local value for the slot.
4686 The local flag bits are in the local_var_flags slot of the buffer. */
4688 /* Nothing can work if this isn't true */
4689 if (sizeof (EMACS_INT) != sizeof (Lisp_Object)) abort ();
4691 /* 0 means not a lisp var, -1 means always local, else mask */
4692 bzero (&buffer_local_flags, sizeof buffer_local_flags);
4693 XSETINT (buffer_local_flags.filename, -1);
4694 XSETINT (buffer_local_flags.directory, -1);
4695 XSETINT (buffer_local_flags.backed_up, -1);
4696 XSETINT (buffer_local_flags.save_length, -1);
4697 XSETINT (buffer_local_flags.auto_save_file_name, -1);
4698 XSETINT (buffer_local_flags.read_only, -1);
4699 XSETINT (buffer_local_flags.major_mode, -1);
4700 XSETINT (buffer_local_flags.mode_name, -1);
4701 XSETINT (buffer_local_flags.undo_list, -1);
4702 XSETINT (buffer_local_flags.mark_active, -1);
4703 XSETINT (buffer_local_flags.point_before_scroll, -1);
4704 XSETINT (buffer_local_flags.file_truename, -1);
4705 XSETINT (buffer_local_flags.invisibility_spec, -1);
4706 XSETINT (buffer_local_flags.file_format, -1);
4707 XSETINT (buffer_local_flags.display_count, -1);
4708 XSETINT (buffer_local_flags.display_time, -1);
4709 XSETINT (buffer_local_flags.enable_multibyte_characters, -1);
4711 idx = 1;
4712 XSETFASTINT (buffer_local_flags.mode_line_format, idx); ++idx;
4713 XSETFASTINT (buffer_local_flags.abbrev_mode, idx); ++idx;
4714 XSETFASTINT (buffer_local_flags.overwrite_mode, idx); ++idx;
4715 XSETFASTINT (buffer_local_flags.case_fold_search, idx); ++idx;
4716 XSETFASTINT (buffer_local_flags.auto_fill_function, idx); ++idx;
4717 XSETFASTINT (buffer_local_flags.selective_display, idx); ++idx;
4718 #ifndef old
4719 XSETFASTINT (buffer_local_flags.selective_display_ellipses, idx); ++idx;
4720 #endif
4721 XSETFASTINT (buffer_local_flags.tab_width, idx); ++idx;
4722 XSETFASTINT (buffer_local_flags.truncate_lines, idx); ++idx;
4723 XSETFASTINT (buffer_local_flags.ctl_arrow, idx); ++idx;
4724 XSETFASTINT (buffer_local_flags.fill_column, idx); ++idx;
4725 XSETFASTINT (buffer_local_flags.left_margin, idx); ++idx;
4726 XSETFASTINT (buffer_local_flags.abbrev_table, idx); ++idx;
4727 XSETFASTINT (buffer_local_flags.display_table, idx); ++idx;
4728 #ifdef DOS_NT
4729 XSETFASTINT (buffer_local_flags.buffer_file_type, idx);
4730 /* Make this one a permanent local. */
4731 buffer_permanent_local_flags[idx++] = 1;
4732 #endif
4733 XSETFASTINT (buffer_local_flags.syntax_table, idx); ++idx;
4734 XSETFASTINT (buffer_local_flags.cache_long_line_scans, idx); ++idx;
4735 XSETFASTINT (buffer_local_flags.category_table, idx); ++idx;
4736 XSETFASTINT (buffer_local_flags.direction_reversed, idx); ++idx;
4737 XSETFASTINT (buffer_local_flags.buffer_file_coding_system, idx);
4738 /* Make this one a permanent local. */
4739 buffer_permanent_local_flags[idx++] = 1;
4740 XSETFASTINT (buffer_local_flags.left_margin_width, idx); ++idx;
4741 XSETFASTINT (buffer_local_flags.right_margin_width, idx); ++idx;
4742 XSETFASTINT (buffer_local_flags.indicate_empty_lines, idx); ++idx;
4743 XSETFASTINT (buffer_local_flags.scroll_up_aggressively, idx); ++idx;
4744 XSETFASTINT (buffer_local_flags.scroll_down_aggressively, idx); ++idx;
4745 XSETFASTINT (buffer_local_flags.header_line_format, idx); ++idx;
4746 XSETFASTINT (buffer_local_flags.cursor_type, idx); ++idx;
4747 XSETFASTINT (buffer_local_flags.extra_line_spacing, idx); ++idx;
4749 /* Need more room? */
4750 if (idx >= MAX_PER_BUFFER_VARS)
4751 abort ();
4752 last_per_buffer_idx = idx;
4754 Vbuffer_alist = Qnil;
4755 current_buffer = 0;
4756 all_buffers = 0;
4758 QSFundamental = build_string ("Fundamental");
4760 Qfundamental_mode = intern ("fundamental-mode");
4761 buffer_defaults.major_mode = Qfundamental_mode;
4763 Qmode_class = intern ("mode-class");
4765 Qprotected_field = intern ("protected-field");
4767 Qpermanent_local = intern ("permanent-local");
4769 Qkill_buffer_hook = intern ("kill-buffer-hook");
4771 Vprin1_to_string_buffer = Fget_buffer_create (build_string (" prin1"));
4773 /* super-magic invisible buffer */
4774 Vbuffer_alist = Qnil;
4776 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
4778 inhibit_modification_hooks = 0;
4781 void
4782 init_buffer ()
4784 char buf[MAXPATHLEN + 1];
4785 char *pwd;
4786 struct stat dotstat, pwdstat;
4787 Lisp_Object temp;
4788 int rc;
4790 #ifdef USE_MMAP_FOR_BUFFERS
4792 /* When using the ralloc implementation based on mmap(2), buffer
4793 text pointers will have been set to null in the dumped Emacs.
4794 Map new memory. */
4795 struct buffer *b;
4797 for (b = all_buffers; b; b = b->next)
4798 if (b->text->beg == NULL)
4799 enlarge_buffer_text (b, 0);
4801 #endif /* USE_MMAP_FOR_BUFFERS */
4803 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
4804 if (NILP (buffer_defaults.enable_multibyte_characters))
4805 Fset_buffer_multibyte (Qnil);
4807 /* If PWD is accurate, use it instead of calling getwd. This is faster
4808 when PWD is right, and may avoid a fatal error. */
4809 if ((pwd = getenv ("PWD")) != 0
4810 && (IS_DIRECTORY_SEP (*pwd) || (*pwd && IS_DEVICE_SEP (pwd[1])))
4811 && stat (pwd, &pwdstat) == 0
4812 && stat (".", &dotstat) == 0
4813 && dotstat.st_ino == pwdstat.st_ino
4814 && dotstat.st_dev == pwdstat.st_dev
4815 && strlen (pwd) < MAXPATHLEN)
4816 strcpy (buf, pwd);
4817 #ifdef HAVE_GETCWD
4818 else if (getcwd (buf, MAXPATHLEN+1) == 0)
4819 fatal ("`getcwd' failed: %s\n", strerror (errno));
4820 #else
4821 else if (getwd (buf) == 0)
4822 fatal ("`getwd' failed: %s\n", buf);
4823 #endif
4825 #ifndef VMS
4826 /* Maybe this should really use some standard subroutine
4827 whose definition is filename syntax dependent. */
4828 rc = strlen (buf);
4829 if (!(IS_DIRECTORY_SEP (buf[rc - 1])))
4831 buf[rc] = DIRECTORY_SEP;
4832 buf[rc + 1] = '\0';
4834 #endif /* not VMS */
4836 current_buffer->directory = build_string (buf);
4838 /* Add /: to the front of the name
4839 if it would otherwise be treated as magic. */
4840 temp = Ffind_file_name_handler (current_buffer->directory, Qt);
4841 if (! NILP (temp)
4842 /* If the default dir is just /, TEMP is non-nil
4843 because of the ange-ftp completion handler.
4844 However, it is not necessary to turn / into /:/.
4845 So avoid doing that. */
4846 && strcmp ("/", XSTRING (current_buffer->directory)->data))
4847 current_buffer->directory
4848 = concat2 (build_string ("/:"), current_buffer->directory);
4850 temp = get_minibuffer (0);
4851 XBUFFER (temp)->directory = current_buffer->directory;
4854 /* initialize the buffer routines */
4855 void
4856 syms_of_buffer ()
4858 staticpro (&last_overlay_modification_hooks);
4859 last_overlay_modification_hooks
4860 = Fmake_vector (make_number (10), Qnil);
4862 staticpro (&Vbuffer_defaults);
4863 staticpro (&Vbuffer_local_symbols);
4864 staticpro (&Qfundamental_mode);
4865 staticpro (&Qmode_class);
4866 staticpro (&QSFundamental);
4867 staticpro (&Vbuffer_alist);
4868 staticpro (&Qprotected_field);
4869 staticpro (&Qpermanent_local);
4870 staticpro (&Qkill_buffer_hook);
4871 Qoverlayp = intern ("overlayp");
4872 staticpro (&Qoverlayp);
4873 Qevaporate = intern ("evaporate");
4874 staticpro (&Qevaporate);
4875 Qmodification_hooks = intern ("modification-hooks");
4876 staticpro (&Qmodification_hooks);
4877 Qinsert_in_front_hooks = intern ("insert-in-front-hooks");
4878 staticpro (&Qinsert_in_front_hooks);
4879 Qinsert_behind_hooks = intern ("insert-behind-hooks");
4880 staticpro (&Qinsert_behind_hooks);
4881 Qget_file_buffer = intern ("get-file-buffer");
4882 staticpro (&Qget_file_buffer);
4883 Qpriority = intern ("priority");
4884 staticpro (&Qpriority);
4885 Qwindow = intern ("window");
4886 staticpro (&Qwindow);
4887 Qbefore_string = intern ("before-string");
4888 staticpro (&Qbefore_string);
4889 Qafter_string = intern ("after-string");
4890 staticpro (&Qafter_string);
4891 Qfirst_change_hook = intern ("first-change-hook");
4892 staticpro (&Qfirst_change_hook);
4893 Qbefore_change_functions = intern ("before-change-functions");
4894 staticpro (&Qbefore_change_functions);
4895 Qafter_change_functions = intern ("after-change-functions");
4896 staticpro (&Qafter_change_functions);
4898 Fput (Qprotected_field, Qerror_conditions,
4899 Fcons (Qprotected_field, Fcons (Qerror, Qnil)));
4900 Fput (Qprotected_field, Qerror_message,
4901 build_string ("Attempt to modify a protected field"));
4903 /* All these use DEFVAR_LISP_NOPRO because the slots in
4904 buffer_defaults will all be marked via Vbuffer_defaults. */
4906 DEFVAR_LISP_NOPRO ("default-mode-line-format",
4907 &buffer_defaults.mode_line_format,
4908 "Default value of `mode-line-format' for buffers that don't override it.\n\
4909 This is the same as (default-value 'mode-line-format).");
4911 DEFVAR_LISP_NOPRO ("default-header-line-format",
4912 &buffer_defaults.header_line_format,
4913 "Default value of `header-line-format' for buffers that don't override it.\n\
4914 This is the same as (default-value 'header-line-format).");
4916 DEFVAR_LISP_NOPRO ("default-cursor-type", &buffer_defaults.cursor_type,
4917 "Default value of `cursor-type' for buffers that don't override it.\n\
4918 This is the same as (default-value 'cursor-type).");
4920 DEFVAR_LISP_NOPRO ("default-line-spacing",
4921 &buffer_defaults.extra_line_spacing,
4922 "Default value of `line-spacing' for buffers that don't override it.\n\
4923 This is the same as (default-value 'line-spacing).");
4925 DEFVAR_LISP_NOPRO ("default-abbrev-mode",
4926 &buffer_defaults.abbrev_mode,
4927 "Default value of `abbrev-mode' for buffers that do not override it.\n\
4928 This is the same as (default-value 'abbrev-mode).");
4930 DEFVAR_LISP_NOPRO ("default-ctl-arrow",
4931 &buffer_defaults.ctl_arrow,
4932 "Default value of `ctl-arrow' for buffers that do not override it.\n\
4933 This is the same as (default-value 'ctl-arrow).");
4935 DEFVAR_LISP_NOPRO ("default-direction-reversed",
4936 &buffer_defaults.direction_reversed,
4937 "Default value of `direction_reversed' for buffers that do not override it.\n\
4938 This is the same as (default-value 'direction-reversed).");
4940 DEFVAR_LISP_NOPRO ("default-enable-multibyte-characters",
4941 &buffer_defaults.enable_multibyte_characters,
4942 "*Default value of `enable-multibyte-characters' for buffers not overriding it.\n\
4943 This is the same as (default-value 'enable-multibyte-characters).");
4945 DEFVAR_LISP_NOPRO ("default-buffer-file-coding-system",
4946 &buffer_defaults.buffer_file_coding_system,
4947 "Default value of `buffer-file-coding-system' for buffers not overriding it.\n\
4948 This is the same as (default-value 'buffer-file-coding-system).");
4950 DEFVAR_LISP_NOPRO ("default-truncate-lines",
4951 &buffer_defaults.truncate_lines,
4952 "Default value of `truncate-lines' for buffers that do not override it.\n\
4953 This is the same as (default-value 'truncate-lines).");
4955 DEFVAR_LISP_NOPRO ("default-fill-column",
4956 &buffer_defaults.fill_column,
4957 "Default value of `fill-column' for buffers that do not override it.\n\
4958 This is the same as (default-value 'fill-column).");
4960 DEFVAR_LISP_NOPRO ("default-left-margin",
4961 &buffer_defaults.left_margin,
4962 "Default value of `left-margin' for buffers that do not override it.\n\
4963 This is the same as (default-value 'left-margin).");
4965 DEFVAR_LISP_NOPRO ("default-tab-width",
4966 &buffer_defaults.tab_width,
4967 "Default value of `tab-width' for buffers that do not override it.\n\
4968 This is the same as (default-value 'tab-width).");
4970 DEFVAR_LISP_NOPRO ("default-case-fold-search",
4971 &buffer_defaults.case_fold_search,
4972 "Default value of `case-fold-search' for buffers that don't override it.\n\
4973 This is the same as (default-value 'case-fold-search).");
4975 #ifdef DOS_NT
4976 DEFVAR_LISP_NOPRO ("default-buffer-file-type",
4977 &buffer_defaults.buffer_file_type,
4978 "Default file type for buffers that do not override it.\n\
4979 This is the same as (default-value 'buffer-file-type).\n\
4980 The file type is nil for text, t for binary.");
4981 #endif
4983 DEFVAR_LISP_NOPRO ("default-left-margin-width",
4984 &buffer_defaults.left_margin_width,
4985 "Default value of `left-margin-width' for buffers that don't override it.\n\
4986 This is the same as (default-value 'left-margin-width).");
4988 DEFVAR_LISP_NOPRO ("default-right-margin-width",
4989 &buffer_defaults.right_margin_width,
4990 "Default value of `right_margin_width' for buffers that don't override it.\n\
4991 This is the same as (default-value 'right-margin-width).");
4993 DEFVAR_LISP_NOPRO ("default-indicate-empty-lines",
4994 &buffer_defaults.indicate_empty_lines,
4995 "Default value of `indicate-empty-lines' for buffers that don't override it.\n\
4996 This is the same as (default-value 'indicate-empty-lines).");
4998 DEFVAR_LISP_NOPRO ("default-scroll-up-aggressively",
4999 &buffer_defaults.scroll_up_aggressively,
5000 "Default value of `scroll-up-aggressively' for buffers that\n\
5001 don't override it. This is the same as (default-value\n\
5002 'scroll-up-aggressively).");
5004 DEFVAR_LISP_NOPRO ("default-scroll-down-aggressively",
5005 &buffer_defaults.scroll_down_aggressively,
5006 "Default value of `scroll-down-aggressively' for buffers that\n\
5007 don't override it. This is the same as (default-value\n\
5008 'scroll-down-aggressively).");
5010 DEFVAR_PER_BUFFER ("header-line-format",
5011 &current_buffer->header_line_format,
5012 Qnil,
5013 "Analogous to `mode-line-format', but for a mode line displayed\n\
5014 at the top of windows.");
5016 DEFVAR_PER_BUFFER ("mode-line-format", &current_buffer->mode_line_format,
5017 Qnil, 0);
5019 /* This doc string is too long for cpp; cpp dies if it isn't in a comment.
5020 But make-docfile finds it!
5021 DEFVAR_PER_BUFFER ("mode-line-format", &current_buffer->mode_line_format,
5022 Qnil,
5023 "Template for displaying mode line for current buffer.\n\
5024 Each buffer has its own value of this variable.\n\
5025 Value may be nil, a string, a symbol or a list or cons cell.\n\
5026 A value of nil means don't display a mode line.\n\
5027 For a symbol, its value is used (but it is ignored if t or nil).\n\
5028 A string appearing directly as the value of a symbol is processed verbatim\n\
5029 in that the %-constructs below are not recognized.\n\
5030 For a list of the form `(:eval FORM)', FORM is evaluated and the result\n\
5031 is used as a mode line element.\n\
5032 For a list whose car is a symbol, the symbol's value is taken,\n\
5033 and if that is non-nil, the cadr of the list is processed recursively.\n\
5034 Otherwise, the caddr of the list (if there is one) is processed.\n\
5035 For a list whose car is a string or list, each element is processed\n\
5036 recursively and the results are effectively concatenated.\n\
5037 For a list whose car is an integer, the cdr of the list is processed\n\
5038 and padded (if the number is positive) or truncated (if negative)\n\
5039 to the width specified by that number.\n\
5040 A string is printed verbatim in the mode line except for %-constructs:\n\
5041 (%-constructs are allowed when the string is the entire mode-line-format\n\
5042 or when it is found in a cons-cell or a list)\n\
5043 %b -- print buffer name. %f -- print visited file name.\n\
5044 %F -- print frame name.\n\
5045 %* -- print %, * or hyphen. %+ -- print *, % or hyphen.\n\
5046 %& is like %*, but ignore read-only-ness.\n\
5047 % means buffer is read-only and * means it is modified.\n\
5048 For a modified read-only buffer, %* gives % and %+ gives *.\n\
5049 %s -- print process status. %l -- print the current line number.\n\
5050 %c -- print the current column number (this makes editing slower).\n\
5051 To make the column number update correctly in all cases,\n\
5052 `column-number-mode' must be non-nil.\n\
5053 %p -- print percent of buffer above top of window, or Top, Bot or All.\n\
5054 %P -- print percent of buffer above bottom of window, perhaps plus Top,\n\
5055 or print Bottom or All.\n\
5056 %m -- print the mode name.\n\
5057 %n -- print Narrow if appropriate.\n\
5058 %z -- print mnemonics of buffer, terminal, and keyboard coding systems.\n\
5059 %Z -- like %z, but including the end-of-line format.\n\
5060 %[ -- print one [ for each recursive editing level. %] similar.\n\
5061 %% -- print %. %- -- print infinitely many dashes.\n\
5062 Decimal digits after the % specify field width to which to pad.");
5065 DEFVAR_LISP_NOPRO ("default-major-mode", &buffer_defaults.major_mode,
5066 "*Major mode for new buffers. Defaults to `fundamental-mode'.\n\
5067 nil here means use current buffer's major mode.");
5069 DEFVAR_PER_BUFFER ("major-mode", &current_buffer->major_mode,
5070 make_number (Lisp_Symbol),
5071 "Symbol for current buffer's major mode.");
5073 DEFVAR_PER_BUFFER ("mode-name", &current_buffer->mode_name,
5074 make_number (Lisp_String),
5075 "Pretty name of current buffer's major mode (a string).");
5077 DEFVAR_PER_BUFFER ("abbrev-mode", &current_buffer->abbrev_mode, Qnil,
5078 "Non-nil turns on automatic expansion of abbrevs as they are inserted.\n\
5079 Automatically becomes buffer-local when set in any fashion.");
5081 DEFVAR_PER_BUFFER ("case-fold-search", &current_buffer->case_fold_search,
5082 Qnil,
5083 "*Non-nil if searches and matches should ignore case.\n\
5084 Automatically becomes buffer-local when set in any fashion.");
5086 DEFVAR_PER_BUFFER ("fill-column", &current_buffer->fill_column,
5087 make_number (Lisp_Int),
5088 "*Column beyond which automatic line-wrapping should happen.\n\
5089 Automatically becomes buffer-local when set in any fashion.");
5091 DEFVAR_PER_BUFFER ("left-margin", &current_buffer->left_margin,
5092 make_number (Lisp_Int),
5093 "*Column for the default indent-line-function to indent to.\n\
5094 Linefeed indents to this column in Fundamental mode.\n\
5095 Automatically becomes buffer-local when set in any fashion.");
5097 DEFVAR_PER_BUFFER ("tab-width", &current_buffer->tab_width,
5098 make_number (Lisp_Int),
5099 "*Distance between tab stops (for display of tab characters), in columns.\n\
5100 Automatically becomes buffer-local when set in any fashion.");
5102 DEFVAR_PER_BUFFER ("ctl-arrow", &current_buffer->ctl_arrow, Qnil,
5103 "*Non-nil means display control chars with uparrow.\n\
5104 A value of nil means use backslash and octal digits.\n\
5105 Automatically becomes buffer-local when set in any fashion.\n\
5106 This variable does not apply to characters whose display is specified\n\
5107 in the current display table (if there is one).");
5109 DEFVAR_PER_BUFFER ("enable-multibyte-characters",
5110 &current_buffer->enable_multibyte_characters,
5111 make_number (-1),
5112 "Non-nil means the buffer contents are regarded as multi-byte characters.\n\
5113 Otherwise they are regarded as unibyte. This affects the display,\n\
5114 file I/O and the behavior of various editing commands.\n\
5116 This variable is buffer-local but you cannot set it directly;\n\
5117 use the function `set-buffer-multibyte' to change a buffer's representation.\n\
5118 Changing its default value with `setq-default' is supported.\n\
5119 See also variable `default-enable-multibyte-characters' and Info node\n\
5120 `(elisp)Text Representations'.");
5122 DEFVAR_PER_BUFFER ("buffer-file-coding-system",
5123 &current_buffer->buffer_file_coding_system, Qnil,
5124 "Coding system to be used for encoding the buffer contents on saving.\n\
5125 This variable applies to saving the buffer, and also to `write-region'\n\
5126 and other functions that use `write-region'.\n\
5127 It does not apply to sending output to subprocesses, however.\n\
5129 If this is nil, the buffer is saved without any code conversion\n\
5130 unless some coding system is specified in `file-coding-system-alist'\n\
5131 for the buffer file.\n\
5133 The variable `coding-system-for-write', if non-nil, overrides this variable.\n\
5135 This variable is never applied to a way of decoding\n\
5136 a file while reading it.");
5138 DEFVAR_PER_BUFFER ("direction-reversed", &current_buffer->direction_reversed,
5139 Qnil,
5140 "*Non-nil means lines in the buffer are displayed right to left.");
5142 DEFVAR_PER_BUFFER ("truncate-lines", &current_buffer->truncate_lines, Qnil,
5143 "*Non-nil means do not display continuation lines;\n\
5144 give each line of text one screen line.\n\
5145 Automatically becomes buffer-local when set in any fashion.\n\
5147 Note that this is overridden by the variable\n\
5148 `truncate-partial-width-windows' if that variable is non-nil\n\
5149 and this buffer is not full-frame width.");
5151 #ifdef DOS_NT
5152 DEFVAR_PER_BUFFER ("buffer-file-type", &current_buffer->buffer_file_type,
5153 Qnil,
5154 "Non-nil if the visited file is a binary file.\n\
5155 This variable is meaningful on MS-DOG and Windows NT.\n\
5156 On those systems, it is automatically local in every buffer.\n\
5157 On other systems, this variable is normally always nil.");
5158 #endif
5160 DEFVAR_PER_BUFFER ("default-directory", &current_buffer->directory,
5161 make_number (Lisp_String),
5162 "Name of default directory of current buffer. Should end with slash.\n\
5163 Each buffer has its own value of this variable.");
5165 DEFVAR_PER_BUFFER ("auto-fill-function", &current_buffer->auto_fill_function,
5166 Qnil,
5167 "Function called (if non-nil) to perform auto-fill.\n\
5168 It is called after self-inserting any character specified in\n\
5169 the `auto-fill-chars' table.\n\
5170 Each buffer has its own value of this variable.\n\
5171 NOTE: This variable is not a hook;\n\
5172 its value may not be a list of functions.");
5174 DEFVAR_PER_BUFFER ("buffer-file-name", &current_buffer->filename,
5175 make_number (Lisp_String),
5176 "Name of file visited in current buffer, or nil if not visiting a file.\n\
5177 Each buffer has its own value of this variable.");
5179 DEFVAR_PER_BUFFER ("buffer-file-truename", &current_buffer->file_truename,
5180 make_number (Lisp_String),
5181 "Abbreviated truename of file visited in current buffer, or nil if none.\n\
5182 The truename of a file is calculated by `file-truename'\n\
5183 and then abbreviated with `abbreviate-file-name'.\n\
5184 Each buffer has its own value of this variable.");
5186 DEFVAR_PER_BUFFER ("buffer-auto-save-file-name",
5187 &current_buffer->auto_save_file_name,
5188 make_number (Lisp_String),
5189 "Name of file for auto-saving current buffer,\n\
5190 or nil if buffer should not be auto-saved.\n\
5191 Each buffer has its own value of this variable.");
5193 DEFVAR_PER_BUFFER ("buffer-read-only", &current_buffer->read_only, Qnil,
5194 "Non-nil if this buffer is read-only.\n\
5195 Each buffer has its own value of this variable.");
5197 DEFVAR_PER_BUFFER ("buffer-backed-up", &current_buffer->backed_up, Qnil,
5198 "Non-nil if this buffer's file has been backed up.\n\
5199 Backing up is done before the first time the file is saved.\n\
5200 Each buffer has its own value of this variable.");
5202 DEFVAR_PER_BUFFER ("buffer-saved-size", &current_buffer->save_length,
5203 make_number (Lisp_Int),
5204 "Length of current buffer when last read in, saved or auto-saved.\n\
5205 0 initially.\n\
5206 Each buffer has its own value of this variable.");
5208 DEFVAR_PER_BUFFER ("selective-display", &current_buffer->selective_display,
5209 Qnil,
5210 "Non-nil enables selective display:\n\
5211 Integer N as value means display only lines\n\
5212 that start with less than n columns of space.\n\
5213 A value of t means, after a ^M, all the rest of the line is invisible.\n\
5214 Then ^M's in the file are written into files as newlines.\n\n\
5215 Automatically becomes buffer-local when set in any fashion.");
5217 #ifndef old
5218 DEFVAR_PER_BUFFER ("selective-display-ellipses",
5219 &current_buffer->selective_display_ellipses,
5220 Qnil,
5221 "t means display ... on previous line when a line is invisible.\n\
5222 Automatically becomes buffer-local when set in any fashion.");
5223 #endif
5225 DEFVAR_PER_BUFFER ("overwrite-mode", &current_buffer->overwrite_mode, Qnil,
5226 "Non-nil if self-insertion should replace existing text.\n\
5227 The value should be one of `overwrite-mode-textual',\n\
5228 `overwrite-mode-binary', or nil.\n\
5229 If it is `overwrite-mode-textual', self-insertion still\n\
5230 inserts at the end of a line, and inserts when point is before a tab,\n\
5231 until the tab is filled in.\n\
5232 If `overwrite-mode-binary', self-insertion replaces newlines and tabs too.\n\
5233 Automatically becomes buffer-local when set in any fashion.");
5235 #if 0 /* The doc string is too long for some compilers,
5236 but make-docfile can find it in this comment. */
5237 DEFVAR_PER_BUFFER ("buffer-display-table", &current_buffer->display_table,
5238 Qnil,
5239 "Display table that controls display of the contents of current buffer.\n\
5240 Automatically becomes buffer-local when set in any fashion.\n\
5241 The display table is a char-table created with `make-display-table'.\n\
5242 The ordinary char-table elements control how to display each possible text\n\
5243 character. Each value should be a vector of characters or nil;\n\
5244 nil means display the character in the default fashion.\n\
5245 There are six extra slots to control the display of\n\
5246 the end of a truncated screen line (extra-slot 0, a single character);\n\
5247 the end of a continued line (extra-slot 1, a single character);\n\
5248 the escape character used to display character codes in octal\n\
5249 (extra-slot 2, a single character);\n\
5250 the character used as an arrow for control characters (extra-slot 3,\n\
5251 a single character);\n\
5252 the decoration indicating the presence of invisible lines (extra-slot 4,\n\
5253 a vector of characters);\n\
5254 the character used to draw the border between side-by-side windows\n\
5255 (extra-slot 5, a single character).\n\
5256 See also the functions `display-table-slot' and `set-display-table-slot'.\n\
5257 If this variable is nil, the value of `standard-display-table' is used.\n\
5258 Each window can have its own, overriding display table.");
5259 #endif
5260 DEFVAR_PER_BUFFER ("buffer-display-table", &current_buffer->display_table,
5261 Qnil, 0);
5263 DEFVAR_PER_BUFFER ("left-margin-width", &current_buffer->left_margin_width,
5264 Qnil,
5265 "*Width of left marginal area for display of a buffer.\n\
5266 Automatically becomes buffer-local when set in any fashion.\n\
5267 A value of nil means no marginal area.");
5269 DEFVAR_PER_BUFFER ("right-margin-width", &current_buffer->right_margin_width,
5270 Qnil,
5271 "*Width of right marginal area for display of a buffer.\n\
5272 Automatically becomes buffer-local when set in any fashion.\n\
5273 A value of nil means no marginal area.");
5275 DEFVAR_PER_BUFFER ("indicate-empty-lines",
5276 &current_buffer->indicate_empty_lines, Qnil,
5277 "*Visually indicate empty lines after the buffer end.\n\
5278 If non-nil, a bitmap is displayed in the left fringe of a window on\n\
5279 window-systems.\n\
5280 Automatically becomes buffer-local when set in any fashion.\n");
5282 DEFVAR_PER_BUFFER ("scroll-up-aggressively",
5283 &current_buffer->scroll_up_aggressively, Qnil,
5284 "*If a number, scroll display up aggressively.\n\
5285 If scrolling a window because point is above the window start, choose\n\
5286 a new window start so that point ends up that fraction of the window's\n\
5287 height from the top of the window.\n\
5288 Automatically becomes buffer-local when set in any fashion.");
5290 DEFVAR_PER_BUFFER ("scroll-down-aggressively",
5291 &current_buffer->scroll_down_aggressively, Qnil,
5292 "*If a number, scroll display down aggressively.\n\
5293 If scrolling a window because point is below the window end, choose\n\
5294 a new window start so that point ends up that fraction of the window's\n\
5295 height from the bottom of the window.\n\
5296 Automatically becomes buffer-local when set in any fashion.");
5298 /*DEFVAR_LISP ("debug-check-symbol", &Vcheck_symbol,
5299 "Don't ask.");
5302 DEFVAR_LISP ("before-change-functions", &Vbefore_change_functions,
5303 "List of functions to call before each text change.\n\
5304 Two arguments are passed to each function: the positions of\n\
5305 the beginning and end of the range of old text to be changed.\n\
5306 \(For an insertion, the beginning and end are at the same place.)\n\
5307 No information is given about the length of the text after the change.\n\
5309 Buffer changes made while executing the `before-change-functions'\n\
5310 don't call any before-change or after-change functions.\n\
5311 That's because these variables are temporarily set to nil.\n\
5312 As a result, a hook function cannot straightforwardly alter the value of\n\
5313 these variables. See the Emacs Lisp manual for a way of\n\
5314 accomplishing an equivalent result by using other variables.\n\
5316 If an unhandled error happens in running these functions,\n\
5317 the variable's value remains nil. That prevents the error\n\
5318 from happening repeatedly and making Emacs nonfunctional.");
5319 Vbefore_change_functions = Qnil;
5321 DEFVAR_LISP ("after-change-functions", &Vafter_change_functions,
5322 "List of function to call after each text change.\n\
5323 Three arguments are passed to each function: the positions of\n\
5324 the beginning and end of the range of changed text,\n\
5325 and the length in bytes of the pre-change text replaced by that range.\n\
5326 \(For an insertion, the pre-change length is zero;\n\
5327 for a deletion, that length is the number of bytes deleted,\n\
5328 and the post-change beginning and end are at the same place.)\n\
5330 Buffer changes made while executing the `after-change-functions'\n\
5331 don't call any before-change or after-change functions.\n\
5332 That's because these variables are temporarily set to nil.\n\
5333 As a result, a hook function cannot straightforwardly alter the value of\n\
5334 these variables. See the Emacs Lisp manual for a way of\n\
5335 accomplishing an equivalent result by using other variables.\n\
5337 If an unhandled error happens in running these functions,\n\
5338 the variable's value remains nil. That prevents the error\n\
5339 from happening repeatedly and making Emacs nonfunctional.");
5340 Vafter_change_functions = Qnil;
5342 DEFVAR_LISP ("first-change-hook", &Vfirst_change_hook,
5343 "A list of functions to call before changing a buffer which is unmodified.\n\
5344 The functions are run using the `run-hooks' function.");
5345 Vfirst_change_hook = Qnil;
5347 #if 0 /* The doc string is too long for some compilers,
5348 but make-docfile can find it in this comment. */
5349 DEFVAR_PER_BUFFER ("buffer-undo-list", &current_buffer->undo_list, Qnil,
5350 "List of undo entries in current buffer.\n\
5351 This variable is always local in all buffers.\n\
5352 Recent changes come first; older changes follow newer.\n\
5354 An entry (BEG . END) represents an insertion which begins at\n\
5355 position BEG and ends at position END.\n\
5357 An entry (TEXT . POSITION) represents the deletion of the string TEXT\n\
5358 from (abs POSITION). If POSITION is positive, point was at the front\n\
5359 of the text being deleted; if negative, point was at the end.\n\
5361 An entry (t HIGH . LOW) indicates that the buffer previously had\n\
5362 \"unmodified\" status. HIGH and LOW are the high and low 16-bit portions\n\
5363 of the visited file's modification time, as of that time. If the\n\
5364 modification time of the most recent save is different, this entry is\n\
5365 obsolete.\n\
5367 An entry (nil PROPERTY VALUE BEG . END) indicates that a text property\n\
5368 was modified between BEG and END. PROPERTY is the property name,\n\
5369 and VALUE is the old value.\n\
5371 An entry (MARKER . DISTANCE) indicates that the marker MARKER\n\
5372 was adjusted in position by the offset DISTANCE (an integer).\n\
5374 An entry of the form POSITION indicates that point was at the buffer\n\
5375 location given by the integer. Undoing an entry of this form places\n\
5376 point at POSITION.\n\
5378 nil marks undo boundaries. The undo command treats the changes\n\
5379 between two undo boundaries as a single step to be undone.\n\
5381 If the value of the variable is t, undo information is not recorded.");
5382 #endif
5383 DEFVAR_PER_BUFFER ("buffer-undo-list", &current_buffer->undo_list, Qnil,
5386 DEFVAR_PER_BUFFER ("mark-active", &current_buffer->mark_active, Qnil,
5387 "Non-nil means the mark and region are currently active in this buffer.\n\
5388 Automatically local in all buffers.");
5390 DEFVAR_PER_BUFFER ("cache-long-line-scans", &current_buffer->cache_long_line_scans, Qnil,
5391 "Non-nil means that Emacs should use caches to handle long lines more quickly.\n\
5392 This variable is buffer-local, in all buffers.\n\
5394 Normally, the line-motion functions work by scanning the buffer for\n\
5395 newlines. Columnar operations (like move-to-column and\n\
5396 compute-motion) also work by scanning the buffer, summing character\n\
5397 widths as they go. This works well for ordinary text, but if the\n\
5398 buffer's lines are very long (say, more than 500 characters), these\n\
5399 motion functions will take longer to execute. Emacs may also take\n\
5400 longer to update the display.\n\
5402 If cache-long-line-scans is non-nil, these motion functions cache the\n\
5403 results of their scans, and consult the cache to avoid rescanning\n\
5404 regions of the buffer until the text is modified. The caches are most\n\
5405 beneficial when they prevent the most searching---that is, when the\n\
5406 buffer contains long lines and large regions of characters with the\n\
5407 same, fixed screen width.\n\
5409 When cache-long-line-scans is non-nil, processing short lines will\n\
5410 become slightly slower (because of the overhead of consulting the\n\
5411 cache), and the caches will use memory roughly proportional to the\n\
5412 number of newlines and characters whose screen width varies.\n\
5414 The caches require no explicit maintenance; their accuracy is\n\
5415 maintained internally by the Emacs primitives. Enabling or disabling\n\
5416 the cache should not affect the behavior of any of the motion\n\
5417 functions; it should only affect their performance.");
5419 DEFVAR_PER_BUFFER ("point-before-scroll", &current_buffer->point_before_scroll, Qnil,
5420 "Value of point before the last series of scroll operations, or nil.\n\
5421 This variable is always local in all buffers.");
5423 DEFVAR_PER_BUFFER ("buffer-file-format", &current_buffer->file_format, Qnil,
5424 "List of formats to use when saving this buffer.\n\
5425 This variable is always local in all buffers.\n\
5426 Formats are defined by `format-alist'. This variable is\n\
5427 set when a file is visited. Automatically local in all buffers.");
5429 DEFVAR_PER_BUFFER ("buffer-invisibility-spec",
5430 &current_buffer->invisibility_spec, Qnil,
5431 "Invisibility spec of this buffer.\n\
5432 This variable is always local in all buffers.\n\
5433 The default is t, which means that text is invisible\n\
5434 if it has a non-nil `invisible' property.\n\
5435 If the value is a list, a text character is invisible if its `invisible'\n\
5436 property is an element in that list.\n\
5437 If an element is a cons cell of the form (PROP . ELLIPSIS),\n\
5438 then characters with property value PROP are invisible,\n\
5439 and they have an ellipsis as well if ELLIPSIS is non-nil.");
5441 DEFVAR_PER_BUFFER ("buffer-display-count",
5442 &current_buffer->display_count, Qnil,
5443 "A number incremented each time this buffer is displayed in a window.\n\
5444 This variable is always local in all buffers.\n\
5445 The function `set-window-buffer increments it.");
5447 DEFVAR_PER_BUFFER ("buffer-display-time",
5448 &current_buffer->display_time, Qnil,
5449 "Time stamp updated each time this buffer is displayed in a window.\n\
5450 This variable is always local in all buffers.\n\
5451 The function `set-window-buffer' updates this variable\n\
5452 to the value obtained by calling `current-time'.\n\
5453 If the buffer has never been shown in a window, the value is nil.");
5455 DEFVAR_LISP ("transient-mark-mode", &Vtransient_mark_mode,
5456 "*Non-nil means deactivate the mark when the buffer contents change.\n\
5457 Non-nil also enables highlighting of the region whenever the mark is active.\n\
5458 The variable `highlight-nonselected-windows' controls whether to highlight\n\
5459 all windows or just the selected window.");
5460 Vtransient_mark_mode = Qnil;
5462 DEFVAR_LISP ("inhibit-read-only", &Vinhibit_read_only,
5463 "*Non-nil means disregard read-only status of buffers or characters.\n\
5464 If the value is t, disregard `buffer-read-only' and all `read-only'\n\
5465 text properties. If the value is a list, disregard `buffer-read-only'\n\
5466 and disregard a `read-only' text property if the property value\n\
5467 is a member of the list.");
5468 Vinhibit_read_only = Qnil;
5470 DEFVAR_PER_BUFFER ("cursor-type", &current_buffer->cursor_type, Qnil,
5471 "Cursor to use in window displaying this buffer.\n\
5472 Values are interpreted as follows:\n\
5474 t use the cursor specified for the frame\n\
5475 nil don't display a cursor\n\
5476 `bar' display a bar cursor with default width\n\
5477 (bar . WIDTH) display a bar cursor with width WIDTH\n\
5478 others display a box cursor.");
5480 DEFVAR_PER_BUFFER ("line-spacing",
5481 &current_buffer->extra_line_spacing, Qnil,
5482 "Additional space to put between lines when displaying a buffer.\n\
5483 The space is measured in pixels, and put below lines on window systems.");
5485 DEFVAR_LISP ("kill-buffer-query-functions", &Vkill_buffer_query_functions,
5486 "List of functions called with no args to query before killing a buffer.");
5487 Vkill_buffer_query_functions = Qnil;
5489 defsubr (&Sbuffer_live_p);
5490 defsubr (&Sbuffer_list);
5491 defsubr (&Sget_buffer);
5492 defsubr (&Sget_file_buffer);
5493 defsubr (&Sget_buffer_create);
5494 defsubr (&Smake_indirect_buffer);
5495 defsubr (&Sgenerate_new_buffer_name);
5496 defsubr (&Sbuffer_name);
5497 /*defsubr (&Sbuffer_number);*/
5498 defsubr (&Sbuffer_file_name);
5499 defsubr (&Sbuffer_base_buffer);
5500 defsubr (&Sbuffer_local_variables);
5501 defsubr (&Sbuffer_modified_p);
5502 defsubr (&Sset_buffer_modified_p);
5503 defsubr (&Sbuffer_modified_tick);
5504 defsubr (&Srename_buffer);
5505 defsubr (&Sother_buffer);
5506 defsubr (&Sbuffer_disable_undo);
5507 defsubr (&Sbuffer_enable_undo);
5508 defsubr (&Skill_buffer);
5509 defsubr (&Sset_buffer_major_mode);
5510 defsubr (&Sswitch_to_buffer);
5511 defsubr (&Spop_to_buffer);
5512 defsubr (&Scurrent_buffer);
5513 defsubr (&Sset_buffer);
5514 defsubr (&Sbarf_if_buffer_read_only);
5515 defsubr (&Sbury_buffer);
5516 defsubr (&Serase_buffer);
5517 defsubr (&Sset_buffer_multibyte);
5518 defsubr (&Skill_all_local_variables);
5520 defsubr (&Soverlayp);
5521 defsubr (&Smake_overlay);
5522 defsubr (&Sdelete_overlay);
5523 defsubr (&Smove_overlay);
5524 defsubr (&Soverlay_start);
5525 defsubr (&Soverlay_end);
5526 defsubr (&Soverlay_buffer);
5527 defsubr (&Soverlay_properties);
5528 defsubr (&Soverlays_at);
5529 defsubr (&Soverlays_in);
5530 defsubr (&Snext_overlay_change);
5531 defsubr (&Sprevious_overlay_change);
5532 defsubr (&Soverlay_recenter);
5533 defsubr (&Soverlay_lists);
5534 defsubr (&Soverlay_get);
5535 defsubr (&Soverlay_put);
5536 defsubr (&Srestore_buffer_modified_p);
5539 void
5540 keys_of_buffer ()
5542 initial_define_key (control_x_map, 'b', "switch-to-buffer");
5543 initial_define_key (control_x_map, 'k', "kill-buffer");
5545 /* This must not be in syms_of_buffer, because Qdisabled is not
5546 initialized when that function gets called. */
5547 Fput (intern ("erase-buffer"), Qdisabled, Qt);