(profile, make-docfile, hexl): Depend on config.h.
[emacs.git] / src / buffer.c
blob50b982fb3fd3788c873964bfa316e6fd831ebd9f
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>
29 #ifndef USE_CRT_DLL
30 extern int errno;
31 #endif
33 #ifndef MAXPATHLEN
34 /* in 4.1, param.h fails to define this. */
35 #define MAXPATHLEN 1024
36 #endif /* not MAXPATHLEN */
38 #ifdef HAVE_UNISTD_H
39 #include <unistd.h>
40 #endif
41 #include "lisp.h"
42 #include "intervals.h"
43 #include "window.h"
44 #include "commands.h"
45 #include "buffer.h"
46 #include "charset.h"
47 #include "region-cache.h"
48 #include "indent.h"
49 #include "blockinput.h"
50 #include "keyboard.h"
51 #include "frame.h"
53 struct buffer *current_buffer; /* the current buffer */
55 /* First buffer in chain of all buffers (in reverse order of creation).
56 Threaded through ->next. */
58 struct buffer *all_buffers;
60 /* This structure holds the default values of the buffer-local variables
61 defined with DEFVAR_PER_BUFFER, that have special slots in each buffer.
62 The default value occupies the same slot in this structure
63 as an individual buffer's value occupies in that buffer.
64 Setting the default value also goes through the alist of buffers
65 and stores into each buffer that does not say it has a local value. */
67 struct buffer buffer_defaults;
69 /* A Lisp_Object pointer to the above, used for staticpro */
71 static Lisp_Object Vbuffer_defaults;
73 /* This structure marks which slots in a buffer have corresponding
74 default values in buffer_defaults.
75 Each such slot has a nonzero value in this structure.
76 The value has only one nonzero bit.
78 When a buffer has its own local value for a slot,
79 the entry for that slot (found in the same slot in this structure)
80 is turned on in the buffer's local_flags array.
82 If a slot in this structure is -1, then even though there may
83 be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
84 and the corresponding slot in buffer_defaults is not used.
86 If a slot is -2, then there is no DEFVAR_PER_BUFFER for it,
87 but there is a default value which is copied into each buffer.
89 If a slot in this structure is negative, then even though there may
90 be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
91 and the corresponding slot in buffer_defaults is not used.
93 If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is
94 zero, that is a bug */
96 struct buffer buffer_local_flags;
98 /* This structure holds the names of symbols whose values may be
99 buffer-local. It is indexed and accessed in the same way as the above. */
101 struct buffer buffer_local_symbols;
102 /* A Lisp_Object pointer to the above, used for staticpro */
103 static Lisp_Object Vbuffer_local_symbols;
105 /* This structure holds the required types for the values in the
106 buffer-local slots. If a slot contains Qnil, then the
107 corresponding buffer slot may contain a value of any type. If a
108 slot contains an integer, then prospective values' tags must be
109 equal to that integer (except nil is always allowed).
110 When a tag does not match, the function
111 buffer_slot_type_mismatch will signal an error.
113 If a slot here contains -1, the corresponding variable is read-only. */
114 struct buffer buffer_local_types;
116 /* Flags indicating which built-in buffer-local variables
117 are permanent locals. */
118 static char buffer_permanent_local_flags[MAX_PER_BUFFER_VARS];
120 /* Number of per-buffer variables used. */
122 int last_per_buffer_idx;
124 Lisp_Object Fset_buffer ();
125 void set_buffer_internal ();
126 void set_buffer_internal_1 ();
127 static void call_overlay_mod_hooks ();
128 static void swap_out_buffer_local_variables ();
129 static void reset_buffer_local_variables ();
131 /* Alist of all buffer names vs the buffers. */
132 /* This used to be a variable, but is no longer,
133 to prevent lossage due to user rplac'ing this alist or its elements. */
134 Lisp_Object Vbuffer_alist;
136 /* Functions to call before and after each text change. */
137 Lisp_Object Vbefore_change_functions;
138 Lisp_Object Vafter_change_functions;
140 Lisp_Object Vtransient_mark_mode;
142 /* t means ignore all read-only text properties.
143 A list means ignore such a property if its value is a member of the list.
144 Any non-nil value means ignore buffer-read-only. */
145 Lisp_Object Vinhibit_read_only;
147 /* List of functions to call that can query about killing a buffer.
148 If any of these functions returns nil, we don't kill it. */
149 Lisp_Object Vkill_buffer_query_functions;
151 /* List of functions to call before changing an unmodified buffer. */
152 Lisp_Object Vfirst_change_hook;
154 Lisp_Object Qfirst_change_hook;
155 Lisp_Object Qbefore_change_functions;
156 Lisp_Object Qafter_change_functions;
158 /* If nonzero, all modification hooks are suppressed. */
159 int inhibit_modification_hooks;
161 Lisp_Object Qfundamental_mode, Qmode_class, Qpermanent_local;
163 Lisp_Object Qprotected_field;
165 Lisp_Object QSFundamental; /* A string "Fundamental" */
167 Lisp_Object Qkill_buffer_hook;
169 Lisp_Object Qget_file_buffer;
171 Lisp_Object Qoverlayp;
173 Lisp_Object Qpriority, Qwindow, Qevaporate, Qbefore_string, Qafter_string;
175 Lisp_Object Qmodification_hooks;
176 Lisp_Object Qinsert_in_front_hooks;
177 Lisp_Object Qinsert_behind_hooks;
179 /* For debugging; temporary. See set_buffer_internal. */
180 /* Lisp_Object Qlisp_mode, Vcheck_symbol; */
182 void
183 nsberror (spec)
184 Lisp_Object spec;
186 if (STRINGP (spec))
187 error ("No buffer named %s", XSTRING (spec)->data);
188 error ("Invalid buffer argument");
191 DEFUN ("buffer-live-p", Fbuffer_live_p, Sbuffer_live_p, 1, 1, 0,
192 "Return non-nil if OBJECT is a buffer which has not been killed.\n\
193 Value is nil if OBJECT is not a buffer or if it has been killed.")
194 (object)
195 Lisp_Object object;
197 return ((BUFFERP (object) && ! NILP (XBUFFER (object)->name))
198 ? Qt : Qnil);
201 DEFUN ("buffer-list", Fbuffer_list, Sbuffer_list, 0, 1, 0,
202 "Return a list of all existing live buffers.\n\
203 If the optional arg FRAME is a frame, we return that frame's buffer list.")
204 (frame)
205 Lisp_Object frame;
207 Lisp_Object framelist, general;
208 general = Fmapcar (Qcdr, Vbuffer_alist);
210 if (FRAMEP (frame))
212 Lisp_Object tail;
214 CHECK_FRAME (frame, 1);
216 framelist = Fcopy_sequence (XFRAME (frame)->buffer_list);
218 /* Remove from GENERAL any buffer that duplicates one in FRAMELIST. */
219 tail = framelist;
220 while (! NILP (tail))
222 general = Fdelq (XCAR (tail), general);
223 tail = XCDR (tail);
225 return nconc2 (framelist, general);
228 return general;
231 /* Like Fassoc, but use Fstring_equal to compare
232 (which ignores text properties),
233 and don't ever QUIT. */
235 static Lisp_Object
236 assoc_ignore_text_properties (key, list)
237 register Lisp_Object key;
238 Lisp_Object list;
240 register Lisp_Object tail;
241 for (tail = list; !NILP (tail); tail = Fcdr (tail))
243 register Lisp_Object elt, tem;
244 elt = Fcar (tail);
245 tem = Fstring_equal (Fcar (elt), key);
246 if (!NILP (tem))
247 return elt;
249 return Qnil;
252 DEFUN ("get-buffer", Fget_buffer, Sget_buffer, 1, 1, 0,
253 "Return the buffer named NAME (a string).\n\
254 If there is no live buffer named NAME, return nil.\n\
255 NAME may also be a buffer; if so, the value is that buffer.")
256 (name)
257 register Lisp_Object name;
259 if (BUFFERP (name))
260 return name;
261 CHECK_STRING (name, 0);
263 return Fcdr (assoc_ignore_text_properties (name, Vbuffer_alist));
266 DEFUN ("get-file-buffer", Fget_file_buffer, Sget_file_buffer, 1, 1, 0,
267 "Return the buffer visiting file FILENAME (a string).\n\
268 The buffer's `buffer-file-name' must match exactly the expansion of FILENAME.\n\
269 If there is no such live buffer, return nil.\n\
270 See also `find-buffer-visiting'.")
271 (filename)
272 register Lisp_Object filename;
274 register Lisp_Object tail, buf, tem;
275 Lisp_Object handler;
277 CHECK_STRING (filename, 0);
278 filename = Fexpand_file_name (filename, Qnil);
280 /* If the file name has special constructs in it,
281 call the corresponding file handler. */
282 handler = Ffind_file_name_handler (filename, Qget_file_buffer);
283 if (!NILP (handler))
284 return call2 (handler, Qget_file_buffer, filename);
286 for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
288 buf = Fcdr (XCAR (tail));
289 if (!BUFFERP (buf)) continue;
290 if (!STRINGP (XBUFFER (buf)->filename)) continue;
291 tem = Fstring_equal (XBUFFER (buf)->filename, filename);
292 if (!NILP (tem))
293 return buf;
295 return Qnil;
298 Lisp_Object
299 get_truename_buffer (filename)
300 register Lisp_Object filename;
302 register Lisp_Object tail, buf, tem;
304 for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
306 buf = Fcdr (XCAR (tail));
307 if (!BUFFERP (buf)) continue;
308 if (!STRINGP (XBUFFER (buf)->file_truename)) continue;
309 tem = Fstring_equal (XBUFFER (buf)->file_truename, filename);
310 if (!NILP (tem))
311 return buf;
313 return Qnil;
316 /* Incremented for each buffer created, to assign the buffer number. */
317 int buffer_count;
319 DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 1, 0,
320 "Return the buffer named NAME, or create such a buffer and return it.\n\
321 A new buffer is created if there is no live buffer named NAME.\n\
322 If NAME starts with a space, the new buffer does not keep undo information.\n\
323 If NAME is a buffer instead of a string, then it is the value returned.\n\
324 The value is never nil.")
325 (name)
326 register Lisp_Object name;
328 register Lisp_Object buf;
329 register struct buffer *b;
331 buf = Fget_buffer (name);
332 if (!NILP (buf))
333 return buf;
335 if (XSTRING (name)->size == 0)
336 error ("Empty string for buffer name is not allowed");
338 b = (struct buffer *) allocate_buffer ();
340 b->size = sizeof (struct buffer) / sizeof (EMACS_INT);
342 /* An ordinary buffer uses its own struct buffer_text. */
343 b->text = &b->own_text;
344 b->base_buffer = 0;
346 BUF_GAP_SIZE (b) = 20;
347 BLOCK_INPUT;
348 /* We allocate extra 1-byte at the tail and keep it always '\0' for
349 anchoring a search. */
350 BUFFER_ALLOC (BUF_BEG_ADDR (b), (BUF_GAP_SIZE (b) + 1));
351 UNBLOCK_INPUT;
352 if (! BUF_BEG_ADDR (b))
353 buffer_memory_full ();
355 BUF_PT (b) = 1;
356 BUF_GPT (b) = 1;
357 BUF_BEGV (b) = 1;
358 BUF_ZV (b) = 1;
359 BUF_Z (b) = 1;
360 BUF_PT_BYTE (b) = 1;
361 BUF_GPT_BYTE (b) = 1;
362 BUF_BEGV_BYTE (b) = 1;
363 BUF_ZV_BYTE (b) = 1;
364 BUF_Z_BYTE (b) = 1;
365 BUF_MODIFF (b) = 1;
366 BUF_OVERLAY_MODIFF (b) = 1;
367 BUF_SAVE_MODIFF (b) = 1;
368 BUF_INTERVALS (b) = 0;
369 BUF_UNCHANGED_MODIFIED (b) = 1;
370 BUF_OVERLAY_UNCHANGED_MODIFIED (b) = 1;
371 BUF_END_UNCHANGED (b) = 0;
372 BUF_BEG_UNCHANGED (b) = 0;
373 *(BUF_GPT_ADDR (b)) = *(BUF_Z_ADDR (b)) = 0; /* Put an anchor '\0'. */
375 b->newline_cache = 0;
376 b->width_run_cache = 0;
377 b->width_table = Qnil;
378 b->prevent_redisplay_optimizations_p = 1;
380 /* Put this on the chain of all buffers including killed ones. */
381 b->next = all_buffers;
382 all_buffers = b;
384 /* An ordinary buffer normally doesn't need markers
385 to handle BEGV and ZV. */
386 b->pt_marker = Qnil;
387 b->begv_marker = Qnil;
388 b->zv_marker = Qnil;
390 name = Fcopy_sequence (name);
391 XSTRING (name)->intervals = NULL_INTERVAL;
392 b->name = name;
394 if (XSTRING (name)->data[0] != ' ')
395 b->undo_list = Qnil;
396 else
397 b->undo_list = Qt;
399 reset_buffer (b);
400 reset_buffer_local_variables (b, 1);
402 /* Put this in the alist of all live buffers. */
403 XSETBUFFER (buf, b);
404 Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));
406 b->mark = Fmake_marker ();
407 BUF_MARKERS (b) = Qnil;
408 b->name = name;
409 return buf;
413 /* Clone per-buffer values of buffer FROM.
415 Buffer TO gets the same per-buffer values as FROM, with the
416 following exceptions: (1) TO's name is left untouched, (2) markers
417 are copied and made to refer to TO, and (3) overlay lists are
418 copied. */
420 static void
421 clone_per_buffer_values (from, to)
422 struct buffer *from, *to;
424 Lisp_Object to_buffer;
425 int offset;
427 XSETBUFFER (to_buffer, to);
429 for (offset = PER_BUFFER_VAR_OFFSET (name) + sizeof (Lisp_Object);
430 offset < sizeof *to;
431 offset += sizeof (Lisp_Object))
433 Lisp_Object obj;
435 obj = PER_BUFFER_VALUE (from, offset);
436 if (MARKERP (obj))
438 struct Lisp_Marker *m = XMARKER (obj);
439 obj = Fmake_marker ();
440 XMARKER (obj)->insertion_type = m->insertion_type;
441 set_marker_both (obj, to_buffer, m->charpos, m->bytepos);
444 PER_BUFFER_VALUE (to, offset) = obj;
447 to->overlays_after = Fcopy_sequence (from->overlays_after);
448 to->overlays_before = Fcopy_sequence (to->overlays_before);
449 bcopy (from->local_flags, to->local_flags, sizeof to->local_flags);
453 DEFUN ("make-indirect-buffer", Fmake_indirect_buffer, Smake_indirect_buffer,
454 2, 3,
455 "bMake indirect buffer (to buffer): \nBName of indirect buffer: ",
456 "Create and return an indirect buffer for buffer BASE-BUFFER, named NAME.\n\
457 BASE-BUFFER should be an existing buffer (or buffer name).\n\
458 NAME should be a string which is not the name of an existing buffer.\n\
459 Optional argument CLONE non-nil means preserve BASE-BUFFER's state,\n\
460 such as major and minor modes, in the indirect buffer.\n\
461 CLONE nil means the indirect buffer's state is reset to default values.")
462 (base_buffer, name, clone)
463 Lisp_Object base_buffer, name, clone;
465 Lisp_Object buf;
466 struct buffer *b;
468 buf = Fget_buffer (name);
469 if (!NILP (buf))
470 error ("Buffer name `%s' is in use", XSTRING (name)->data);
472 base_buffer = Fget_buffer (base_buffer);
473 if (NILP (base_buffer))
474 error ("No such buffer: `%s'",
475 XSTRING (XBUFFER (base_buffer)->name)->data);
477 if (XSTRING (name)->size == 0)
478 error ("Empty string for buffer name is not allowed");
480 b = (struct buffer *) allocate_buffer ();
481 b->size = sizeof (struct buffer) / sizeof (EMACS_INT);
483 if (XBUFFER (base_buffer)->base_buffer)
484 b->base_buffer = XBUFFER (base_buffer)->base_buffer;
485 else
486 b->base_buffer = XBUFFER (base_buffer);
488 /* Use the base buffer's text object. */
489 b->text = b->base_buffer->text;
491 BUF_BEGV (b) = BUF_BEGV (b->base_buffer);
492 BUF_ZV (b) = BUF_ZV (b->base_buffer);
493 BUF_PT (b) = BUF_PT (b->base_buffer);
494 BUF_BEGV_BYTE (b) = BUF_BEGV_BYTE (b->base_buffer);
495 BUF_ZV_BYTE (b) = BUF_ZV_BYTE (b->base_buffer);
496 BUF_PT_BYTE (b) = BUF_PT_BYTE (b->base_buffer);
498 b->newline_cache = 0;
499 b->width_run_cache = 0;
500 b->width_table = Qnil;
502 /* Put this on the chain of all buffers including killed ones. */
503 b->next = all_buffers;
504 all_buffers = b;
506 name = Fcopy_sequence (name);
507 XSTRING (name)->intervals = NULL_INTERVAL;
508 b->name = name;
510 reset_buffer (b);
511 reset_buffer_local_variables (b, 1);
513 /* Put this in the alist of all live buffers. */
514 XSETBUFFER (buf, b);
515 Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));
517 b->mark = Fmake_marker ();
518 b->name = name;
520 /* The multibyte status belongs to the base buffer. */
521 b->enable_multibyte_characters = b->base_buffer->enable_multibyte_characters;
523 /* Make sure the base buffer has markers for its narrowing. */
524 if (NILP (b->base_buffer->pt_marker))
526 b->base_buffer->pt_marker = Fmake_marker ();
527 set_marker_both (b->base_buffer->pt_marker, base_buffer,
528 BUF_PT (b->base_buffer),
529 BUF_PT_BYTE (b->base_buffer));
531 if (NILP (b->base_buffer->begv_marker))
533 b->base_buffer->begv_marker = Fmake_marker ();
534 set_marker_both (b->base_buffer->begv_marker, base_buffer,
535 BUF_BEGV (b->base_buffer),
536 BUF_BEGV_BYTE (b->base_buffer));
538 if (NILP (b->base_buffer->zv_marker))
540 b->base_buffer->zv_marker = Fmake_marker ();
541 set_marker_both (b->base_buffer->zv_marker, base_buffer,
542 BUF_ZV (b->base_buffer),
543 BUF_ZV_BYTE (b->base_buffer));
544 XMARKER (b->base_buffer->zv_marker)->insertion_type = 1;
547 if (NILP (clone))
549 /* Give the indirect buffer markers for its narrowing. */
550 b->pt_marker = Fmake_marker ();
551 set_marker_both (b->pt_marker, buf, BUF_PT (b), BUF_PT_BYTE (b));
552 b->begv_marker = Fmake_marker ();
553 set_marker_both (b->begv_marker, buf, BUF_BEGV (b), BUF_BEGV_BYTE (b));
554 b->zv_marker = Fmake_marker ();
555 set_marker_both (b->zv_marker, buf, BUF_ZV (b), BUF_ZV_BYTE (b));
556 XMARKER (b->zv_marker)->insertion_type = 1;
558 else
559 clone_per_buffer_values (b->base_buffer, b);
561 return buf;
564 /* Reinitialize everything about a buffer except its name and contents
565 and local variables. */
567 void
568 reset_buffer (b)
569 register struct buffer *b;
571 b->filename = Qnil;
572 b->file_truename = Qnil;
573 b->directory = (current_buffer) ? current_buffer->directory : Qnil;
574 b->modtime = 0;
575 XSETFASTINT (b->save_length, 0);
576 b->last_window_start = 1;
577 /* It is more conservative to start out "changed" than "unchanged". */
578 b->clip_changed = 0;
579 b->prevent_redisplay_optimizations_p = 1;
580 b->backed_up = Qnil;
581 b->auto_save_modified = 0;
582 b->auto_save_failure_time = -1;
583 b->auto_save_file_name = Qnil;
584 b->read_only = Qnil;
585 b->overlays_before = Qnil;
586 b->overlays_after = Qnil;
587 XSETFASTINT (b->overlay_center, 1);
588 b->mark_active = Qnil;
589 b->point_before_scroll = Qnil;
590 b->file_format = Qnil;
591 b->last_selected_window = Qnil;
592 XSETINT (b->display_count, 0);
593 b->display_time = Qnil;
594 b->enable_multibyte_characters = buffer_defaults.enable_multibyte_characters;
595 b->cursor_type = buffer_defaults.cursor_type;
596 b->extra_line_spacing = buffer_defaults.extra_line_spacing;
599 /* Reset buffer B's local variables info.
600 Don't use this on a buffer that has already been in use;
601 it does not treat permanent locals consistently.
602 Instead, use Fkill_all_local_variables.
604 If PERMANENT_TOO is 1, then we reset permanent built-in
605 buffer-local variables. If PERMANENT_TOO is 0,
606 we preserve those. */
608 static void
609 reset_buffer_local_variables (b, permanent_too)
610 register struct buffer *b;
611 int permanent_too;
613 register int offset;
614 int i;
616 /* Reset the major mode to Fundamental, together with all the
617 things that depend on the major mode.
618 default-major-mode is handled at a higher level.
619 We ignore it here. */
620 b->major_mode = Qfundamental_mode;
621 b->keymap = Qnil;
622 b->abbrev_table = Vfundamental_mode_abbrev_table;
623 b->mode_name = QSFundamental;
624 b->minor_modes = Qnil;
626 /* If the standard case table has been altered and invalidated,
627 fix up its insides first. */
628 if (! (CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[0])
629 && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[1])
630 && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[2])))
631 Fset_standard_case_table (Vascii_downcase_table);
633 b->downcase_table = Vascii_downcase_table;
634 b->upcase_table = XCHAR_TABLE (Vascii_downcase_table)->extras[0];
635 b->case_canon_table = XCHAR_TABLE (Vascii_downcase_table)->extras[1];
636 b->case_eqv_table = XCHAR_TABLE (Vascii_downcase_table)->extras[2];
637 b->invisibility_spec = Qt;
638 #ifndef DOS_NT
639 b->buffer_file_type = Qnil;
640 #endif
642 #if 0
643 b->sort_table = XSTRING (Vascii_sort_table);
644 b->folding_sort_table = XSTRING (Vascii_folding_sort_table);
645 #endif /* 0 */
647 /* Reset all (or most) per-buffer variables to their defaults. */
648 b->local_var_alist = Qnil;
649 for (i = 0; i < last_per_buffer_idx; ++i)
650 if (permanent_too || buffer_permanent_local_flags[i] == 0)
651 SET_PER_BUFFER_VALUE_P (b, i, 0);
653 /* For each slot that has a default value,
654 copy that into the slot. */
656 for (offset = PER_BUFFER_VAR_OFFSET (name);
657 offset < sizeof *b;
658 offset += sizeof (Lisp_Object))
660 int idx = PER_BUFFER_IDX (offset);
661 if ((idx > 0
662 && (permanent_too
663 || buffer_permanent_local_flags[idx] == 0))
664 /* Is -2 used anywhere? */
665 || idx == -2)
666 PER_BUFFER_VALUE (b, offset) = PER_BUFFER_DEFAULT (offset);
670 /* We split this away from generate-new-buffer, because rename-buffer
671 and set-visited-file-name ought to be able to use this to really
672 rename the buffer properly. */
674 DEFUN ("generate-new-buffer-name", Fgenerate_new_buffer_name, Sgenerate_new_buffer_name,
675 1, 2, 0,
676 "Return a string that is the name of no existing buffer based on NAME.\n\
677 If there is no live buffer named NAME, then return NAME.\n\
678 Otherwise modify name by appending `<NUMBER>', incrementing NUMBER\n\
679 until an unused name is found, and then return that name.\n\
680 Optional second argument IGNORE specifies a name that is okay to use\n\
681 \(if it is in the sequence to be tried)\n\
682 even if a buffer with that name exists.")
683 (name, ignore)
684 register Lisp_Object name, ignore;
686 register Lisp_Object gentemp, tem;
687 int count;
688 char number[10];
690 CHECK_STRING (name, 0);
692 tem = Fget_buffer (name);
693 if (NILP (tem))
694 return name;
696 count = 1;
697 while (1)
699 sprintf (number, "<%d>", ++count);
700 gentemp = concat2 (name, build_string (number));
701 tem = Fstring_equal (gentemp, ignore);
702 if (!NILP (tem))
703 return gentemp;
704 tem = Fget_buffer (gentemp);
705 if (NILP (tem))
706 return gentemp;
711 DEFUN ("buffer-name", Fbuffer_name, Sbuffer_name, 0, 1, 0,
712 "Return the name of BUFFER, as a string.\n\
713 With no argument or nil as argument, return the name of the current buffer.")
714 (buffer)
715 register Lisp_Object buffer;
717 if (NILP (buffer))
718 return current_buffer->name;
719 CHECK_BUFFER (buffer, 0);
720 return XBUFFER (buffer)->name;
723 DEFUN ("buffer-file-name", Fbuffer_file_name, Sbuffer_file_name, 0, 1, 0,
724 "Return name of file BUFFER is visiting, or nil if none.\n\
725 No argument or nil as argument means use the current buffer.")
726 (buffer)
727 register Lisp_Object buffer;
729 if (NILP (buffer))
730 return current_buffer->filename;
731 CHECK_BUFFER (buffer, 0);
732 return XBUFFER (buffer)->filename;
735 DEFUN ("buffer-base-buffer", Fbuffer_base_buffer, Sbuffer_base_buffer,
736 0, 1, 0,
737 "Return the base buffer of indirect buffer BUFFER.\n\
738 If BUFFER is not indirect, return nil.")
739 (buffer)
740 register Lisp_Object buffer;
742 struct buffer *base;
743 Lisp_Object base_buffer;
745 if (NILP (buffer))
746 base = current_buffer->base_buffer;
747 else
749 CHECK_BUFFER (buffer, 0);
750 base = XBUFFER (buffer)->base_buffer;
753 if (! base)
754 return Qnil;
755 XSETBUFFER (base_buffer, base);
756 return base_buffer;
759 DEFUN ("buffer-local-variables", Fbuffer_local_variables,
760 Sbuffer_local_variables, 0, 1, 0,
761 "Return an alist of variables that are buffer-local in BUFFER.\n\
762 Most elements look like (SYMBOL . VALUE), describing one variable.\n\
763 For a symbol that is locally unbound, just the symbol appears in the value.\n\
764 Note that storing new VALUEs in these elements doesn't change the variables.\n\
765 No argument or nil as argument means use current buffer as BUFFER.")
766 (buffer)
767 register Lisp_Object buffer;
769 register struct buffer *buf;
770 register Lisp_Object result;
772 if (NILP (buffer))
773 buf = current_buffer;
774 else
776 CHECK_BUFFER (buffer, 0);
777 buf = XBUFFER (buffer);
780 result = Qnil;
783 register Lisp_Object tail;
784 for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail))
786 Lisp_Object val, elt;
788 elt = XCAR (tail);
790 /* Reference each variable in the alist in buf.
791 If inquiring about the current buffer, this gets the current values,
792 so store them into the alist so the alist is up to date.
793 If inquiring about some other buffer, this swaps out any values
794 for that buffer, making the alist up to date automatically. */
795 val = find_symbol_value (XCAR (elt));
796 /* Use the current buffer value only if buf is the current buffer. */
797 if (buf != current_buffer)
798 val = XCDR (elt);
800 /* If symbol is unbound, put just the symbol in the list. */
801 if (EQ (val, Qunbound))
802 result = Fcons (XCAR (elt), result);
803 /* Otherwise, put (symbol . value) in the list. */
804 else
805 result = Fcons (Fcons (XCAR (elt), val), result);
809 /* Add on all the variables stored in special slots. */
811 int offset, idx;
813 for (offset = PER_BUFFER_VAR_OFFSET (name);
814 offset < sizeof (struct buffer);
815 /* sizeof EMACS_INT == sizeof Lisp_Object */
816 offset += (sizeof (EMACS_INT)))
818 idx = PER_BUFFER_IDX (offset);
819 if ((idx == -1 || PER_BUFFER_VALUE_P (buf, idx))
820 && SYMBOLP (PER_BUFFER_SYMBOL (offset)))
821 result = Fcons (Fcons (PER_BUFFER_SYMBOL (offset),
822 PER_BUFFER_VALUE (buf, offset)),
823 result);
827 return result;
831 DEFUN ("buffer-modified-p", Fbuffer_modified_p, Sbuffer_modified_p,
832 0, 1, 0,
833 "Return t if BUFFER was modified since its file was last read or saved.\n\
834 No argument or nil as argument means use current buffer as BUFFER.")
835 (buffer)
836 register Lisp_Object buffer;
838 register struct buffer *buf;
839 if (NILP (buffer))
840 buf = current_buffer;
841 else
843 CHECK_BUFFER (buffer, 0);
844 buf = XBUFFER (buffer);
847 return BUF_SAVE_MODIFF (buf) < BUF_MODIFF (buf) ? Qt : Qnil;
850 DEFUN ("set-buffer-modified-p", Fset_buffer_modified_p, Sset_buffer_modified_p,
851 1, 1, 0,
852 "Mark current buffer as modified or unmodified according to FLAG.\n\
853 A non-nil FLAG means mark the buffer modified.")
854 (flag)
855 register Lisp_Object flag;
857 register int already;
858 register Lisp_Object fn;
859 Lisp_Object buffer, window;
861 #ifdef CLASH_DETECTION
862 /* If buffer becoming modified, lock the file.
863 If buffer becoming unmodified, unlock the file. */
865 fn = current_buffer->file_truename;
866 /* Test buffer-file-name so that binding it to nil is effective. */
867 if (!NILP (fn) && ! NILP (current_buffer->filename))
869 already = SAVE_MODIFF < MODIFF;
870 if (!already && !NILP (flag))
871 lock_file (fn);
872 else if (already && NILP (flag))
873 unlock_file (fn);
875 #endif /* CLASH_DETECTION */
877 SAVE_MODIFF = NILP (flag) ? MODIFF : 0;
879 /* Set update_mode_lines only if buffer is displayed in some window.
880 Packages like jit-lock or lazy-lock preserve a buffer's modified
881 state by recording/restoring the state around blocks of code.
882 Setting update_mode_lines makes redisplay consider all windows
883 (on all frames). Stealth fontification of buffers not displayed
884 would incur additional redisplay costs if we'd set
885 update_modes_lines unconditionally.
887 Ideally, I think there should be another mechanism for fontifying
888 buffers without "modifying" buffers, or redisplay should be
889 smarter about updating the `*' in mode lines. --gerd */
890 XSETBUFFER (buffer, current_buffer);
891 window = Fget_buffer_window (buffer, Qt);
892 if (WINDOWP (window))
893 update_mode_lines++;
895 return flag;
898 DEFUN ("restore-buffer-modified-p", Frestore_buffer_modified_p,
899 Srestore_buffer_modified_p, 1, 1, 0,
900 "Like `set-buffer-modified-p', with a differences concerning redisplay.\n\
901 It is not ensured that mode lines will be updated to show the modified\n\
902 state of the current buffer. Use with care.")
903 (flag)
904 Lisp_Object flag;
906 #ifdef CLASH_DETECTION
907 Lisp_Object fn;
909 /* If buffer becoming modified, lock the file.
910 If buffer becoming unmodified, unlock the file. */
912 fn = current_buffer->file_truename;
913 /* Test buffer-file-name so that binding it to nil is effective. */
914 if (!NILP (fn) && ! NILP (current_buffer->filename))
916 int already = SAVE_MODIFF < MODIFF;
917 if (!already && !NILP (flag))
918 lock_file (fn);
919 else if (already && NILP (flag))
920 unlock_file (fn);
922 #endif /* CLASH_DETECTION */
924 SAVE_MODIFF = NILP (flag) ? MODIFF : 0;
925 return flag;
928 DEFUN ("buffer-modified-tick", Fbuffer_modified_tick, Sbuffer_modified_tick,
929 0, 1, 0,
930 "Return BUFFER's tick counter, incremented for each change in text.\n\
931 Each buffer has a tick counter which is incremented each time the text in\n\
932 that buffer is changed. It wraps around occasionally.\n\
933 No argument or nil as argument means use current buffer as BUFFER.")
934 (buffer)
935 register Lisp_Object buffer;
937 register struct buffer *buf;
938 if (NILP (buffer))
939 buf = current_buffer;
940 else
942 CHECK_BUFFER (buffer, 0);
943 buf = XBUFFER (buffer);
946 return make_number (BUF_MODIFF (buf));
949 DEFUN ("rename-buffer", Frename_buffer, Srename_buffer, 1, 2,
950 "sRename buffer (to new name): \nP",
951 "Change current buffer's name to NEWNAME (a string).\n\
952 If second arg UNIQUE is nil or omitted, it is an error if a\n\
953 buffer named NEWNAME already exists.\n\
954 If UNIQUE is non-nil, come up with a new name using\n\
955 `generate-new-buffer-name'.\n\
956 Interactively, you can set UNIQUE with a prefix argument.\n\
957 We return the name we actually gave the buffer.\n\
958 This does not change the name of the visited file (if any).")
959 (newname, unique)
960 register Lisp_Object newname, unique;
962 register Lisp_Object tem, buf;
964 CHECK_STRING (newname, 0);
966 if (XSTRING (newname)->size == 0)
967 error ("Empty string is invalid as a buffer name");
969 tem = Fget_buffer (newname);
970 if (!NILP (tem))
972 /* Don't short-circuit if UNIQUE is t. That is a useful way to
973 rename the buffer automatically so you can create another
974 with the original name. It makes UNIQUE equivalent to
975 (rename-buffer (generate-new-buffer-name NEWNAME)). */
976 if (NILP (unique) && XBUFFER (tem) == current_buffer)
977 return current_buffer->name;
978 if (!NILP (unique))
979 newname = Fgenerate_new_buffer_name (newname, current_buffer->name);
980 else
981 error ("Buffer name `%s' is in use", XSTRING (newname)->data);
984 current_buffer->name = newname;
986 /* Catch redisplay's attention. Unless we do this, the mode lines for
987 any windows displaying current_buffer will stay unchanged. */
988 update_mode_lines++;
990 XSETBUFFER (buf, current_buffer);
991 Fsetcar (Frassq (buf, Vbuffer_alist), newname);
992 if (NILP (current_buffer->filename)
993 && !NILP (current_buffer->auto_save_file_name))
994 call0 (intern ("rename-auto-save-file"));
995 /* Refetch since that last call may have done GC. */
996 return current_buffer->name;
999 DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 3, 0,
1000 "Return most recently selected buffer other than BUFFER.\n\
1001 Buffers not visible in windows are preferred to visible buffers,\n\
1002 unless optional second argument VISIBLE-OK is non-nil.\n\
1003 If the optional third argument FRAME is non-nil, use that frame's\n\
1004 buffer list instead of the selected frame's buffer list.\n\
1005 If no other buffer exists, the buffer `*scratch*' is returned.\n\
1006 If BUFFER is omitted or nil, some interesting buffer is returned.")
1007 (buffer, visible_ok, frame)
1008 register Lisp_Object buffer, visible_ok, frame;
1010 Lisp_Object Fset_buffer_major_mode ();
1011 register Lisp_Object tail, buf, notsogood, tem, pred, add_ons;
1012 notsogood = Qnil;
1014 if (NILP (frame))
1015 frame = selected_frame;
1017 tail = Vbuffer_alist;
1018 pred = frame_buffer_predicate (frame);
1020 /* Consider buffers that have been seen in the selected frame
1021 before other buffers. */
1023 tem = frame_buffer_list (frame);
1024 add_ons = Qnil;
1025 while (CONSP (tem))
1027 if (BUFFERP (XCAR (tem)))
1028 add_ons = Fcons (Fcons (Qnil, XCAR (tem)), add_ons);
1029 tem = XCDR (tem);
1031 tail = nconc2 (Fnreverse (add_ons), tail);
1033 for (; !NILP (tail); tail = Fcdr (tail))
1035 buf = Fcdr (Fcar (tail));
1036 if (EQ (buf, buffer))
1037 continue;
1038 if (XSTRING (XBUFFER (buf)->name)->data[0] == ' ')
1039 continue;
1040 /* If the selected frame has a buffer_predicate,
1041 disregard buffers that don't fit the predicate. */
1042 if (!NILP (pred))
1044 tem = call1 (pred, buf);
1045 if (NILP (tem))
1046 continue;
1049 if (NILP (visible_ok))
1050 tem = Fget_buffer_window (buf, Qt);
1051 else
1052 tem = Qnil;
1053 if (NILP (tem))
1054 return buf;
1055 if (NILP (notsogood))
1056 notsogood = buf;
1058 if (!NILP (notsogood))
1059 return notsogood;
1060 buf = Fget_buffer (build_string ("*scratch*"));
1061 if (NILP (buf))
1063 buf = Fget_buffer_create (build_string ("*scratch*"));
1064 Fset_buffer_major_mode (buf);
1066 return buf;
1069 DEFUN ("buffer-disable-undo", Fbuffer_disable_undo, Sbuffer_disable_undo,
1070 0, 1, "",
1071 "Make BUFFER stop keeping undo information.\n\
1072 No argument or nil as argument means do this for the current buffer.")
1073 (buffer)
1074 register Lisp_Object buffer;
1076 Lisp_Object real_buffer;
1078 if (NILP (buffer))
1079 XSETBUFFER (real_buffer, current_buffer);
1080 else
1082 real_buffer = Fget_buffer (buffer);
1083 if (NILP (real_buffer))
1084 nsberror (buffer);
1087 XBUFFER (real_buffer)->undo_list = Qt;
1089 return Qnil;
1092 DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, Sbuffer_enable_undo,
1093 0, 1, "",
1094 "Start keeping undo information for buffer BUFFER.\n\
1095 No argument or nil as argument means do this for the current buffer.")
1096 (buffer)
1097 register Lisp_Object buffer;
1099 Lisp_Object real_buffer;
1101 if (NILP (buffer))
1102 XSETBUFFER (real_buffer, current_buffer);
1103 else
1105 real_buffer = Fget_buffer (buffer);
1106 if (NILP (real_buffer))
1107 nsberror (buffer);
1110 if (EQ (XBUFFER (real_buffer)->undo_list, Qt))
1111 XBUFFER (real_buffer)->undo_list = Qnil;
1113 return Qnil;
1117 DEFVAR_LISP ("kill-buffer-hook", no_cell, "\
1118 Hook to be run (by `run-hooks', which see) when a buffer is killed.\n\
1119 The buffer being killed will be current while the hook is running.\n\
1120 See `kill-buffer'."
1122 DEFUN ("kill-buffer", Fkill_buffer, Skill_buffer, 1, 1, "bKill buffer: ",
1123 "Kill the buffer BUFFER.\n\
1124 The argument may be a buffer or may be the name of a buffer.\n\
1125 An argument of nil means kill the current buffer.\n\n\
1126 Value is t if the buffer is actually killed, nil if user says no.\n\n\
1127 The value of `kill-buffer-hook' (which may be local to that buffer),\n\
1128 if not void, is a list of functions to be called, with no arguments,\n\
1129 before the buffer is actually killed. The buffer to be killed is current\n\
1130 when the hook functions are called.\n\n\
1131 Any processes that have this buffer as the `process-buffer' are killed\n\
1132 with SIGHUP.")
1133 (buffer)
1134 Lisp_Object buffer;
1136 Lisp_Object buf;
1137 register struct buffer *b;
1138 register Lisp_Object tem;
1139 register struct Lisp_Marker *m;
1140 struct gcpro gcpro1;
1142 if (NILP (buffer))
1143 buf = Fcurrent_buffer ();
1144 else
1145 buf = Fget_buffer (buffer);
1146 if (NILP (buf))
1147 nsberror (buffer);
1149 b = XBUFFER (buf);
1151 /* Avoid trouble for buffer already dead. */
1152 if (NILP (b->name))
1153 return Qnil;
1155 /* Query if the buffer is still modified. */
1156 if (INTERACTIVE && !NILP (b->filename)
1157 && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b))
1159 GCPRO1 (buf);
1160 tem = do_yes_or_no_p (format1 ("Buffer %s modified; kill anyway? ",
1161 XSTRING (b->name)->data));
1162 UNGCPRO;
1163 if (NILP (tem))
1164 return Qnil;
1167 /* Run hooks with the buffer to be killed the current buffer. */
1169 int count = specpdl_ptr - specpdl;
1170 Lisp_Object list;
1172 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1173 set_buffer_internal (b);
1175 /* First run the query functions; if any query is answered no,
1176 don't kill the buffer. */
1177 for (list = Vkill_buffer_query_functions; !NILP (list); list = Fcdr (list))
1179 tem = call0 (Fcar (list));
1180 if (NILP (tem))
1181 return unbind_to (count, Qnil);
1184 /* Then run the hooks. */
1185 if (!NILP (Vrun_hooks))
1186 call1 (Vrun_hooks, Qkill_buffer_hook);
1187 unbind_to (count, Qnil);
1190 /* We have no more questions to ask. Verify that it is valid
1191 to kill the buffer. This must be done after the questions
1192 since anything can happen within do_yes_or_no_p. */
1194 /* Don't kill the minibuffer now current. */
1195 if (EQ (buf, XWINDOW (minibuf_window)->buffer))
1196 return Qnil;
1198 if (NILP (b->name))
1199 return Qnil;
1201 /* When we kill a base buffer, kill all its indirect buffers.
1202 We do it at this stage so nothing terrible happens if they
1203 ask questions or their hooks get errors. */
1204 if (! b->base_buffer)
1206 struct buffer *other;
1208 GCPRO1 (buf);
1210 for (other = all_buffers; other; other = other->next)
1211 /* all_buffers contains dead buffers too;
1212 don't re-kill them. */
1213 if (other->base_buffer == b && !NILP (other->name))
1215 Lisp_Object buf;
1216 XSETBUFFER (buf, other);
1217 Fkill_buffer (buf);
1220 UNGCPRO;
1223 /* Make this buffer not be current.
1224 In the process, notice if this is the sole visible buffer
1225 and give up if so. */
1226 if (b == current_buffer)
1228 tem = Fother_buffer (buf, Qnil, Qnil);
1229 Fset_buffer (tem);
1230 if (b == current_buffer)
1231 return Qnil;
1234 /* Now there is no question: we can kill the buffer. */
1236 #ifdef CLASH_DETECTION
1237 /* Unlock this buffer's file, if it is locked. */
1238 unlock_buffer (b);
1239 #endif /* CLASH_DETECTION */
1241 kill_buffer_processes (buf);
1243 tem = Vinhibit_quit;
1244 Vinhibit_quit = Qt;
1245 replace_buffer_in_all_windows (buf);
1246 Vbuffer_alist = Fdelq (Frassq (buf, Vbuffer_alist), Vbuffer_alist);
1247 frames_discard_buffer (buf);
1248 Vinhibit_quit = tem;
1250 /* Delete any auto-save file, if we saved it in this session. */
1251 if (STRINGP (b->auto_save_file_name)
1252 && b->auto_save_modified != 0
1253 && BUF_SAVE_MODIFF (b) < b->auto_save_modified)
1255 Lisp_Object tem;
1256 tem = Fsymbol_value (intern ("delete-auto-save-files"));
1257 if (! NILP (tem))
1258 internal_delete_file (b->auto_save_file_name);
1261 if (b->base_buffer)
1263 /* Unchain all markers that belong to this indirect buffer.
1264 Don't unchain the markers that belong to the base buffer
1265 or its other indirect buffers. */
1266 for (tem = BUF_MARKERS (b); !NILP (tem); )
1268 Lisp_Object next;
1269 m = XMARKER (tem);
1270 next = m->chain;
1271 if (m->buffer == b)
1272 unchain_marker (tem);
1273 tem = next;
1276 else
1278 /* Unchain all markers of this buffer and its indirect buffers.
1279 and leave them pointing nowhere. */
1280 for (tem = BUF_MARKERS (b); !NILP (tem); )
1282 m = XMARKER (tem);
1283 m->buffer = 0;
1284 tem = m->chain;
1285 m->chain = Qnil;
1287 BUF_MARKERS (b) = Qnil;
1288 BUF_INTERVALS (b) = NULL_INTERVAL;
1290 /* Perhaps we should explicitly free the interval tree here... */
1293 /* Reset the local variables, so that this buffer's local values
1294 won't be protected from GC. They would be protected
1295 if they happened to remain encached in their symbols.
1296 This gets rid of them for certain. */
1297 swap_out_buffer_local_variables (b);
1298 reset_buffer_local_variables (b, 1);
1300 b->name = Qnil;
1302 BLOCK_INPUT;
1303 if (! b->base_buffer)
1304 BUFFER_FREE (BUF_BEG_ADDR (b));
1306 if (b->newline_cache)
1308 free_region_cache (b->newline_cache);
1309 b->newline_cache = 0;
1311 if (b->width_run_cache)
1313 free_region_cache (b->width_run_cache);
1314 b->width_run_cache = 0;
1316 b->width_table = Qnil;
1317 UNBLOCK_INPUT;
1318 b->undo_list = Qnil;
1320 return Qt;
1323 /* Move the assoc for buffer BUF to the front of buffer-alist. Since
1324 we do this each time BUF is selected visibly, the more recently
1325 selected buffers are always closer to the front of the list. This
1326 means that other_buffer is more likely to choose a relevant buffer. */
1328 void
1329 record_buffer (buf)
1330 Lisp_Object buf;
1332 register Lisp_Object link, prev;
1333 Lisp_Object frame;
1334 frame = selected_frame;
1336 prev = Qnil;
1337 for (link = Vbuffer_alist; CONSP (link); link = XCDR (link))
1339 if (EQ (XCDR (XCAR (link)), buf))
1340 break;
1341 prev = link;
1344 /* Effectively do Vbuffer_alist = Fdelq (link, Vbuffer_alist);
1345 we cannot use Fdelq itself here because it allows quitting. */
1347 if (NILP (prev))
1348 Vbuffer_alist = XCDR (Vbuffer_alist);
1349 else
1350 XCDR (prev) = XCDR (XCDR (prev));
1352 XCDR (link) = Vbuffer_alist;
1353 Vbuffer_alist = link;
1355 /* Now move this buffer to the front of frame_buffer_list also. */
1357 prev = Qnil;
1358 for (link = frame_buffer_list (frame); CONSP (link);
1359 link = XCDR (link))
1361 if (EQ (XCAR (link), buf))
1362 break;
1363 prev = link;
1366 /* Effectively do delq. */
1368 if (CONSP (link))
1370 if (NILP (prev))
1371 set_frame_buffer_list (frame,
1372 XCDR (frame_buffer_list (frame)));
1373 else
1374 XCDR (prev) = XCDR (XCDR (prev));
1376 XCDR (link) = frame_buffer_list (frame);
1377 set_frame_buffer_list (frame, link);
1379 else
1380 set_frame_buffer_list (frame, Fcons (buf, frame_buffer_list (frame)));
1383 DEFUN ("set-buffer-major-mode", Fset_buffer_major_mode, Sset_buffer_major_mode, 1, 1, 0,
1384 "Set an appropriate major mode for BUFFER, according to `default-major-mode'.\n\
1385 Use this function before selecting the buffer, since it may need to inspect\n\
1386 the current buffer's major mode.")
1387 (buffer)
1388 Lisp_Object buffer;
1390 int count;
1391 Lisp_Object function;
1393 function = buffer_defaults.major_mode;
1394 if (NILP (function) && NILP (Fget (current_buffer->major_mode, Qmode_class)))
1395 function = current_buffer->major_mode;
1397 if (NILP (function) || EQ (function, Qfundamental_mode))
1398 return Qnil;
1400 count = specpdl_ptr - specpdl;
1402 /* To select a nonfundamental mode,
1403 select the buffer temporarily and then call the mode function. */
1405 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1407 Fset_buffer (buffer);
1408 call0 (function);
1410 return unbind_to (count, Qnil);
1413 /* If switching buffers in WINDOW would be an error, return
1414 a C string saying what the error would be. */
1416 char *
1417 no_switch_window (window)
1418 Lisp_Object window;
1420 Lisp_Object tem;
1421 if (EQ (minibuf_window, window))
1422 return "Cannot switch buffers in minibuffer window";
1423 tem = Fwindow_dedicated_p (window);
1424 if (!NILP (tem))
1425 return "Cannot switch buffers in a dedicated window";
1426 return NULL;
1429 /* Switch to buffer BUFFER in the selected window.
1430 If NORECORD is non-nil, don't call record_buffer. */
1432 Lisp_Object
1433 switch_to_buffer_1 (buffer, norecord)
1434 Lisp_Object buffer, norecord;
1436 register Lisp_Object buf;
1438 if (NILP (buffer))
1439 buf = Fother_buffer (Fcurrent_buffer (), Qnil, Qnil);
1440 else
1442 buf = Fget_buffer (buffer);
1443 if (NILP (buf))
1445 buf = Fget_buffer_create (buffer);
1446 Fset_buffer_major_mode (buf);
1449 Fset_buffer (buf);
1450 if (NILP (norecord))
1451 record_buffer (buf);
1453 Fset_window_buffer (EQ (selected_window, minibuf_window)
1454 ? Fnext_window (minibuf_window, Qnil, Qnil)
1455 : selected_window,
1456 buf);
1458 return buf;
1461 DEFUN ("switch-to-buffer", Fswitch_to_buffer, Sswitch_to_buffer, 1, 2, "BSwitch to buffer: ",
1462 "Select buffer BUFFER in the current window.\n\
1463 BUFFER may be a buffer or a buffer name.\n\
1464 Optional second arg NORECORD non-nil means\n\
1465 do not put this buffer at the front of the list of recently selected ones.\n\
1467 WARNING: This is NOT the way to work on another buffer temporarily\n\
1468 within a Lisp program! Use `set-buffer' instead. That avoids messing with\n\
1469 the window-buffer correspondences.")
1470 (buffer, norecord)
1471 Lisp_Object buffer, norecord;
1473 char *err;
1475 err = no_switch_window (selected_window);
1476 if (err) error (err);
1478 return switch_to_buffer_1 (buffer, norecord);
1481 DEFUN ("pop-to-buffer", Fpop_to_buffer, Spop_to_buffer, 1, 3, 0,
1482 "Select buffer BUFFER in some window, preferably a different one.\n\
1483 If BUFFER is nil, then some other buffer is chosen.\n\
1484 If `pop-up-windows' is non-nil, windows can be split to do this.\n\
1485 If optional second arg OTHER-WINDOW is non-nil, insist on finding another\n\
1486 window even if BUFFER is already visible in the selected window.\n\
1487 This uses the function `display-buffer' as a subroutine; see the documentation\n\
1488 of `display-buffer' for additional customization information.\n\
1490 Optional third arg NORECORD non-nil means\n\
1491 do not put this buffer at the front of the list of recently selected ones.")
1492 (buffer, other_window, norecord)
1493 Lisp_Object buffer, other_window, norecord;
1495 register Lisp_Object buf;
1496 if (NILP (buffer))
1497 buf = Fother_buffer (Fcurrent_buffer (), Qnil, Qnil);
1498 else
1500 buf = Fget_buffer (buffer);
1501 if (NILP (buf))
1503 buf = Fget_buffer_create (buffer);
1504 Fset_buffer_major_mode (buf);
1507 Fset_buffer (buf);
1508 if (NILP (norecord))
1509 record_buffer (buf);
1510 Fselect_window (Fdisplay_buffer (buf, other_window, Qnil));
1511 return buf;
1514 DEFUN ("current-buffer", Fcurrent_buffer, Scurrent_buffer, 0, 0, 0,
1515 "Return the current buffer as a Lisp object.")
1518 register Lisp_Object buf;
1519 XSETBUFFER (buf, current_buffer);
1520 return buf;
1523 /* Set the current buffer to B.
1525 We previously set windows_or_buffers_changed here to invalidate
1526 global unchanged information in beg_unchanged and end_unchanged.
1527 This is no longer necessary because we now compute unchanged
1528 information on a buffer-basis. Every action affecting other
1529 windows than the selected one requires a select_window at some
1530 time, and that increments windows_or_buffers_changed. */
1532 void
1533 set_buffer_internal (b)
1534 register struct buffer *b;
1536 if (current_buffer != b)
1537 set_buffer_internal_1 (b);
1540 /* Set the current buffer to B, and do not set windows_or_buffers_changed.
1541 This is used by redisplay. */
1543 void
1544 set_buffer_internal_1 (b)
1545 register struct buffer *b;
1547 register struct buffer *old_buf;
1548 register Lisp_Object tail, valcontents;
1549 Lisp_Object tem;
1551 if (current_buffer == b)
1552 return;
1554 old_buf = current_buffer;
1555 current_buffer = b;
1556 last_known_column_point = -1; /* invalidate indentation cache */
1558 if (old_buf)
1560 /* Put the undo list back in the base buffer, so that it appears
1561 that an indirect buffer shares the undo list of its base. */
1562 if (old_buf->base_buffer)
1563 old_buf->base_buffer->undo_list = old_buf->undo_list;
1565 /* If the old current buffer has markers to record PT, BEGV and ZV
1566 when it is not current, update them now. */
1567 if (! NILP (old_buf->pt_marker))
1569 Lisp_Object obuf;
1570 XSETBUFFER (obuf, old_buf);
1571 set_marker_both (old_buf->pt_marker, obuf,
1572 BUF_PT (old_buf), BUF_PT_BYTE (old_buf));
1574 if (! NILP (old_buf->begv_marker))
1576 Lisp_Object obuf;
1577 XSETBUFFER (obuf, old_buf);
1578 set_marker_both (old_buf->begv_marker, obuf,
1579 BUF_BEGV (old_buf), BUF_BEGV_BYTE (old_buf));
1581 if (! NILP (old_buf->zv_marker))
1583 Lisp_Object obuf;
1584 XSETBUFFER (obuf, old_buf);
1585 set_marker_both (old_buf->zv_marker, obuf,
1586 BUF_ZV (old_buf), BUF_ZV_BYTE (old_buf));
1590 /* Get the undo list from the base buffer, so that it appears
1591 that an indirect buffer shares the undo list of its base. */
1592 if (b->base_buffer)
1593 b->undo_list = b->base_buffer->undo_list;
1595 /* If the new current buffer has markers to record PT, BEGV and ZV
1596 when it is not current, fetch them now. */
1597 if (! NILP (b->pt_marker))
1599 BUF_PT (b) = marker_position (b->pt_marker);
1600 BUF_PT_BYTE (b) = marker_byte_position (b->pt_marker);
1602 if (! NILP (b->begv_marker))
1604 BUF_BEGV (b) = marker_position (b->begv_marker);
1605 BUF_BEGV_BYTE (b) = marker_byte_position (b->begv_marker);
1607 if (! NILP (b->zv_marker))
1609 BUF_ZV (b) = marker_position (b->zv_marker);
1610 BUF_ZV_BYTE (b) = marker_byte_position (b->zv_marker);
1613 /* Look down buffer's list of local Lisp variables
1614 to find and update any that forward into C variables. */
1616 for (tail = b->local_var_alist; !NILP (tail); tail = XCDR (tail))
1618 valcontents = XSYMBOL (XCAR (XCAR (tail)))->value;
1619 if ((BUFFER_LOCAL_VALUEP (valcontents)
1620 || SOME_BUFFER_LOCAL_VALUEP (valcontents))
1621 && (tem = XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
1622 (BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem))))
1623 /* Just reference the variable
1624 to cause it to become set for this buffer. */
1625 Fsymbol_value (XCAR (XCAR (tail)));
1628 /* Do the same with any others that were local to the previous buffer */
1630 if (old_buf)
1631 for (tail = old_buf->local_var_alist; !NILP (tail); tail = XCDR (tail))
1633 valcontents = XSYMBOL (XCAR (XCAR (tail)))->value;
1634 if ((BUFFER_LOCAL_VALUEP (valcontents)
1635 || SOME_BUFFER_LOCAL_VALUEP (valcontents))
1636 && (tem = XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
1637 (BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem))))
1638 /* Just reference the variable
1639 to cause it to become set for this buffer. */
1640 Fsymbol_value (XCAR (XCAR (tail)));
1644 /* Switch to buffer B temporarily for redisplay purposes.
1645 This avoids certain things that don't need to be done within redisplay. */
1647 void
1648 set_buffer_temp (b)
1649 struct buffer *b;
1651 register struct buffer *old_buf;
1653 if (current_buffer == b)
1654 return;
1656 old_buf = current_buffer;
1657 current_buffer = b;
1659 if (old_buf)
1661 /* If the old current buffer has markers to record PT, BEGV and ZV
1662 when it is not current, update them now. */
1663 if (! NILP (old_buf->pt_marker))
1665 Lisp_Object obuf;
1666 XSETBUFFER (obuf, old_buf);
1667 set_marker_both (old_buf->pt_marker, obuf,
1668 BUF_PT (old_buf), BUF_PT_BYTE (old_buf));
1670 if (! NILP (old_buf->begv_marker))
1672 Lisp_Object obuf;
1673 XSETBUFFER (obuf, old_buf);
1674 set_marker_both (old_buf->begv_marker, obuf,
1675 BUF_BEGV (old_buf), BUF_BEGV_BYTE (old_buf));
1677 if (! NILP (old_buf->zv_marker))
1679 Lisp_Object obuf;
1680 XSETBUFFER (obuf, old_buf);
1681 set_marker_both (old_buf->zv_marker, obuf,
1682 BUF_ZV (old_buf), BUF_ZV_BYTE (old_buf));
1686 /* If the new current buffer has markers to record PT, BEGV and ZV
1687 when it is not current, fetch them now. */
1688 if (! NILP (b->pt_marker))
1690 BUF_PT (b) = marker_position (b->pt_marker);
1691 BUF_PT_BYTE (b) = marker_byte_position (b->pt_marker);
1693 if (! NILP (b->begv_marker))
1695 BUF_BEGV (b) = marker_position (b->begv_marker);
1696 BUF_BEGV_BYTE (b) = marker_byte_position (b->begv_marker);
1698 if (! NILP (b->zv_marker))
1700 BUF_ZV (b) = marker_position (b->zv_marker);
1701 BUF_ZV_BYTE (b) = marker_byte_position (b->zv_marker);
1705 DEFUN ("set-buffer", Fset_buffer, Sset_buffer, 1, 1, 0,
1706 "Make the buffer BUFFER current for editing operations.\n\
1707 BUFFER may be a buffer or the name of an existing buffer.\n\
1708 See also `save-excursion' when you want to make a buffer current temporarily.\n\
1709 This function does not display the buffer, so its effect ends\n\
1710 when the current command terminates.\n\
1711 Use `switch-to-buffer' or `pop-to-buffer' to switch buffers permanently.")
1712 (buffer)
1713 register Lisp_Object buffer;
1715 register Lisp_Object buf;
1716 buf = Fget_buffer (buffer);
1717 if (NILP (buf))
1718 nsberror (buffer);
1719 if (NILP (XBUFFER (buf)->name))
1720 error ("Selecting deleted buffer");
1721 set_buffer_internal (XBUFFER (buf));
1722 return buf;
1725 /* Set the current buffer to BUFFER provided it is alive. */
1727 Lisp_Object
1728 set_buffer_if_live (buffer)
1729 Lisp_Object buffer;
1731 if (! NILP (XBUFFER (buffer)->name))
1732 Fset_buffer (buffer);
1733 return Qnil;
1736 DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only,
1737 Sbarf_if_buffer_read_only, 0, 0, 0,
1738 "Signal a `buffer-read-only' error if the current buffer is read-only.")
1741 if (!NILP (current_buffer->read_only)
1742 && NILP (Vinhibit_read_only))
1743 Fsignal (Qbuffer_read_only, (Fcons (Fcurrent_buffer (), Qnil)));
1744 return Qnil;
1747 DEFUN ("bury-buffer", Fbury_buffer, Sbury_buffer, 0, 1, "",
1748 "Put BUFFER at the end of the list of all buffers.\n\
1749 There it is the least likely candidate for `other-buffer' to return;\n\
1750 thus, the least likely buffer for \\[switch-to-buffer] to select by default.\n\
1751 If BUFFER is nil or omitted, bury the current buffer.\n\
1752 Also, if BUFFER is nil or omitted, remove the current buffer from the\n\
1753 selected window if it is displayed there.")
1754 (buffer)
1755 register Lisp_Object buffer;
1757 /* Figure out what buffer we're going to bury. */
1758 if (NILP (buffer))
1760 XSETBUFFER (buffer, current_buffer);
1762 /* If we're burying the current buffer, unshow it. */
1763 Fswitch_to_buffer (Fother_buffer (buffer, Qnil, Qnil), Qnil);
1765 else
1767 Lisp_Object buf1;
1769 buf1 = Fget_buffer (buffer);
1770 if (NILP (buf1))
1771 nsberror (buffer);
1772 buffer = buf1;
1775 /* Move buffer to the end of the buffer list. Do nothing if the
1776 buffer is killed. */
1777 if (!NILP (XBUFFER (buffer)->name))
1779 Lisp_Object aelt, link;
1781 aelt = Frassq (buffer, Vbuffer_alist);
1782 link = Fmemq (aelt, Vbuffer_alist);
1783 Vbuffer_alist = Fdelq (aelt, Vbuffer_alist);
1784 XCDR (link) = Qnil;
1785 Vbuffer_alist = nconc2 (Vbuffer_alist, link);
1787 frames_bury_buffer (buffer);
1790 return Qnil;
1793 DEFUN ("erase-buffer", Ferase_buffer, Serase_buffer, 0, 0, "*",
1794 "Delete the entire contents of the current buffer.\n\
1795 Any narrowing restriction in effect (see `narrow-to-region') is removed,\n\
1796 so the buffer is truly empty after this.")
1799 Fwiden ();
1801 del_range (BEG, Z);
1803 current_buffer->last_window_start = 1;
1804 /* Prevent warnings, or suspension of auto saving, that would happen
1805 if future size is less than past size. Use of erase-buffer
1806 implies that the future text is not really related to the past text. */
1807 XSETFASTINT (current_buffer->save_length, 0);
1808 return Qnil;
1811 void
1812 validate_region (b, e)
1813 register Lisp_Object *b, *e;
1815 CHECK_NUMBER_COERCE_MARKER (*b, 0);
1816 CHECK_NUMBER_COERCE_MARKER (*e, 1);
1818 if (XINT (*b) > XINT (*e))
1820 Lisp_Object tem;
1821 tem = *b; *b = *e; *e = tem;
1824 if (!(BEGV <= XINT (*b) && XINT (*b) <= XINT (*e)
1825 && XINT (*e) <= ZV))
1826 args_out_of_range (*b, *e);
1829 /* Advance BYTE_POS up to a character boundary
1830 and return the adjusted position. */
1832 static int
1833 advance_to_char_boundary (byte_pos)
1834 int byte_pos;
1836 int c;
1838 if (byte_pos == BEG)
1839 /* Beginning of buffer is always a character boundary. */
1840 return 1;
1842 c = FETCH_BYTE (byte_pos);
1843 if (! CHAR_HEAD_P (c))
1845 /* We should advance BYTE_POS only when C is a constituent of a
1846 multibyte sequence. */
1847 int orig_byte_pos = byte_pos;
1851 byte_pos--;
1852 c = FETCH_BYTE (byte_pos);
1854 while (! CHAR_HEAD_P (c) && byte_pos > BEG);
1855 INC_POS (byte_pos);
1856 if (byte_pos < orig_byte_pos)
1857 byte_pos = orig_byte_pos;
1858 /* If C is a constituent of a multibyte sequence, BYTE_POS was
1859 surely advance to the correct character boundary. If C is
1860 not, BYTE_POS was unchanged. */
1863 return byte_pos;
1866 DEFUN ("set-buffer-multibyte", Fset_buffer_multibyte, Sset_buffer_multibyte,
1867 1, 1, 0,
1868 "Set the multibyte flag of the current buffer to FLAG.\n\
1869 If FLAG is t, this makes the buffer a multibyte buffer.\n\
1870 If FLAG is nil, this makes the buffer a single-byte buffer.\n\
1871 The buffer contents remain unchanged as a sequence of bytes\n\
1872 but the contents viewed as characters do change.")
1873 (flag)
1874 Lisp_Object flag;
1876 Lisp_Object tail, markers;
1877 struct buffer *other;
1878 int undo_enabled_p = !EQ (current_buffer->undo_list, Qt);
1879 int begv = BEGV, zv = ZV;
1880 int narrowed = (BEG != begv || Z != zv);
1881 int modified_p = !NILP (Fbuffer_modified_p (Qnil));
1883 if (current_buffer->base_buffer)
1884 error ("Cannot do `set-buffer-multibyte' on an indirect buffer");
1886 /* Do nothing if nothing actually changes. */
1887 if (NILP (flag) == NILP (current_buffer->enable_multibyte_characters))
1888 return flag;
1890 /* It would be better to update the list,
1891 but this is good enough for now. */
1892 if (undo_enabled_p)
1893 current_buffer->undo_list = Qt;
1895 /* If the cached position is for this buffer, clear it out. */
1896 clear_charpos_cache (current_buffer);
1898 if (narrowed)
1899 Fwiden ();
1901 if (NILP (flag))
1903 int pos, stop;
1904 unsigned char *p;
1906 /* Do this first, so it can use CHAR_TO_BYTE
1907 to calculate the old correspondences. */
1908 set_intervals_multibyte (0);
1910 current_buffer->enable_multibyte_characters = Qnil;
1912 Z = Z_BYTE;
1913 BEGV = BEGV_BYTE;
1914 ZV = ZV_BYTE;
1915 GPT = GPT_BYTE;
1916 TEMP_SET_PT_BOTH (PT_BYTE, PT_BYTE);
1918 tail = BUF_MARKERS (current_buffer);
1919 while (! NILP (tail))
1921 XMARKER (tail)->charpos = XMARKER (tail)->bytepos;
1922 tail = XMARKER (tail)->chain;
1925 /* Convert multibyte form of 8-bit characters to unibyte. */
1926 pos = BEG;
1927 stop = GPT;
1928 p = BEG_ADDR;
1929 while (1)
1931 int c, bytes;
1933 if (pos == stop)
1935 if (pos == Z)
1936 break;
1937 p = GAP_END_ADDR;
1938 stop = Z;
1940 if (MULTIBYTE_STR_AS_UNIBYTE_P (p, bytes))
1941 p += bytes, pos += bytes;
1942 else
1944 c = STRING_CHAR (p, stop - pos);
1945 /* Delete all bytes for this 8-bit character but the
1946 last one, and change the last one to the charcter
1947 code. */
1948 bytes--;
1949 del_range_2 (pos, pos, pos + bytes, pos + bytes, 0);
1950 p = GAP_END_ADDR;
1951 *p++ = c;
1952 pos++;
1953 if (begv > pos)
1954 begv -= bytes;
1955 if (zv > pos)
1956 zv -= bytes;
1957 stop = Z;
1960 if (narrowed)
1961 Fnarrow_to_region (make_number (begv), make_number (zv));
1963 else
1965 int pt = PT;
1966 int pos, stop;
1967 unsigned char *p;
1969 /* Be sure not to have a multibyte sequence striding over the GAP.
1970 Ex: We change this: "...abc\201 _GAP_ \241def..."
1971 to: "...abc _GAP_ \201\241def..." */
1973 if (GPT_BYTE > 1 && GPT_BYTE < Z_BYTE
1974 && ! CHAR_HEAD_P (*(GAP_END_ADDR)))
1976 unsigned char *p = GPT_ADDR - 1;
1978 while (! CHAR_HEAD_P (*p) && p > BEG_ADDR) p--;
1979 if (BASE_LEADING_CODE_P (*p))
1981 int new_gpt = GPT_BYTE - (GPT_ADDR - p);
1983 move_gap_both (new_gpt, new_gpt);
1987 /* Make the buffer contents valid as multibyte by converting
1988 8-bit characters to multibyte form. */
1989 pos = BEG;
1990 stop = GPT;
1991 p = BEG_ADDR;
1992 while (1)
1994 int bytes;
1996 if (pos == stop)
1998 if (pos == Z)
1999 break;
2000 p = GAP_END_ADDR;
2001 stop = Z;
2004 if (UNIBYTE_STR_AS_MULTIBYTE_P (p, stop - pos, bytes))
2005 p += bytes, pos += bytes;
2006 else
2008 unsigned char tmp[MAX_MULTIBYTE_LENGTH];
2010 bytes = CHAR_STRING (*p, tmp);
2011 *p = tmp[0];
2012 TEMP_SET_PT_BOTH (pos + 1, pos + 1);
2013 bytes--;
2014 insert_1_both (tmp + 1, bytes, bytes, 1, 0, 0);
2015 /* Now the gap is after the just inserted data. */
2016 pos = GPT;
2017 p = GAP_END_ADDR;
2018 if (pos <= begv)
2019 begv += bytes;
2020 if (pos <= zv)
2021 zv += bytes;
2022 if (pos <= pt)
2023 pt += bytes;
2024 stop = Z;
2028 if (pt != PT)
2029 TEMP_SET_PT (pt);
2031 if (narrowed)
2032 Fnarrow_to_region (make_number (begv), make_number (zv));
2034 /* Do this first, so that chars_in_text asks the right question.
2035 set_intervals_multibyte needs it too. */
2036 current_buffer->enable_multibyte_characters = Qt;
2038 GPT_BYTE = advance_to_char_boundary (GPT_BYTE);
2039 GPT = chars_in_text (BEG_ADDR, GPT_BYTE - BEG_BYTE) + BEG;
2041 Z = chars_in_text (GAP_END_ADDR, Z_BYTE - GPT_BYTE) + GPT;
2043 BEGV_BYTE = advance_to_char_boundary (BEGV_BYTE);
2044 if (BEGV_BYTE > GPT_BYTE)
2045 BEGV = chars_in_text (GAP_END_ADDR, BEGV_BYTE - GPT_BYTE) + GPT;
2046 else
2047 BEGV = chars_in_text (BEG_ADDR, BEGV_BYTE - BEG_BYTE) + BEG;
2049 ZV_BYTE = advance_to_char_boundary (ZV_BYTE);
2050 if (ZV_BYTE > GPT_BYTE)
2051 ZV = chars_in_text (GAP_END_ADDR, ZV_BYTE - GPT_BYTE) + GPT;
2052 else
2053 ZV = chars_in_text (BEG_ADDR, ZV_BYTE - BEG_BYTE) + BEG;
2056 int pt_byte = advance_to_char_boundary (PT_BYTE);
2057 int pt;
2059 if (pt_byte > GPT_BYTE)
2060 pt = chars_in_text (GAP_END_ADDR, pt_byte - GPT_BYTE) + GPT;
2061 else
2062 pt = chars_in_text (BEG_ADDR, pt_byte - BEG_BYTE) + BEG;
2063 TEMP_SET_PT_BOTH (pt, pt_byte);
2066 tail = markers = BUF_MARKERS (current_buffer);
2068 /* This prevents BYTE_TO_CHAR (that is, buf_bytepos_to_charpos) from
2069 getting confused by the markers that have not yet been updated.
2070 It is also a signal that it should never create a marker. */
2071 BUF_MARKERS (current_buffer) = Qnil;
2073 while (! NILP (tail))
2075 XMARKER (tail)->bytepos
2076 = advance_to_char_boundary (XMARKER (tail)->bytepos);
2077 XMARKER (tail)->charpos = BYTE_TO_CHAR (XMARKER (tail)->bytepos);
2079 tail = XMARKER (tail)->chain;
2082 /* Make sure no markers were put on the chain
2083 while the chain value was incorrect. */
2084 if (! EQ (BUF_MARKERS (current_buffer), Qnil))
2085 abort ();
2087 BUF_MARKERS (current_buffer) = markers;
2089 /* Do this last, so it can calculate the new correspondences
2090 between chars and bytes. */
2091 set_intervals_multibyte (1);
2094 if (undo_enabled_p)
2095 current_buffer->undo_list = Qnil;
2097 /* Changing the multibyteness of a buffer means that all windows
2098 showing that buffer must be updated thoroughly. */
2099 current_buffer->prevent_redisplay_optimizations_p = 1;
2100 ++windows_or_buffers_changed;
2102 /* Copy this buffer's new multibyte status
2103 into all of its indirect buffers. */
2104 for (other = all_buffers; other; other = other->next)
2105 if (other->base_buffer == current_buffer && !NILP (other->name))
2107 other->enable_multibyte_characters
2108 = current_buffer->enable_multibyte_characters;
2109 other->prevent_redisplay_optimizations_p = 1;
2112 /* Restore the modifiedness of the buffer. */
2113 if (!modified_p && !NILP (Fbuffer_modified_p (Qnil)))
2114 Fset_buffer_modified_p (Qnil);
2116 return flag;
2119 DEFUN ("kill-all-local-variables", Fkill_all_local_variables, Skill_all_local_variables,
2120 0, 0, 0,
2121 "Switch to Fundamental mode by killing current buffer's local variables.\n\
2122 Most local variable bindings are eliminated so that the default values\n\
2123 become effective once more. Also, the syntax table is set from\n\
2124 `standard-syntax-table', the local keymap is set to nil,\n\
2125 and the abbrev table from `fundamental-mode-abbrev-table'.\n\
2126 This function also forces redisplay of the mode line.\n\
2128 Every function to select a new major mode starts by\n\
2129 calling this function.\n\n\
2130 As a special exception, local variables whose names have\n\
2131 a non-nil `permanent-local' property are not eliminated by this function.\n\
2133 The first thing this function does is run\n\
2134 the normal hook `change-major-mode-hook'.")
2137 register Lisp_Object alist, sym, tem;
2138 Lisp_Object oalist;
2140 if (!NILP (Vrun_hooks))
2141 call1 (Vrun_hooks, intern ("change-major-mode-hook"));
2142 oalist = current_buffer->local_var_alist;
2144 /* Make sure none of the bindings in oalist
2145 remain swapped in, in their symbols. */
2147 swap_out_buffer_local_variables (current_buffer);
2149 /* Actually eliminate all local bindings of this buffer. */
2151 reset_buffer_local_variables (current_buffer, 0);
2153 /* Redisplay mode lines; we are changing major mode. */
2155 update_mode_lines++;
2157 /* Any which are supposed to be permanent,
2158 make local again, with the same values they had. */
2160 for (alist = oalist; !NILP (alist); alist = XCDR (alist))
2162 sym = XCAR (XCAR (alist));
2163 tem = Fget (sym, Qpermanent_local);
2164 if (! NILP (tem))
2166 Fmake_local_variable (sym);
2167 Fset (sym, XCDR (XCAR (alist)));
2171 /* Force mode-line redisplay. Useful here because all major mode
2172 commands call this function. */
2173 update_mode_lines++;
2175 return Qnil;
2178 /* Make sure no local variables remain set up with buffer B
2179 for their current values. */
2181 static void
2182 swap_out_buffer_local_variables (b)
2183 struct buffer *b;
2185 Lisp_Object oalist, alist, sym, tem, buffer;
2187 XSETBUFFER (buffer, b);
2188 oalist = b->local_var_alist;
2190 for (alist = oalist; !NILP (alist); alist = XCDR (alist))
2192 sym = XCAR (XCAR (alist));
2194 /* Need not do anything if some other buffer's binding is now encached. */
2195 tem = XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->buffer;
2196 if (BUFFERP (tem) && XBUFFER (tem) == current_buffer)
2198 /* Symbol is set up for this buffer's old local value.
2199 Set it up for the current buffer with the default value. */
2201 tem = XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->cdr;
2202 /* Store the symbol's current value into the alist entry
2203 it is currently set up for. This is so that, if the
2204 local is marked permanent, and we make it local again
2205 later in Fkill_all_local_variables, we don't lose the value. */
2206 XCDR (XCAR (tem))
2207 = do_symval_forwarding (XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->realvalue);
2208 /* Switch to the symbol's default-value alist entry. */
2209 XCAR (tem) = tem;
2210 /* Mark it as current for buffer B. */
2211 XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->buffer = buffer;
2212 /* Store the current value into any forwarding in the symbol. */
2213 store_symval_forwarding (sym,
2214 XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->realvalue,
2215 XCDR (tem));
2220 /* Find all the overlays in the current buffer that contain position POS.
2221 Return the number found, and store them in a vector in *VEC_PTR.
2222 Store in *LEN_PTR the size allocated for the vector.
2223 Store in *NEXT_PTR the next position after POS where an overlay starts,
2224 or ZV if there are no more overlays.
2225 Store in *PREV_PTR the previous position before POS where an overlay ends,
2226 or where an overlay starts which ends at or after POS;
2227 or BEGV if there are no such overlays.
2228 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
2230 *VEC_PTR and *LEN_PTR should contain a valid vector and size
2231 when this function is called.
2233 If EXTEND is non-zero, we make the vector bigger if necessary.
2234 If EXTEND is zero, we never extend the vector,
2235 and we store only as many overlays as will fit.
2236 But we still return the total number of overlays.
2238 If CHANGE_REQ is true, then any position written into *PREV_PTR or
2239 *NEXT_PTR is guaranteed to be not equal to POS, unless it is the
2240 default (BEGV or ZV). */
2243 overlays_at (pos, extend, vec_ptr, len_ptr, next_ptr, prev_ptr, change_req)
2244 int pos;
2245 int extend;
2246 Lisp_Object **vec_ptr;
2247 int *len_ptr;
2248 int *next_ptr;
2249 int *prev_ptr;
2250 int change_req;
2252 Lisp_Object tail, overlay, start, end;
2253 int idx = 0;
2254 int len = *len_ptr;
2255 Lisp_Object *vec = *vec_ptr;
2256 int next = ZV;
2257 int prev = BEGV;
2258 int inhibit_storing = 0;
2260 for (tail = current_buffer->overlays_before;
2261 GC_CONSP (tail);
2262 tail = XCDR (tail))
2264 int startpos, endpos;
2266 overlay = XCAR (tail);
2268 start = OVERLAY_START (overlay);
2269 end = OVERLAY_END (overlay);
2270 endpos = OVERLAY_POSITION (end);
2271 if (endpos < pos)
2273 if (prev < endpos)
2274 prev = endpos;
2275 break;
2277 startpos = OVERLAY_POSITION (start);
2278 /* This one ends at or after POS
2279 so its start counts for PREV_PTR if it's before POS. */
2280 if (prev < startpos && startpos < pos)
2281 prev = startpos;
2282 if (endpos == pos)
2283 continue;
2284 if (startpos <= pos)
2286 if (idx == len)
2288 /* The supplied vector is full.
2289 Either make it bigger, or don't store any more in it. */
2290 if (extend)
2292 /* Make it work with an initial len == 0. */
2293 len *= 2;
2294 if (len == 0)
2295 len = 4;
2296 *len_ptr = len;
2297 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2298 *vec_ptr = vec;
2300 else
2301 inhibit_storing = 1;
2304 if (!inhibit_storing)
2305 vec[idx] = overlay;
2306 /* Keep counting overlays even if we can't return them all. */
2307 idx++;
2309 else if (startpos < next)
2310 next = startpos;
2313 for (tail = current_buffer->overlays_after;
2314 GC_CONSP (tail);
2315 tail = XCDR (tail))
2317 int startpos, endpos;
2319 overlay = XCAR (tail);
2321 start = OVERLAY_START (overlay);
2322 end = OVERLAY_END (overlay);
2323 startpos = OVERLAY_POSITION (start);
2324 if (pos < startpos)
2326 if (startpos < next)
2327 next = startpos;
2328 break;
2330 endpos = OVERLAY_POSITION (end);
2331 if (pos < endpos)
2333 if (idx == len)
2335 if (extend)
2337 *len_ptr = len *= 2;
2338 if (len == 0)
2339 len = *len_ptr = 4;
2340 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2341 *vec_ptr = vec;
2343 else
2344 inhibit_storing = 1;
2347 if (!inhibit_storing)
2348 vec[idx] = overlay;
2349 idx++;
2351 if (startpos < pos && startpos > prev)
2352 prev = startpos;
2354 else if (endpos < pos && endpos > prev)
2355 prev = endpos;
2356 else if (endpos == pos && startpos > prev && !change_req)
2357 prev = startpos;
2360 if (next_ptr)
2361 *next_ptr = next;
2362 if (prev_ptr)
2363 *prev_ptr = prev;
2364 return idx;
2367 /* Find all the overlays in the current buffer that overlap the range BEG-END
2368 or are empty at BEG.
2370 Return the number found, and store them in a vector in *VEC_PTR.
2371 Store in *LEN_PTR the size allocated for the vector.
2372 Store in *NEXT_PTR the next position after POS where an overlay starts,
2373 or ZV if there are no more overlays.
2374 Store in *PREV_PTR the previous position before POS where an overlay ends,
2375 or BEGV if there are no previous overlays.
2376 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
2378 *VEC_PTR and *LEN_PTR should contain a valid vector and size
2379 when this function is called.
2381 If EXTEND is non-zero, we make the vector bigger if necessary.
2382 If EXTEND is zero, we never extend the vector,
2383 and we store only as many overlays as will fit.
2384 But we still return the total number of overlays. */
2387 overlays_in (beg, end, extend, vec_ptr, len_ptr, next_ptr, prev_ptr)
2388 int beg, end;
2389 int extend;
2390 Lisp_Object **vec_ptr;
2391 int *len_ptr;
2392 int *next_ptr;
2393 int *prev_ptr;
2395 Lisp_Object tail, overlay, ostart, oend;
2396 int idx = 0;
2397 int len = *len_ptr;
2398 Lisp_Object *vec = *vec_ptr;
2399 int next = ZV;
2400 int prev = BEGV;
2401 int inhibit_storing = 0;
2403 for (tail = current_buffer->overlays_before;
2404 GC_CONSP (tail);
2405 tail = XCDR (tail))
2407 int startpos, endpos;
2409 overlay = XCAR (tail);
2411 ostart = OVERLAY_START (overlay);
2412 oend = OVERLAY_END (overlay);
2413 endpos = OVERLAY_POSITION (oend);
2414 if (endpos < beg)
2416 if (prev < endpos)
2417 prev = endpos;
2418 break;
2420 startpos = OVERLAY_POSITION (ostart);
2421 /* Count an interval if it either overlaps the range
2422 or is empty at the start of the range. */
2423 if ((beg < endpos && startpos < end)
2424 || (startpos == endpos && beg == endpos))
2426 if (idx == len)
2428 /* The supplied vector is full.
2429 Either make it bigger, or don't store any more in it. */
2430 if (extend)
2432 *len_ptr = len *= 2;
2433 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2434 *vec_ptr = vec;
2436 else
2437 inhibit_storing = 1;
2440 if (!inhibit_storing)
2441 vec[idx] = overlay;
2442 /* Keep counting overlays even if we can't return them all. */
2443 idx++;
2445 else if (startpos < next)
2446 next = startpos;
2449 for (tail = current_buffer->overlays_after;
2450 GC_CONSP (tail);
2451 tail = XCDR (tail))
2453 int startpos, endpos;
2455 overlay = XCAR (tail);
2457 ostart = OVERLAY_START (overlay);
2458 oend = OVERLAY_END (overlay);
2459 startpos = OVERLAY_POSITION (ostart);
2460 if (end < startpos)
2462 if (startpos < next)
2463 next = startpos;
2464 break;
2466 endpos = OVERLAY_POSITION (oend);
2467 /* Count an interval if it either overlaps the range
2468 or is empty at the start of the range. */
2469 if ((beg < endpos && startpos < end)
2470 || (startpos == endpos && beg == endpos))
2472 if (idx == len)
2474 if (extend)
2476 *len_ptr = len *= 2;
2477 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2478 *vec_ptr = vec;
2480 else
2481 inhibit_storing = 1;
2484 if (!inhibit_storing)
2485 vec[idx] = overlay;
2486 idx++;
2488 else if (endpos < beg && endpos > prev)
2489 prev = endpos;
2492 if (next_ptr)
2493 *next_ptr = next;
2494 if (prev_ptr)
2495 *prev_ptr = prev;
2496 return idx;
2499 /* Fast function to just test if we're at an overlay boundary. */
2501 overlay_touches_p (pos)
2502 int pos;
2504 Lisp_Object tail, overlay;
2506 for (tail = current_buffer->overlays_before; GC_CONSP (tail);
2507 tail = XCDR (tail))
2509 int endpos;
2511 overlay = XCAR (tail);
2512 if (!GC_OVERLAYP (overlay))
2513 abort ();
2515 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2516 if (endpos < pos)
2517 break;
2518 if (endpos == pos || OVERLAY_POSITION (OVERLAY_START (overlay)) == pos)
2519 return 1;
2522 for (tail = current_buffer->overlays_after; GC_CONSP (tail);
2523 tail = XCDR (tail))
2525 int startpos;
2527 overlay = XCAR (tail);
2528 if (!GC_OVERLAYP (overlay))
2529 abort ();
2531 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2532 if (pos < startpos)
2533 break;
2534 if (startpos == pos || OVERLAY_POSITION (OVERLAY_END (overlay)) == pos)
2535 return 1;
2537 return 0;
2540 struct sortvec
2542 Lisp_Object overlay;
2543 int beg, end;
2544 int priority;
2547 static int
2548 compare_overlays (v1, v2)
2549 const void *v1, *v2;
2551 const struct sortvec *s1 = (const struct sortvec *) v1;
2552 const struct sortvec *s2 = (const struct sortvec *) v2;
2553 if (s1->priority != s2->priority)
2554 return s1->priority - s2->priority;
2555 if (s1->beg != s2->beg)
2556 return s1->beg - s2->beg;
2557 if (s1->end != s2->end)
2558 return s2->end - s1->end;
2559 return 0;
2562 /* Sort an array of overlays by priority. The array is modified in place.
2563 The return value is the new size; this may be smaller than the original
2564 size if some of the overlays were invalid or were window-specific. */
2566 sort_overlays (overlay_vec, noverlays, w)
2567 Lisp_Object *overlay_vec;
2568 int noverlays;
2569 struct window *w;
2571 int i, j;
2572 struct sortvec *sortvec;
2573 sortvec = (struct sortvec *) alloca (noverlays * sizeof (struct sortvec));
2575 /* Put the valid and relevant overlays into sortvec. */
2577 for (i = 0, j = 0; i < noverlays; i++)
2579 Lisp_Object tem;
2580 Lisp_Object overlay;
2582 overlay = overlay_vec[i];
2583 if (OVERLAY_VALID (overlay)
2584 && OVERLAY_POSITION (OVERLAY_START (overlay)) > 0
2585 && OVERLAY_POSITION (OVERLAY_END (overlay)) > 0)
2587 /* If we're interested in a specific window, then ignore
2588 overlays that are limited to some other window. */
2589 if (w)
2591 Lisp_Object window;
2593 window = Foverlay_get (overlay, Qwindow);
2594 if (WINDOWP (window) && XWINDOW (window) != w)
2595 continue;
2598 /* This overlay is good and counts: put it into sortvec. */
2599 sortvec[j].overlay = overlay;
2600 sortvec[j].beg = OVERLAY_POSITION (OVERLAY_START (overlay));
2601 sortvec[j].end = OVERLAY_POSITION (OVERLAY_END (overlay));
2602 tem = Foverlay_get (overlay, Qpriority);
2603 if (INTEGERP (tem))
2604 sortvec[j].priority = XINT (tem);
2605 else
2606 sortvec[j].priority = 0;
2607 j++;
2610 noverlays = j;
2612 /* Sort the overlays into the proper order: increasing priority. */
2614 if (noverlays > 1)
2615 qsort (sortvec, noverlays, sizeof (struct sortvec), compare_overlays);
2617 for (i = 0; i < noverlays; i++)
2618 overlay_vec[i] = sortvec[i].overlay;
2619 return (noverlays);
2622 struct sortstr
2624 Lisp_Object string, string2;
2625 int size;
2626 int priority;
2629 struct sortstrlist
2631 struct sortstr *buf; /* An array that expands as needed; never freed. */
2632 int size; /* Allocated length of that array. */
2633 int used; /* How much of the array is currently in use. */
2634 int bytes; /* Total length of the strings in buf. */
2637 /* Buffers for storing information about the overlays touching a given
2638 position. These could be automatic variables in overlay_strings, but
2639 it's more efficient to hold onto the memory instead of repeatedly
2640 allocating and freeing it. */
2641 static struct sortstrlist overlay_heads, overlay_tails;
2642 static unsigned char *overlay_str_buf;
2644 /* Allocated length of overlay_str_buf. */
2645 static int overlay_str_len;
2647 /* A comparison function suitable for passing to qsort. */
2648 static int
2649 cmp_for_strings (as1, as2)
2650 char *as1, *as2;
2652 struct sortstr *s1 = (struct sortstr *)as1;
2653 struct sortstr *s2 = (struct sortstr *)as2;
2654 if (s1->size != s2->size)
2655 return s2->size - s1->size;
2656 if (s1->priority != s2->priority)
2657 return s1->priority - s2->priority;
2658 return 0;
2661 static void
2662 record_overlay_string (ssl, str, str2, pri, size)
2663 struct sortstrlist *ssl;
2664 Lisp_Object str, str2, pri;
2665 int size;
2667 int nbytes;
2669 if (ssl->used == ssl->size)
2671 if (ssl->buf)
2672 ssl->size *= 2;
2673 else
2674 ssl->size = 5;
2675 ssl->buf = ((struct sortstr *)
2676 xrealloc (ssl->buf, ssl->size * sizeof (struct sortstr)));
2678 ssl->buf[ssl->used].string = str;
2679 ssl->buf[ssl->used].string2 = str2;
2680 ssl->buf[ssl->used].size = size;
2681 ssl->buf[ssl->used].priority = (INTEGERP (pri) ? XINT (pri) : 0);
2682 ssl->used++;
2684 if (NILP (current_buffer->enable_multibyte_characters))
2685 nbytes = XSTRING (str)->size;
2686 else if (! STRING_MULTIBYTE (str))
2687 nbytes = count_size_as_multibyte (XSTRING (str)->data,
2688 STRING_BYTES (XSTRING (str)));
2689 else
2690 nbytes = STRING_BYTES (XSTRING (str));
2692 ssl->bytes += nbytes;
2694 if (STRINGP (str2))
2696 if (NILP (current_buffer->enable_multibyte_characters))
2697 nbytes = XSTRING (str2)->size;
2698 else if (! STRING_MULTIBYTE (str2))
2699 nbytes = count_size_as_multibyte (XSTRING (str2)->data,
2700 STRING_BYTES (XSTRING (str2)));
2701 else
2702 nbytes = STRING_BYTES (XSTRING (str2));
2704 ssl->bytes += nbytes;
2708 /* Return the concatenation of the strings associated with overlays that
2709 begin or end at POS, ignoring overlays that are specific to a window
2710 other than W. The strings are concatenated in the appropriate order:
2711 shorter overlays nest inside longer ones, and higher priority inside
2712 lower. Normally all of the after-strings come first, but zero-sized
2713 overlays have their after-strings ride along with the before-strings
2714 because it would look strange to print them inside-out.
2716 Returns the string length, and stores the contents indirectly through
2717 PSTR, if that variable is non-null. The string may be overwritten by
2718 subsequent calls. */
2721 overlay_strings (pos, w, pstr)
2722 int pos;
2723 struct window *w;
2724 unsigned char **pstr;
2726 Lisp_Object ov, overlay, window, str;
2727 int startpos, endpos;
2728 int multibyte = ! NILP (current_buffer->enable_multibyte_characters);
2730 overlay_heads.used = overlay_heads.bytes = 0;
2731 overlay_tails.used = overlay_tails.bytes = 0;
2732 for (ov = current_buffer->overlays_before; CONSP (ov); ov = XCDR (ov))
2734 overlay = XCAR (ov);
2735 if (!OVERLAYP (overlay))
2736 abort ();
2738 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2739 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2740 if (endpos < pos)
2741 break;
2742 if (endpos != pos && startpos != pos)
2743 continue;
2744 window = Foverlay_get (overlay, Qwindow);
2745 if (WINDOWP (window) && XWINDOW (window) != w)
2746 continue;
2747 if (startpos == pos
2748 && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
2749 record_overlay_string (&overlay_heads, str,
2750 (startpos == endpos
2751 ? Foverlay_get (overlay, Qafter_string)
2752 : Qnil),
2753 Foverlay_get (overlay, Qpriority),
2754 endpos - startpos);
2755 else if (endpos == pos
2756 && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
2757 record_overlay_string (&overlay_tails, str, Qnil,
2758 Foverlay_get (overlay, Qpriority),
2759 endpos - startpos);
2761 for (ov = current_buffer->overlays_after; CONSP (ov); ov = XCDR (ov))
2763 overlay = XCAR (ov);
2764 if (!OVERLAYP (overlay))
2765 abort ();
2767 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2768 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2769 if (startpos > pos)
2770 break;
2771 if (endpos != pos && startpos != pos)
2772 continue;
2773 window = Foverlay_get (overlay, Qwindow);
2774 if (WINDOWP (window) && XWINDOW (window) != w)
2775 continue;
2776 if (startpos == pos
2777 && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
2778 record_overlay_string (&overlay_heads, str,
2779 (startpos == endpos
2780 ? Foverlay_get (overlay, Qafter_string)
2781 : Qnil),
2782 Foverlay_get (overlay, Qpriority),
2783 endpos - startpos);
2784 else if (endpos == pos
2785 && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
2786 record_overlay_string (&overlay_tails, str, Qnil,
2787 Foverlay_get (overlay, Qpriority),
2788 endpos - startpos);
2790 if (overlay_tails.used > 1)
2791 qsort (overlay_tails.buf, overlay_tails.used, sizeof (struct sortstr),
2792 cmp_for_strings);
2793 if (overlay_heads.used > 1)
2794 qsort (overlay_heads.buf, overlay_heads.used, sizeof (struct sortstr),
2795 cmp_for_strings);
2796 if (overlay_heads.bytes || overlay_tails.bytes)
2798 Lisp_Object tem;
2799 int i;
2800 unsigned char *p;
2801 int total = overlay_heads.bytes + overlay_tails.bytes;
2803 if (total > overlay_str_len)
2805 overlay_str_len = total;
2806 overlay_str_buf = (unsigned char *)xrealloc (overlay_str_buf,
2807 total);
2809 p = overlay_str_buf;
2810 for (i = overlay_tails.used; --i >= 0;)
2812 int nbytes;
2813 tem = overlay_tails.buf[i].string;
2814 nbytes = copy_text (XSTRING (tem)->data, p,
2815 STRING_BYTES (XSTRING (tem)),
2816 STRING_MULTIBYTE (tem), multibyte);
2817 p += nbytes;
2819 for (i = 0; i < overlay_heads.used; ++i)
2821 int nbytes;
2822 tem = overlay_heads.buf[i].string;
2823 nbytes = copy_text (XSTRING (tem)->data, p,
2824 STRING_BYTES (XSTRING (tem)),
2825 STRING_MULTIBYTE (tem), multibyte);
2826 p += nbytes;
2827 tem = overlay_heads.buf[i].string2;
2828 if (STRINGP (tem))
2830 nbytes = copy_text (XSTRING (tem)->data, p,
2831 STRING_BYTES (XSTRING (tem)),
2832 STRING_MULTIBYTE (tem), multibyte);
2833 p += nbytes;
2836 if (p != overlay_str_buf + total)
2837 abort ();
2838 if (pstr)
2839 *pstr = overlay_str_buf;
2840 return total;
2842 return 0;
2845 /* Shift overlays in BUF's overlay lists, to center the lists at POS. */
2847 void
2848 recenter_overlay_lists (buf, pos)
2849 struct buffer *buf;
2850 int pos;
2852 Lisp_Object overlay, tail, next, prev, beg, end;
2854 /* See if anything in overlays_before should move to overlays_after. */
2856 /* We don't strictly need prev in this loop; it should always be nil.
2857 But we use it for symmetry and in case that should cease to be true
2858 with some future change. */
2859 prev = Qnil;
2860 for (tail = buf->overlays_before;
2861 CONSP (tail);
2862 prev = tail, tail = next)
2864 next = XCDR (tail);
2865 overlay = XCAR (tail);
2867 /* If the overlay is not valid, get rid of it. */
2868 if (!OVERLAY_VALID (overlay))
2869 #if 1
2870 abort ();
2871 #else
2873 /* Splice the cons cell TAIL out of overlays_before. */
2874 if (!NILP (prev))
2875 XCDR (prev) = next;
2876 else
2877 buf->overlays_before = next;
2878 tail = prev;
2879 continue;
2881 #endif
2883 beg = OVERLAY_START (overlay);
2884 end = OVERLAY_END (overlay);
2886 if (OVERLAY_POSITION (end) > pos)
2888 /* OVERLAY needs to be moved. */
2889 int where = OVERLAY_POSITION (beg);
2890 Lisp_Object other, other_prev;
2892 /* Splice the cons cell TAIL out of overlays_before. */
2893 if (!NILP (prev))
2894 XCDR (prev) = next;
2895 else
2896 buf->overlays_before = next;
2898 /* Search thru overlays_after for where to put it. */
2899 other_prev = Qnil;
2900 for (other = buf->overlays_after;
2901 CONSP (other);
2902 other_prev = other, other = XCDR (other))
2904 Lisp_Object otherbeg, otheroverlay;
2906 otheroverlay = XCAR (other);
2907 if (! OVERLAY_VALID (otheroverlay))
2908 abort ();
2910 otherbeg = OVERLAY_START (otheroverlay);
2911 if (OVERLAY_POSITION (otherbeg) >= where)
2912 break;
2915 /* Add TAIL to overlays_after before OTHER. */
2916 XCDR (tail) = other;
2917 if (!NILP (other_prev))
2918 XCDR (other_prev) = tail;
2919 else
2920 buf->overlays_after = tail;
2921 tail = prev;
2923 else
2924 /* We've reached the things that should stay in overlays_before.
2925 All the rest of overlays_before must end even earlier,
2926 so stop now. */
2927 break;
2930 /* See if anything in overlays_after should be in overlays_before. */
2931 prev = Qnil;
2932 for (tail = buf->overlays_after;
2933 CONSP (tail);
2934 prev = tail, tail = next)
2936 next = XCDR (tail);
2937 overlay = XCAR (tail);
2939 /* If the overlay is not valid, get rid of it. */
2940 if (!OVERLAY_VALID (overlay))
2941 #if 1
2942 abort ();
2943 #else
2945 /* Splice the cons cell TAIL out of overlays_after. */
2946 if (!NILP (prev))
2947 XCDR (prev) = next;
2948 else
2949 buf->overlays_after = next;
2950 tail = prev;
2951 continue;
2953 #endif
2955 beg = OVERLAY_START (overlay);
2956 end = OVERLAY_END (overlay);
2958 /* Stop looking, when we know that nothing further
2959 can possibly end before POS. */
2960 if (OVERLAY_POSITION (beg) > pos)
2961 break;
2963 if (OVERLAY_POSITION (end) <= pos)
2965 /* OVERLAY needs to be moved. */
2966 int where = OVERLAY_POSITION (end);
2967 Lisp_Object other, other_prev;
2969 /* Splice the cons cell TAIL out of overlays_after. */
2970 if (!NILP (prev))
2971 XCDR (prev) = next;
2972 else
2973 buf->overlays_after = next;
2975 /* Search thru overlays_before for where to put it. */
2976 other_prev = Qnil;
2977 for (other = buf->overlays_before;
2978 CONSP (other);
2979 other_prev = other, other = XCDR (other))
2981 Lisp_Object otherend, otheroverlay;
2983 otheroverlay = XCAR (other);
2984 if (! OVERLAY_VALID (otheroverlay))
2985 abort ();
2987 otherend = OVERLAY_END (otheroverlay);
2988 if (OVERLAY_POSITION (otherend) <= where)
2989 break;
2992 /* Add TAIL to overlays_before before OTHER. */
2993 XCDR (tail) = other;
2994 if (!NILP (other_prev))
2995 XCDR (other_prev) = tail;
2996 else
2997 buf->overlays_before = tail;
2998 tail = prev;
3002 XSETFASTINT (buf->overlay_center, pos);
3005 void
3006 adjust_overlays_for_insert (pos, length)
3007 int pos;
3008 int length;
3010 /* After an insertion, the lists are still sorted properly,
3011 but we may need to update the value of the overlay center. */
3012 if (XFASTINT (current_buffer->overlay_center) >= pos)
3013 XSETFASTINT (current_buffer->overlay_center,
3014 XFASTINT (current_buffer->overlay_center) + length);
3017 void
3018 adjust_overlays_for_delete (pos, length)
3019 int pos;
3020 int length;
3022 if (XFASTINT (current_buffer->overlay_center) < pos)
3023 /* The deletion was to our right. No change needed; the before- and
3024 after-lists are still consistent. */
3026 else if (XFASTINT (current_buffer->overlay_center) > pos + length)
3027 /* The deletion was to our left. We need to adjust the center value
3028 to account for the change in position, but the lists are consistent
3029 given the new value. */
3030 XSETFASTINT (current_buffer->overlay_center,
3031 XFASTINT (current_buffer->overlay_center) - length);
3032 else
3033 /* We're right in the middle. There might be things on the after-list
3034 that now belong on the before-list. Recentering will move them,
3035 and also update the center point. */
3036 recenter_overlay_lists (current_buffer, pos);
3039 /* Fix up overlays that were garbled as a result of permuting markers
3040 in the range START through END. Any overlay with at least one
3041 endpoint in this range will need to be unlinked from the overlay
3042 list and reinserted in its proper place.
3043 Such an overlay might even have negative size at this point.
3044 If so, we'll reverse the endpoints. Can you think of anything
3045 better to do in this situation? */
3046 void
3047 fix_overlays_in_range (start, end)
3048 register int start, end;
3050 Lisp_Object overlay;
3051 Lisp_Object before_list, after_list;
3052 Lisp_Object *ptail, *pbefore = &before_list, *pafter = &after_list;
3053 int startpos, endpos;
3055 /* This algorithm shifts links around instead of consing and GCing.
3056 The loop invariant is that before_list (resp. after_list) is a
3057 well-formed list except that its last element, the one that
3058 *pbefore (resp. *pafter) points to, is still uninitialized.
3059 So it's not a bug that before_list isn't initialized, although
3060 it may look strange. */
3061 for (ptail = &current_buffer->overlays_before; CONSP (*ptail);)
3063 overlay = XCAR (*ptail);
3064 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3065 if (endpos < start)
3066 break;
3067 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3068 if (endpos < end
3069 || (startpos >= start && startpos < end))
3071 /* If the overlay is backwards, fix that now. */
3072 if (startpos > endpos)
3074 int tem;
3075 Fset_marker (OVERLAY_START (overlay), make_number (endpos),
3076 Qnil);
3077 Fset_marker (OVERLAY_END (overlay), make_number (startpos),
3078 Qnil);
3079 tem = startpos; startpos = endpos; endpos = tem;
3081 /* Add it to the end of the wrong list. Later on,
3082 recenter_overlay_lists will move it to the right place. */
3083 if (endpos < XINT (current_buffer->overlay_center))
3085 *pafter = *ptail;
3086 pafter = &XCDR (*ptail);
3088 else
3090 *pbefore = *ptail;
3091 pbefore = &XCDR (*ptail);
3093 *ptail = XCDR (*ptail);
3095 else
3096 ptail = &XCDR (*ptail);
3098 for (ptail = &current_buffer->overlays_after; CONSP (*ptail);)
3100 overlay = XCAR (*ptail);
3101 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3102 if (startpos >= end)
3103 break;
3104 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3105 if (startpos >= start
3106 || (endpos >= start && endpos < end))
3108 if (startpos > endpos)
3110 int tem;
3111 Fset_marker (OVERLAY_START (overlay), make_number (endpos),
3112 Qnil);
3113 Fset_marker (OVERLAY_END (overlay), make_number (startpos),
3114 Qnil);
3115 tem = startpos; startpos = endpos; endpos = tem;
3117 if (endpos < XINT (current_buffer->overlay_center))
3119 *pafter = *ptail;
3120 pafter = &XCDR (*ptail);
3122 else
3124 *pbefore = *ptail;
3125 pbefore = &XCDR (*ptail);
3127 *ptail = XCDR (*ptail);
3129 else
3130 ptail = &XCDR (*ptail);
3133 /* Splice the constructed (wrong) lists into the buffer's lists,
3134 and let the recenter function make it sane again. */
3135 *pbefore = current_buffer->overlays_before;
3136 current_buffer->overlays_before = before_list;
3137 recenter_overlay_lists (current_buffer,
3138 XINT (current_buffer->overlay_center));
3140 *pafter = current_buffer->overlays_after;
3141 current_buffer->overlays_after = after_list;
3142 recenter_overlay_lists (current_buffer,
3143 XINT (current_buffer->overlay_center));
3146 /* We have two types of overlay: the one whose ending marker is
3147 after-insertion-marker (this is the usual case) and the one whose
3148 ending marker is before-insertion-marker. When `overlays_before'
3149 contains overlays of the latter type and the former type in this
3150 order and both overlays end at inserting position, inserting a text
3151 increases only the ending marker of the latter type, which results
3152 in incorrect ordering of `overlays_before'.
3154 This function fixes ordering of overlays in the slot
3155 `overlays_before' of the buffer *BP. Before the insertion, `point'
3156 was at PREV, and now is at POS. */
3158 void
3159 fix_overlays_before (bp, prev, pos)
3160 struct buffer *bp;
3161 int prev, pos;
3163 Lisp_Object *tailp = &bp->overlays_before;
3164 Lisp_Object *right_place;
3165 int end;
3167 /* After the insertion, the several overlays may be in incorrect
3168 order. The possibility is that, in the list `overlays_before',
3169 an overlay which ends at POS appears after an overlay which ends
3170 at PREV. Since POS is greater than PREV, we must fix the
3171 ordering of these overlays, by moving overlays ends at POS before
3172 the overlays ends at PREV. */
3174 /* At first, find a place where disordered overlays should be linked
3175 in. It is where an overlay which end before POS exists. (i.e. an
3176 overlay whose ending marker is after-insertion-marker if disorder
3177 exists). */
3178 while (!NILP (*tailp)
3179 && ((end = OVERLAY_POSITION (OVERLAY_END (XCAR (*tailp))))
3180 >= pos))
3181 tailp = &XCDR (*tailp);
3183 /* If we don't find such an overlay,
3184 or the found one ends before PREV,
3185 or the found one is the last one in the list,
3186 we don't have to fix anything. */
3187 if (NILP (*tailp)
3188 || end < prev
3189 || NILP (XCDR (*tailp)))
3190 return;
3192 right_place = tailp;
3193 tailp = &XCDR (*tailp);
3195 /* Now, end position of overlays in the list *TAILP should be before
3196 or equal to PREV. In the loop, an overlay which ends at POS is
3197 moved ahead to the place pointed by RIGHT_PLACE. If we found an
3198 overlay which ends before PREV, the remaining overlays are in
3199 correct order. */
3200 while (!NILP (*tailp))
3202 end = OVERLAY_POSITION (OVERLAY_END (XCAR (*tailp)));
3204 if (end == pos)
3205 { /* This overlay is disordered. */
3206 Lisp_Object found = *tailp;
3208 /* Unlink the found overlay. */
3209 *tailp = XCDR (found);
3210 /* Move an overlay at RIGHT_PLACE to the next of the found one. */
3211 XCDR (found) = *right_place;
3212 /* Link it into the right place. */
3213 *right_place = found;
3215 else if (end == prev)
3216 tailp = &XCDR (*tailp);
3217 else /* No more disordered overlay. */
3218 break;
3222 DEFUN ("overlayp", Foverlayp, Soverlayp, 1, 1, 0,
3223 "Return t if OBJECT is an overlay.")
3224 (object)
3225 Lisp_Object object;
3227 return (OVERLAYP (object) ? Qt : Qnil);
3230 DEFUN ("make-overlay", Fmake_overlay, Smake_overlay, 2, 5, 0,
3231 "Create a new overlay with range BEG to END in BUFFER.\n\
3232 If omitted, BUFFER defaults to the current buffer.\n\
3233 BEG and END may be integers or markers.\n\
3234 The fourth arg FRONT-ADVANCE, if non-nil, makes the\n\
3235 front delimiter advance when text is inserted there.\n\
3236 The fifth arg REAR-ADVANCE, if non-nil, makes the\n\
3237 rear delimiter advance when text is inserted there.")
3238 (beg, end, buffer, front_advance, rear_advance)
3239 Lisp_Object beg, end, buffer;
3240 Lisp_Object front_advance, rear_advance;
3242 Lisp_Object overlay;
3243 struct buffer *b;
3245 if (NILP (buffer))
3246 XSETBUFFER (buffer, current_buffer);
3247 else
3248 CHECK_BUFFER (buffer, 2);
3249 if (MARKERP (beg)
3250 && ! EQ (Fmarker_buffer (beg), buffer))
3251 error ("Marker points into wrong buffer");
3252 if (MARKERP (end)
3253 && ! EQ (Fmarker_buffer (end), buffer))
3254 error ("Marker points into wrong buffer");
3256 CHECK_NUMBER_COERCE_MARKER (beg, 1);
3257 CHECK_NUMBER_COERCE_MARKER (end, 1);
3259 if (XINT (beg) > XINT (end))
3261 Lisp_Object temp;
3262 temp = beg; beg = end; end = temp;
3265 b = XBUFFER (buffer);
3267 beg = Fset_marker (Fmake_marker (), beg, buffer);
3268 end = Fset_marker (Fmake_marker (), end, buffer);
3270 if (!NILP (front_advance))
3271 XMARKER (beg)->insertion_type = 1;
3272 if (!NILP (rear_advance))
3273 XMARKER (end)->insertion_type = 1;
3275 overlay = allocate_misc ();
3276 XMISCTYPE (overlay) = Lisp_Misc_Overlay;
3277 XOVERLAY (overlay)->start = beg;
3278 XOVERLAY (overlay)->end = end;
3279 XOVERLAY (overlay)->plist = Qnil;
3281 /* Put the new overlay on the wrong list. */
3282 end = OVERLAY_END (overlay);
3283 if (OVERLAY_POSITION (end) < XINT (b->overlay_center))
3284 b->overlays_after = Fcons (overlay, b->overlays_after);
3285 else
3286 b->overlays_before = Fcons (overlay, b->overlays_before);
3288 /* This puts it in the right list, and in the right order. */
3289 recenter_overlay_lists (b, XINT (b->overlay_center));
3291 /* We don't need to redisplay the region covered by the overlay, because
3292 the overlay has no properties at the moment. */
3294 return overlay;
3297 /* Mark a section of BUF as needing redisplay because of overlays changes. */
3299 static void
3300 modify_overlay (buf, start, end)
3301 struct buffer *buf;
3302 int start, end;
3304 if (start == end)
3305 return;
3307 if (start > end)
3309 int temp = start;
3310 start = end; end = temp;
3313 BUF_COMPUTE_UNCHANGED (buf, start, end);
3315 /* If this is a buffer not in the selected window,
3316 we must do other windows. */
3317 if (buf != XBUFFER (XWINDOW (selected_window)->buffer))
3318 windows_or_buffers_changed = 1;
3319 /* If multiple windows show this buffer, we must do other windows. */
3320 else if (buffer_shared > 1)
3321 windows_or_buffers_changed = 1;
3323 ++BUF_OVERLAY_MODIFF (buf);
3326 \f\f
3327 Lisp_Object Fdelete_overlay ();
3329 DEFUN ("move-overlay", Fmove_overlay, Smove_overlay, 3, 4, 0,
3330 "Set the endpoints of OVERLAY to BEG and END in BUFFER.\n\
3331 If BUFFER is omitted, leave OVERLAY in the same buffer it inhabits now.\n\
3332 If BUFFER is omitted, and OVERLAY is in no buffer, put it in the current\n\
3333 buffer.")
3334 (overlay, beg, end, buffer)
3335 Lisp_Object overlay, beg, end, buffer;
3337 struct buffer *b, *ob;
3338 Lisp_Object obuffer;
3339 int count = specpdl_ptr - specpdl;
3341 CHECK_OVERLAY (overlay, 0);
3342 if (NILP (buffer))
3343 buffer = Fmarker_buffer (OVERLAY_START (overlay));
3344 if (NILP (buffer))
3345 XSETBUFFER (buffer, current_buffer);
3346 CHECK_BUFFER (buffer, 3);
3348 if (MARKERP (beg)
3349 && ! EQ (Fmarker_buffer (beg), buffer))
3350 error ("Marker points into wrong buffer");
3351 if (MARKERP (end)
3352 && ! EQ (Fmarker_buffer (end), buffer))
3353 error ("Marker points into wrong buffer");
3355 CHECK_NUMBER_COERCE_MARKER (beg, 1);
3356 CHECK_NUMBER_COERCE_MARKER (end, 1);
3358 if (XINT (beg) == XINT (end) && ! NILP (Foverlay_get (overlay, Qevaporate)))
3359 return Fdelete_overlay (overlay);
3361 if (XINT (beg) > XINT (end))
3363 Lisp_Object temp;
3364 temp = beg; beg = end; end = temp;
3367 specbind (Qinhibit_quit, Qt);
3369 obuffer = Fmarker_buffer (OVERLAY_START (overlay));
3370 b = XBUFFER (buffer);
3371 ob = BUFFERP (obuffer) ? XBUFFER (obuffer) : (struct buffer *) 0;
3373 /* If the overlay has changed buffers, do a thorough redisplay. */
3374 if (!EQ (buffer, obuffer))
3376 /* Redisplay where the overlay was. */
3377 if (!NILP (obuffer))
3379 int o_beg;
3380 int o_end;
3382 o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
3383 o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
3385 modify_overlay (ob, o_beg, o_end);
3388 /* Redisplay where the overlay is going to be. */
3389 modify_overlay (b, XINT (beg), XINT (end));
3391 else
3392 /* Redisplay the area the overlay has just left, or just enclosed. */
3394 int o_beg, o_end;
3396 o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
3397 o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
3399 if (o_beg == XINT (beg))
3400 modify_overlay (b, o_end, XINT (end));
3401 else if (o_end == XINT (end))
3402 modify_overlay (b, o_beg, XINT (beg));
3403 else
3405 if (XINT (beg) < o_beg) o_beg = XINT (beg);
3406 if (XINT (end) > o_end) o_end = XINT (end);
3407 modify_overlay (b, o_beg, o_end);
3411 if (!NILP (obuffer))
3413 ob->overlays_before = Fdelq (overlay, ob->overlays_before);
3414 ob->overlays_after = Fdelq (overlay, ob->overlays_after);
3417 Fset_marker (OVERLAY_START (overlay), beg, buffer);
3418 Fset_marker (OVERLAY_END (overlay), end, buffer);
3420 /* Put the overlay on the wrong list. */
3421 end = OVERLAY_END (overlay);
3422 if (OVERLAY_POSITION (end) < XINT (b->overlay_center))
3423 b->overlays_after = Fcons (overlay, b->overlays_after);
3424 else
3425 b->overlays_before = Fcons (overlay, b->overlays_before);
3427 /* This puts it in the right list, and in the right order. */
3428 recenter_overlay_lists (b, XINT (b->overlay_center));
3430 return unbind_to (count, overlay);
3433 DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0,
3434 "Delete the overlay OVERLAY from its buffer.")
3435 (overlay)
3436 Lisp_Object overlay;
3438 Lisp_Object buffer;
3439 struct buffer *b;
3440 int count = specpdl_ptr - specpdl;
3442 CHECK_OVERLAY (overlay, 0);
3444 buffer = Fmarker_buffer (OVERLAY_START (overlay));
3445 if (NILP (buffer))
3446 return Qnil;
3448 b = XBUFFER (buffer);
3450 specbind (Qinhibit_quit, Qt);
3452 b->overlays_before = Fdelq (overlay, b->overlays_before);
3453 b->overlays_after = Fdelq (overlay, b->overlays_after);
3455 modify_overlay (b,
3456 marker_position (OVERLAY_START (overlay)),
3457 marker_position (OVERLAY_END (overlay)));
3459 Fset_marker (OVERLAY_START (overlay), Qnil, Qnil);
3460 Fset_marker (OVERLAY_END (overlay), Qnil, Qnil);
3462 return unbind_to (count, Qnil);
3465 /* Overlay dissection functions. */
3467 DEFUN ("overlay-start", Foverlay_start, Soverlay_start, 1, 1, 0,
3468 "Return the position at which OVERLAY starts.")
3469 (overlay)
3470 Lisp_Object overlay;
3472 CHECK_OVERLAY (overlay, 0);
3474 return (Fmarker_position (OVERLAY_START (overlay)));
3477 DEFUN ("overlay-end", Foverlay_end, Soverlay_end, 1, 1, 0,
3478 "Return the position at which OVERLAY ends.")
3479 (overlay)
3480 Lisp_Object overlay;
3482 CHECK_OVERLAY (overlay, 0);
3484 return (Fmarker_position (OVERLAY_END (overlay)));
3487 DEFUN ("overlay-buffer", Foverlay_buffer, Soverlay_buffer, 1, 1, 0,
3488 "Return the buffer OVERLAY belongs to.")
3489 (overlay)
3490 Lisp_Object overlay;
3492 CHECK_OVERLAY (overlay, 0);
3494 return Fmarker_buffer (OVERLAY_START (overlay));
3497 DEFUN ("overlay-properties", Foverlay_properties, Soverlay_properties, 1, 1, 0,
3498 "Return a list of the properties on OVERLAY.\n\
3499 This is a copy of OVERLAY's plist; modifying its conses has no effect on\n\
3500 OVERLAY.")
3501 (overlay)
3502 Lisp_Object overlay;
3504 CHECK_OVERLAY (overlay, 0);
3506 return Fcopy_sequence (XOVERLAY (overlay)->plist);
3510 DEFUN ("overlays-at", Foverlays_at, Soverlays_at, 1, 1, 0,
3511 "Return a list of the overlays that contain position POS.")
3512 (pos)
3513 Lisp_Object pos;
3515 int noverlays;
3516 Lisp_Object *overlay_vec;
3517 int len;
3518 Lisp_Object result;
3520 CHECK_NUMBER_COERCE_MARKER (pos, 0);
3522 len = 10;
3523 /* We can't use alloca here because overlays_at can call xrealloc. */
3524 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
3526 /* Put all the overlays we want in a vector in overlay_vec.
3527 Store the length in len. */
3528 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
3529 (int *) 0, (int *) 0, 0);
3531 /* Make a list of them all. */
3532 result = Flist (noverlays, overlay_vec);
3534 xfree (overlay_vec);
3535 return result;
3538 DEFUN ("overlays-in", Foverlays_in, Soverlays_in, 2, 2, 0,
3539 "Return a list of the overlays that overlap the region BEG ... END.\n\
3540 Overlap means that at least one character is contained within the overlay\n\
3541 and also contained within the specified region.\n\
3542 Empty overlays are included in the result if they are located at BEG\n\
3543 or between BEG and END.")
3544 (beg, end)
3545 Lisp_Object beg, end;
3547 int noverlays;
3548 Lisp_Object *overlay_vec;
3549 int len;
3550 Lisp_Object result;
3552 CHECK_NUMBER_COERCE_MARKER (beg, 0);
3553 CHECK_NUMBER_COERCE_MARKER (end, 0);
3555 len = 10;
3556 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
3558 /* Put all the overlays we want in a vector in overlay_vec.
3559 Store the length in len. */
3560 noverlays = overlays_in (XINT (beg), XINT (end), 1, &overlay_vec, &len,
3561 (int *) 0, (int *) 0);
3563 /* Make a list of them all. */
3564 result = Flist (noverlays, overlay_vec);
3566 xfree (overlay_vec);
3567 return result;
3570 DEFUN ("next-overlay-change", Fnext_overlay_change, Snext_overlay_change,
3571 1, 1, 0,
3572 "Return the next position after POS where an overlay starts or ends.\n\
3573 If there are no more overlay boundaries after POS, return (point-max).")
3574 (pos)
3575 Lisp_Object pos;
3577 int noverlays;
3578 int endpos;
3579 Lisp_Object *overlay_vec;
3580 int len;
3581 int i;
3583 CHECK_NUMBER_COERCE_MARKER (pos, 0);
3585 len = 10;
3586 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
3588 /* Put all the overlays we want in a vector in overlay_vec.
3589 Store the length in len.
3590 endpos gets the position where the next overlay starts. */
3591 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
3592 &endpos, (int *) 0, 1);
3594 /* If any of these overlays ends before endpos,
3595 use its ending point instead. */
3596 for (i = 0; i < noverlays; i++)
3598 Lisp_Object oend;
3599 int oendpos;
3601 oend = OVERLAY_END (overlay_vec[i]);
3602 oendpos = OVERLAY_POSITION (oend);
3603 if (oendpos < endpos)
3604 endpos = oendpos;
3607 xfree (overlay_vec);
3608 return make_number (endpos);
3611 DEFUN ("previous-overlay-change", Fprevious_overlay_change,
3612 Sprevious_overlay_change, 1, 1, 0,
3613 "Return the previous position before POS where an overlay starts or ends.\n\
3614 If there are no more overlay boundaries before POS, return (point-min).")
3615 (pos)
3616 Lisp_Object pos;
3618 int noverlays;
3619 int prevpos;
3620 Lisp_Object *overlay_vec;
3621 int len;
3623 CHECK_NUMBER_COERCE_MARKER (pos, 0);
3625 /* At beginning of buffer, we know the answer;
3626 avoid bug subtracting 1 below. */
3627 if (XINT (pos) == BEGV)
3628 return pos;
3630 len = 10;
3631 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
3633 /* Put all the overlays we want in a vector in overlay_vec.
3634 Store the length in len.
3635 prevpos gets the position of the previous change. */
3636 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
3637 (int *) 0, &prevpos, 1);
3639 xfree (overlay_vec);
3640 return make_number (prevpos);
3643 /* These functions are for debugging overlays. */
3645 DEFUN ("overlay-lists", Foverlay_lists, Soverlay_lists, 0, 0, 0,
3646 "Return a pair of lists giving all the overlays of the current buffer.\n\
3647 The car has all the overlays before the overlay center;\n\
3648 the cdr has all the overlays after the overlay center.\n\
3649 Recentering overlays moves overlays between these lists.\n\
3650 The lists you get are copies, so that changing them has no effect.\n\
3651 However, the overlays you get are the real objects that the buffer uses.")
3654 Lisp_Object before, after;
3655 before = current_buffer->overlays_before;
3656 if (CONSP (before))
3657 before = Fcopy_sequence (before);
3658 after = current_buffer->overlays_after;
3659 if (CONSP (after))
3660 after = Fcopy_sequence (after);
3662 return Fcons (before, after);
3665 DEFUN ("overlay-recenter", Foverlay_recenter, Soverlay_recenter, 1, 1, 0,
3666 "Recenter the overlays of the current buffer around position POS.")
3667 (pos)
3668 Lisp_Object pos;
3670 CHECK_NUMBER_COERCE_MARKER (pos, 0);
3672 recenter_overlay_lists (current_buffer, XINT (pos));
3673 return Qnil;
3676 DEFUN ("overlay-get", Foverlay_get, Soverlay_get, 2, 2, 0,
3677 "Get the property of overlay OVERLAY with property name PROP.")
3678 (overlay, prop)
3679 Lisp_Object overlay, prop;
3681 Lisp_Object plist, fallback;
3683 CHECK_OVERLAY (overlay, 0);
3685 fallback = Qnil;
3687 for (plist = XOVERLAY (overlay)->plist;
3688 CONSP (plist) && CONSP (XCDR (plist));
3689 plist = XCDR (XCDR (plist)))
3691 if (EQ (XCAR (plist), prop))
3692 return XCAR (XCDR (plist));
3693 else if (EQ (XCAR (plist), Qcategory))
3695 Lisp_Object tem;
3696 tem = Fcar (Fcdr (plist));
3697 if (SYMBOLP (tem))
3698 fallback = Fget (tem, prop);
3702 return fallback;
3705 DEFUN ("overlay-put", Foverlay_put, Soverlay_put, 3, 3, 0,
3706 "Set one property of overlay OVERLAY: give property PROP value VALUE.")
3707 (overlay, prop, value)
3708 Lisp_Object overlay, prop, value;
3710 Lisp_Object tail, buffer;
3711 int changed;
3713 CHECK_OVERLAY (overlay, 0);
3715 buffer = Fmarker_buffer (OVERLAY_START (overlay));
3717 for (tail = XOVERLAY (overlay)->plist;
3718 CONSP (tail) && CONSP (XCDR (tail));
3719 tail = XCDR (XCDR (tail)))
3720 if (EQ (XCAR (tail), prop))
3722 changed = !EQ (XCAR (XCDR (tail)), value);
3723 XCAR (XCDR (tail)) = value;
3724 goto found;
3726 /* It wasn't in the list, so add it to the front. */
3727 changed = !NILP (value);
3728 XOVERLAY (overlay)->plist
3729 = Fcons (prop, Fcons (value, XOVERLAY (overlay)->plist));
3730 found:
3731 if (! NILP (buffer))
3733 if (changed)
3734 modify_overlay (XBUFFER (buffer),
3735 marker_position (OVERLAY_START (overlay)),
3736 marker_position (OVERLAY_END (overlay)));
3737 if (EQ (prop, Qevaporate) && ! NILP (value)
3738 && (OVERLAY_POSITION (OVERLAY_START (overlay))
3739 == OVERLAY_POSITION (OVERLAY_END (overlay))))
3740 Fdelete_overlay (overlay);
3742 return value;
3745 /* Subroutine of report_overlay_modification. */
3747 /* Lisp vector holding overlay hook functions to call.
3748 Vector elements come in pairs.
3749 Each even-index element is a list of hook functions.
3750 The following odd-index element is the overlay they came from.
3752 Before the buffer change, we fill in this vector
3753 as we call overlay hook functions.
3754 After the buffer change, we get the functions to call from this vector.
3755 This way we always call the same functions before and after the change. */
3756 static Lisp_Object last_overlay_modification_hooks;
3758 /* Number of elements actually used in last_overlay_modification_hooks. */
3759 static int last_overlay_modification_hooks_used;
3761 /* Add one functionlist/overlay pair
3762 to the end of last_overlay_modification_hooks. */
3764 static void
3765 add_overlay_mod_hooklist (functionlist, overlay)
3766 Lisp_Object functionlist, overlay;
3768 int oldsize = XVECTOR (last_overlay_modification_hooks)->size;
3770 if (last_overlay_modification_hooks_used == oldsize)
3772 Lisp_Object old;
3773 old = last_overlay_modification_hooks;
3774 last_overlay_modification_hooks
3775 = Fmake_vector (make_number (oldsize * 2), Qnil);
3776 bcopy (XVECTOR (old)->contents,
3777 XVECTOR (last_overlay_modification_hooks)->contents,
3778 sizeof (Lisp_Object) * oldsize);
3780 XVECTOR (last_overlay_modification_hooks)->contents[last_overlay_modification_hooks_used++] = functionlist;
3781 XVECTOR (last_overlay_modification_hooks)->contents[last_overlay_modification_hooks_used++] = overlay;
3784 /* Run the modification-hooks of overlays that include
3785 any part of the text in START to END.
3786 If this change is an insertion, also
3787 run the insert-before-hooks of overlay starting at END,
3788 and the insert-after-hooks of overlay ending at START.
3790 This is called both before and after the modification.
3791 AFTER is nonzero when we call after the modification.
3793 ARG1, ARG2, ARG3 are arguments to pass to the hook functions.
3794 When AFTER is nonzero, they are the start position,
3795 the position after the inserted new text,
3796 and the length of deleted or replaced old text. */
3798 void
3799 report_overlay_modification (start, end, after, arg1, arg2, arg3)
3800 Lisp_Object start, end;
3801 int after;
3802 Lisp_Object arg1, arg2, arg3;
3804 Lisp_Object prop, overlay, tail;
3805 /* 1 if this change is an insertion. */
3806 int insertion = (after ? XFASTINT (arg3) == 0 : EQ (start, end));
3807 int tail_copied;
3808 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
3810 overlay = Qnil;
3811 tail = Qnil;
3812 GCPRO5 (overlay, tail, arg1, arg2, arg3);
3814 if (after)
3816 /* Call the functions recorded in last_overlay_modification_hooks
3817 rather than scanning the overlays again.
3818 First copy the vector contents, in case some of these hooks
3819 do subsequent modification of the buffer. */
3820 int size = last_overlay_modification_hooks_used;
3821 Lisp_Object *copy = (Lisp_Object *) alloca (size * sizeof (Lisp_Object));
3822 int i;
3824 bcopy (XVECTOR (last_overlay_modification_hooks)->contents,
3825 copy, size * sizeof (Lisp_Object));
3826 gcpro1.var = copy;
3827 gcpro1.nvars = size;
3829 for (i = 0; i < size;)
3831 Lisp_Object prop, overlay;
3832 prop = copy[i++];
3833 overlay = copy[i++];
3834 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
3836 UNGCPRO;
3837 return;
3840 /* We are being called before a change.
3841 Scan the overlays to find the functions to call. */
3842 last_overlay_modification_hooks_used = 0;
3843 tail_copied = 0;
3844 for (tail = current_buffer->overlays_before;
3845 CONSP (tail);
3846 tail = XCDR (tail))
3848 int startpos, endpos;
3849 Lisp_Object ostart, oend;
3851 overlay = XCAR (tail);
3853 ostart = OVERLAY_START (overlay);
3854 oend = OVERLAY_END (overlay);
3855 endpos = OVERLAY_POSITION (oend);
3856 if (XFASTINT (start) > endpos)
3857 break;
3858 startpos = OVERLAY_POSITION (ostart);
3859 if (insertion && (XFASTINT (start) == startpos
3860 || XFASTINT (end) == startpos))
3862 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
3863 if (!NILP (prop))
3865 /* Copy TAIL in case the hook recenters the overlay lists. */
3866 if (!tail_copied)
3867 tail = Fcopy_sequence (tail);
3868 tail_copied = 1;
3869 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
3872 if (insertion && (XFASTINT (start) == endpos
3873 || XFASTINT (end) == endpos))
3875 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
3876 if (!NILP (prop))
3878 if (!tail_copied)
3879 tail = Fcopy_sequence (tail);
3880 tail_copied = 1;
3881 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
3884 /* Test for intersecting intervals. This does the right thing
3885 for both insertion and deletion. */
3886 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
3888 prop = Foverlay_get (overlay, Qmodification_hooks);
3889 if (!NILP (prop))
3891 if (!tail_copied)
3892 tail = Fcopy_sequence (tail);
3893 tail_copied = 1;
3894 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
3899 tail_copied = 0;
3900 for (tail = current_buffer->overlays_after;
3901 CONSP (tail);
3902 tail = XCDR (tail))
3904 int startpos, endpos;
3905 Lisp_Object ostart, oend;
3907 overlay = XCAR (tail);
3909 ostart = OVERLAY_START (overlay);
3910 oend = OVERLAY_END (overlay);
3911 startpos = OVERLAY_POSITION (ostart);
3912 endpos = OVERLAY_POSITION (oend);
3913 if (XFASTINT (end) < startpos)
3914 break;
3915 if (insertion && (XFASTINT (start) == startpos
3916 || XFASTINT (end) == startpos))
3918 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
3919 if (!NILP (prop))
3921 if (!tail_copied)
3922 tail = Fcopy_sequence (tail);
3923 tail_copied = 1;
3924 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
3927 if (insertion && (XFASTINT (start) == endpos
3928 || XFASTINT (end) == endpos))
3930 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
3931 if (!NILP (prop))
3933 if (!tail_copied)
3934 tail = Fcopy_sequence (tail);
3935 tail_copied = 1;
3936 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
3939 /* Test for intersecting intervals. This does the right thing
3940 for both insertion and deletion. */
3941 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
3943 prop = Foverlay_get (overlay, Qmodification_hooks);
3944 if (!NILP (prop))
3946 if (!tail_copied)
3947 tail = Fcopy_sequence (tail);
3948 tail_copied = 1;
3949 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
3954 UNGCPRO;
3957 static void
3958 call_overlay_mod_hooks (list, overlay, after, arg1, arg2, arg3)
3959 Lisp_Object list, overlay;
3960 int after;
3961 Lisp_Object arg1, arg2, arg3;
3963 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3965 GCPRO4 (list, arg1, arg2, arg3);
3966 if (! after)
3967 add_overlay_mod_hooklist (list, overlay);
3969 while (!NILP (list))
3971 if (NILP (arg3))
3972 call4 (Fcar (list), overlay, after ? Qt : Qnil, arg1, arg2);
3973 else
3974 call5 (Fcar (list), overlay, after ? Qt : Qnil, arg1, arg2, arg3);
3975 list = Fcdr (list);
3977 UNGCPRO;
3980 /* Delete any zero-sized overlays at position POS, if the `evaporate'
3981 property is set. */
3982 void
3983 evaporate_overlays (pos)
3984 int pos;
3986 Lisp_Object tail, overlay, hit_list;
3988 hit_list = Qnil;
3989 if (pos <= XFASTINT (current_buffer->overlay_center))
3990 for (tail = current_buffer->overlays_before; CONSP (tail);
3991 tail = XCDR (tail))
3993 int endpos;
3994 overlay = XCAR (tail);
3995 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3996 if (endpos < pos)
3997 break;
3998 if (endpos == pos && OVERLAY_POSITION (OVERLAY_START (overlay)) == pos
3999 && ! NILP (Foverlay_get (overlay, Qevaporate)))
4000 hit_list = Fcons (overlay, hit_list);
4002 else
4003 for (tail = current_buffer->overlays_after; CONSP (tail);
4004 tail = XCDR (tail))
4006 int startpos;
4007 overlay = XCAR (tail);
4008 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
4009 if (startpos > pos)
4010 break;
4011 if (startpos == pos && OVERLAY_POSITION (OVERLAY_END (overlay)) == pos
4012 && ! NILP (Foverlay_get (overlay, Qevaporate)))
4013 hit_list = Fcons (overlay, hit_list);
4015 for (; CONSP (hit_list); hit_list = XCDR (hit_list))
4016 Fdelete_overlay (XCAR (hit_list));
4019 /* Somebody has tried to store a value with an unacceptable type
4020 in the slot with offset OFFSET. */
4022 void
4023 buffer_slot_type_mismatch (offset)
4024 int offset;
4026 Lisp_Object sym;
4027 char *type_name;
4029 switch (XINT (PER_BUFFER_TYPE (offset)))
4031 case Lisp_Int:
4032 type_name = "integers";
4033 break;
4035 case Lisp_String:
4036 type_name = "strings";
4037 break;
4039 case Lisp_Symbol:
4040 type_name = "symbols";
4041 break;
4043 default:
4044 abort ();
4047 sym = PER_BUFFER_SYMBOL (offset);
4048 error ("Only %s should be stored in the buffer-local variable %s",
4049 type_name, XSYMBOL (sym)->name->data);
4053 void
4054 init_buffer_once ()
4056 int idx;
4058 bzero (buffer_permanent_local_flags, sizeof buffer_permanent_local_flags);
4060 /* Make sure all markable slots in buffer_defaults
4061 are initialized reasonably, so mark_buffer won't choke. */
4062 reset_buffer (&buffer_defaults);
4063 reset_buffer_local_variables (&buffer_defaults, 1);
4064 reset_buffer (&buffer_local_symbols);
4065 reset_buffer_local_variables (&buffer_local_symbols, 1);
4066 /* Prevent GC from getting confused. */
4067 buffer_defaults.text = &buffer_defaults.own_text;
4068 buffer_local_symbols.text = &buffer_local_symbols.own_text;
4069 BUF_INTERVALS (&buffer_defaults) = 0;
4070 BUF_INTERVALS (&buffer_local_symbols) = 0;
4071 XSETBUFFER (Vbuffer_defaults, &buffer_defaults);
4072 XSETBUFFER (Vbuffer_local_symbols, &buffer_local_symbols);
4074 /* Set up the default values of various buffer slots. */
4075 /* Must do these before making the first buffer! */
4077 /* real setup is done in bindings.el */
4078 buffer_defaults.mode_line_format = build_string ("%-");
4079 buffer_defaults.header_line_format = Qnil;
4080 buffer_defaults.abbrev_mode = Qnil;
4081 buffer_defaults.overwrite_mode = Qnil;
4082 buffer_defaults.case_fold_search = Qt;
4083 buffer_defaults.auto_fill_function = Qnil;
4084 buffer_defaults.selective_display = Qnil;
4085 #ifndef old
4086 buffer_defaults.selective_display_ellipses = Qt;
4087 #endif
4088 buffer_defaults.abbrev_table = Qnil;
4089 buffer_defaults.display_table = Qnil;
4090 buffer_defaults.undo_list = Qnil;
4091 buffer_defaults.mark_active = Qnil;
4092 buffer_defaults.file_format = Qnil;
4093 buffer_defaults.overlays_before = Qnil;
4094 buffer_defaults.overlays_after = Qnil;
4095 XSETFASTINT (buffer_defaults.overlay_center, BEG);
4097 XSETFASTINT (buffer_defaults.tab_width, 8);
4098 buffer_defaults.truncate_lines = Qnil;
4099 buffer_defaults.ctl_arrow = Qt;
4100 buffer_defaults.direction_reversed = Qnil;
4101 buffer_defaults.cursor_type = Qt;
4102 buffer_defaults.extra_line_spacing = Qnil;
4104 #ifdef DOS_NT
4105 buffer_defaults.buffer_file_type = Qnil; /* TEXT */
4106 #endif
4107 buffer_defaults.enable_multibyte_characters = Qt;
4108 buffer_defaults.buffer_file_coding_system = Qnil;
4109 XSETFASTINT (buffer_defaults.fill_column, 70);
4110 XSETFASTINT (buffer_defaults.left_margin, 0);
4111 buffer_defaults.cache_long_line_scans = Qnil;
4112 buffer_defaults.file_truename = Qnil;
4113 XSETFASTINT (buffer_defaults.display_count, 0);
4114 buffer_defaults.indicate_empty_lines = Qnil;
4115 buffer_defaults.scroll_up_aggressively = Qnil;
4116 buffer_defaults.scroll_down_aggressively = Qnil;
4117 buffer_defaults.display_time = Qnil;
4119 /* Assign the local-flags to the slots that have default values.
4120 The local flag is a bit that is used in the buffer
4121 to say that it has its own local value for the slot.
4122 The local flag bits are in the local_var_flags slot of the buffer. */
4124 /* Nothing can work if this isn't true */
4125 if (sizeof (EMACS_INT) != sizeof (Lisp_Object)) abort ();
4127 /* 0 means not a lisp var, -1 means always local, else mask */
4128 bzero (&buffer_local_flags, sizeof buffer_local_flags);
4129 XSETINT (buffer_local_flags.filename, -1);
4130 XSETINT (buffer_local_flags.directory, -1);
4131 XSETINT (buffer_local_flags.backed_up, -1);
4132 XSETINT (buffer_local_flags.save_length, -1);
4133 XSETINT (buffer_local_flags.auto_save_file_name, -1);
4134 XSETINT (buffer_local_flags.read_only, -1);
4135 XSETINT (buffer_local_flags.major_mode, -1);
4136 XSETINT (buffer_local_flags.mode_name, -1);
4137 XSETINT (buffer_local_flags.undo_list, -1);
4138 XSETINT (buffer_local_flags.mark_active, -1);
4139 XSETINT (buffer_local_flags.point_before_scroll, -1);
4140 XSETINT (buffer_local_flags.file_truename, -1);
4141 XSETINT (buffer_local_flags.invisibility_spec, -1);
4142 XSETINT (buffer_local_flags.file_format, -1);
4143 XSETINT (buffer_local_flags.display_count, -1);
4144 XSETINT (buffer_local_flags.display_time, -1);
4145 XSETINT (buffer_local_flags.enable_multibyte_characters, -1);
4147 idx = 1;
4148 XSETFASTINT (buffer_local_flags.mode_line_format, idx); ++idx;
4149 XSETFASTINT (buffer_local_flags.abbrev_mode, idx); ++idx;
4150 XSETFASTINT (buffer_local_flags.overwrite_mode, idx); ++idx;
4151 XSETFASTINT (buffer_local_flags.case_fold_search, idx); ++idx;
4152 XSETFASTINT (buffer_local_flags.auto_fill_function, idx); ++idx;
4153 XSETFASTINT (buffer_local_flags.selective_display, idx); ++idx;
4154 #ifndef old
4155 XSETFASTINT (buffer_local_flags.selective_display_ellipses, idx); ++idx;
4156 #endif
4157 XSETFASTINT (buffer_local_flags.tab_width, idx); ++idx;
4158 XSETFASTINT (buffer_local_flags.truncate_lines, idx); ++idx;
4159 XSETFASTINT (buffer_local_flags.ctl_arrow, idx); ++idx;
4160 XSETFASTINT (buffer_local_flags.fill_column, idx); ++idx;
4161 XSETFASTINT (buffer_local_flags.left_margin, idx); ++idx;
4162 XSETFASTINT (buffer_local_flags.abbrev_table, idx); ++idx;
4163 XSETFASTINT (buffer_local_flags.display_table, idx); ++idx;
4164 #ifdef DOS_NT
4165 XSETFASTINT (buffer_local_flags.buffer_file_type, idx);
4166 /* Make this one a permanent local. */
4167 buffer_permanent_local_flags[idx++] = 1;
4168 #endif
4169 XSETFASTINT (buffer_local_flags.syntax_table, idx); ++idx;
4170 XSETFASTINT (buffer_local_flags.cache_long_line_scans, idx); ++idx;
4171 XSETFASTINT (buffer_local_flags.category_table, idx); ++idx;
4172 XSETFASTINT (buffer_local_flags.direction_reversed, idx); ++idx;
4173 XSETFASTINT (buffer_local_flags.buffer_file_coding_system, idx);
4174 /* Make this one a permanent local. */
4175 buffer_permanent_local_flags[idx++] = 1;
4176 XSETFASTINT (buffer_local_flags.left_margin_width, idx); ++idx;
4177 XSETFASTINT (buffer_local_flags.right_margin_width, idx); ++idx;
4178 XSETFASTINT (buffer_local_flags.indicate_empty_lines, idx); ++idx;
4179 XSETFASTINT (buffer_local_flags.scroll_up_aggressively, idx); ++idx;
4180 XSETFASTINT (buffer_local_flags.scroll_down_aggressively, idx); ++idx;
4181 XSETFASTINT (buffer_local_flags.header_line_format, idx); ++idx;
4182 XSETFASTINT (buffer_local_flags.cursor_type, idx); ++idx;
4183 XSETFASTINT (buffer_local_flags.extra_line_spacing, idx); ++idx;
4185 /* Need more room? */
4186 if (idx >= MAX_PER_BUFFER_VARS)
4187 abort ();
4188 last_per_buffer_idx = idx;
4190 Vbuffer_alist = Qnil;
4191 current_buffer = 0;
4192 all_buffers = 0;
4194 QSFundamental = build_string ("Fundamental");
4196 Qfundamental_mode = intern ("fundamental-mode");
4197 buffer_defaults.major_mode = Qfundamental_mode;
4199 Qmode_class = intern ("mode-class");
4201 Qprotected_field = intern ("protected-field");
4203 Qpermanent_local = intern ("permanent-local");
4205 Qkill_buffer_hook = intern ("kill-buffer-hook");
4207 Vprin1_to_string_buffer = Fget_buffer_create (build_string (" prin1"));
4209 /* super-magic invisible buffer */
4210 Vbuffer_alist = Qnil;
4212 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
4214 inhibit_modification_hooks = 0;
4217 void
4218 init_buffer ()
4220 char buf[MAXPATHLEN+1];
4221 char *pwd;
4222 struct stat dotstat, pwdstat;
4223 Lisp_Object temp;
4224 int rc;
4226 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
4227 if (NILP (buffer_defaults.enable_multibyte_characters))
4228 Fset_buffer_multibyte (Qnil);
4230 /* If PWD is accurate, use it instead of calling getwd. This is faster
4231 when PWD is right, and may avoid a fatal error. */
4232 if ((pwd = getenv ("PWD")) != 0
4233 && (IS_DIRECTORY_SEP (*pwd) || (*pwd && IS_DEVICE_SEP (pwd[1])))
4234 && stat (pwd, &pwdstat) == 0
4235 && stat (".", &dotstat) == 0
4236 && dotstat.st_ino == pwdstat.st_ino
4237 && dotstat.st_dev == pwdstat.st_dev
4238 && strlen (pwd) < MAXPATHLEN)
4239 strcpy (buf, pwd);
4240 #ifdef HAVE_GETCWD
4241 else if (getcwd (buf, MAXPATHLEN+1) == 0)
4242 fatal ("`getcwd' failed: %s\n", strerror (errno));
4243 #else
4244 else if (getwd (buf) == 0)
4245 fatal ("`getwd' failed: %s\n", buf);
4246 #endif
4248 #ifndef VMS
4249 /* Maybe this should really use some standard subroutine
4250 whose definition is filename syntax dependent. */
4251 rc = strlen (buf);
4252 if (!(IS_DIRECTORY_SEP (buf[rc - 1])))
4254 buf[rc] = DIRECTORY_SEP;
4255 buf[rc + 1] = '\0';
4257 #endif /* not VMS */
4259 current_buffer->directory = build_string (buf);
4261 /* Add /: to the front of the name
4262 if it would otherwise be treated as magic. */
4263 temp = Ffind_file_name_handler (current_buffer->directory, Qt);
4264 if (! NILP (temp)
4265 /* If the default dir is just /, TEMP is non-nil
4266 because of the ange-ftp completion handler.
4267 However, it is not necessary to turn / into /:/.
4268 So avoid doing that. */
4269 && strcmp ("/", XSTRING (current_buffer->directory)->data))
4270 current_buffer->directory
4271 = concat2 (build_string ("/:"), current_buffer->directory);
4273 temp = get_minibuffer (0);
4274 XBUFFER (temp)->directory = current_buffer->directory;
4277 /* initialize the buffer routines */
4278 void
4279 syms_of_buffer ()
4281 staticpro (&last_overlay_modification_hooks);
4282 last_overlay_modification_hooks
4283 = Fmake_vector (make_number (10), Qnil);
4285 staticpro (&Vbuffer_defaults);
4286 staticpro (&Vbuffer_local_symbols);
4287 staticpro (&Qfundamental_mode);
4288 staticpro (&Qmode_class);
4289 staticpro (&QSFundamental);
4290 staticpro (&Vbuffer_alist);
4291 staticpro (&Qprotected_field);
4292 staticpro (&Qpermanent_local);
4293 staticpro (&Qkill_buffer_hook);
4294 Qoverlayp = intern ("overlayp");
4295 staticpro (&Qoverlayp);
4296 Qevaporate = intern ("evaporate");
4297 staticpro (&Qevaporate);
4298 Qmodification_hooks = intern ("modification-hooks");
4299 staticpro (&Qmodification_hooks);
4300 Qinsert_in_front_hooks = intern ("insert-in-front-hooks");
4301 staticpro (&Qinsert_in_front_hooks);
4302 Qinsert_behind_hooks = intern ("insert-behind-hooks");
4303 staticpro (&Qinsert_behind_hooks);
4304 Qget_file_buffer = intern ("get-file-buffer");
4305 staticpro (&Qget_file_buffer);
4306 Qpriority = intern ("priority");
4307 staticpro (&Qpriority);
4308 Qwindow = intern ("window");
4309 staticpro (&Qwindow);
4310 Qbefore_string = intern ("before-string");
4311 staticpro (&Qbefore_string);
4312 Qafter_string = intern ("after-string");
4313 staticpro (&Qafter_string);
4314 Qfirst_change_hook = intern ("first-change-hook");
4315 staticpro (&Qfirst_change_hook);
4316 Qbefore_change_functions = intern ("before-change-functions");
4317 staticpro (&Qbefore_change_functions);
4318 Qafter_change_functions = intern ("after-change-functions");
4319 staticpro (&Qafter_change_functions);
4321 Fput (Qprotected_field, Qerror_conditions,
4322 Fcons (Qprotected_field, Fcons (Qerror, Qnil)));
4323 Fput (Qprotected_field, Qerror_message,
4324 build_string ("Attempt to modify a protected field"));
4326 /* All these use DEFVAR_LISP_NOPRO because the slots in
4327 buffer_defaults will all be marked via Vbuffer_defaults. */
4329 DEFVAR_LISP_NOPRO ("default-mode-line-format",
4330 &buffer_defaults.mode_line_format,
4331 "Default value of `mode-line-format' for buffers that don't override it.\n\
4332 This is the same as (default-value 'mode-line-format).");
4334 DEFVAR_LISP_NOPRO ("default-header-line-format",
4335 &buffer_defaults.header_line_format,
4336 "Default value of `header-line-format' for buffers that don't override it.\n\
4337 This is the same as (default-value 'header-line-format).");
4339 DEFVAR_LISP_NOPRO ("default-cursor-type", &buffer_defaults.cursor_type,
4340 "Default value of `cursor-type' for buffers that don't override it.\n\
4341 This is the same as (default-value 'cursor-type).");
4343 DEFVAR_LISP_NOPRO ("default-line-spacing",
4344 &buffer_defaults.extra_line_spacing,
4345 "Default value of `line-spacing' for buffers that don't override it.\n\
4346 This is the same as (default-value 'line-spacing).");
4348 DEFVAR_LISP_NOPRO ("default-abbrev-mode",
4349 &buffer_defaults.abbrev_mode,
4350 "Default value of `abbrev-mode' for buffers that do not override it.\n\
4351 This is the same as (default-value 'abbrev-mode).");
4353 DEFVAR_LISP_NOPRO ("default-ctl-arrow",
4354 &buffer_defaults.ctl_arrow,
4355 "Default value of `ctl-arrow' for buffers that do not override it.\n\
4356 This is the same as (default-value 'ctl-arrow).");
4358 DEFVAR_LISP_NOPRO ("default-direction-reversed",
4359 &buffer_defaults.direction_reversed,
4360 "Default value of `direction_reversed' for buffers that do not override it.\n\
4361 This is the same as (default-value 'direction-reversed).");
4363 DEFVAR_LISP_NOPRO ("default-enable-multibyte-characters",
4364 &buffer_defaults.enable_multibyte_characters,
4365 "*Default value of `enable-multibyte-characters' for buffers not overriding it.\n\
4366 This is the same as (default-value 'enable-multibyte-characters).");
4368 DEFVAR_LISP_NOPRO ("default-buffer-file-coding-system",
4369 &buffer_defaults.buffer_file_coding_system,
4370 "Default value of `buffer-file-coding-system' for buffers not overriding it.\n\
4371 This is the same as (default-value 'buffer-file-coding-system).");
4373 DEFVAR_LISP_NOPRO ("default-truncate-lines",
4374 &buffer_defaults.truncate_lines,
4375 "Default value of `truncate-lines' for buffers that do not override it.\n\
4376 This is the same as (default-value 'truncate-lines).");
4378 DEFVAR_LISP_NOPRO ("default-fill-column",
4379 &buffer_defaults.fill_column,
4380 "Default value of `fill-column' for buffers that do not override it.\n\
4381 This is the same as (default-value 'fill-column).");
4383 DEFVAR_LISP_NOPRO ("default-left-margin",
4384 &buffer_defaults.left_margin,
4385 "Default value of `left-margin' for buffers that do not override it.\n\
4386 This is the same as (default-value 'left-margin).");
4388 DEFVAR_LISP_NOPRO ("default-tab-width",
4389 &buffer_defaults.tab_width,
4390 "Default value of `tab-width' for buffers that do not override it.\n\
4391 This is the same as (default-value 'tab-width).");
4393 DEFVAR_LISP_NOPRO ("default-case-fold-search",
4394 &buffer_defaults.case_fold_search,
4395 "Default value of `case-fold-search' for buffers that don't override it.\n\
4396 This is the same as (default-value 'case-fold-search).");
4398 #ifdef DOS_NT
4399 DEFVAR_LISP_NOPRO ("default-buffer-file-type",
4400 &buffer_defaults.buffer_file_type,
4401 "Default file type for buffers that do not override it.\n\
4402 This is the same as (default-value 'buffer-file-type).\n\
4403 The file type is nil for text, t for binary.");
4404 #endif
4406 DEFVAR_LISP_NOPRO ("default-left-margin-width",
4407 &buffer_defaults.left_margin_width,
4408 "Default value of `left-margin-width' for buffers that don't override it.\n\
4409 This is the same as (default-value 'left-margin-width).");
4411 DEFVAR_LISP_NOPRO ("default-right-margin-width",
4412 &buffer_defaults.right_margin_width,
4413 "Default value of `right_margin_width' for buffers that don't override it.\n\
4414 This is the same as (default-value 'right-margin-width).");
4416 DEFVAR_LISP_NOPRO ("default-indicate-empty-lines",
4417 &buffer_defaults.indicate_empty_lines,
4418 "Default value of `indicate-empty-lines' for buffers that don't override it.\n\
4419 This is the same as (default-value 'indicate-empty-lines).");
4421 DEFVAR_LISP_NOPRO ("default-scroll-up-aggressively",
4422 &buffer_defaults.scroll_up_aggressively,
4423 "Default value of `scroll-up-aggressively' for buffers that\n\
4424 don't override it. This is the same as (default-value\n\
4425 'scroll-up-aggressively).");
4427 DEFVAR_LISP_NOPRO ("default-scroll-down-aggressively",
4428 &buffer_defaults.scroll_down_aggressively,
4429 "Default value of `scroll-down-aggressively' for buffers that\n\
4430 don't override it. This is the same as (default-value\n\
4431 'scroll-down-aggressively).");
4433 DEFVAR_PER_BUFFER ("header-line-format",
4434 &current_buffer->header_line_format,
4435 Qnil,
4436 "Analogous to `mode-line-format', but for a mode line displayed\n\
4437 at the top of windows.");
4439 DEFVAR_PER_BUFFER ("mode-line-format", &current_buffer->mode_line_format,
4440 Qnil, 0);
4442 /* This doc string is too long for cpp; cpp dies if it isn't in a comment.
4443 But make-docfile finds it!
4444 DEFVAR_PER_BUFFER ("mode-line-format", &current_buffer->mode_line_format,
4445 Qnil,
4446 "Template for displaying mode line for current buffer.\n\
4447 Each buffer has its own value of this variable.\n\
4448 Value may be nil, a string, a symbol or a list or cons cell.\n\
4449 A value of nil means don't display a mode line.\n\
4450 For a symbol, its value is used (but it is ignored if t or nil).\n\
4451 A string appearing directly as the value of a symbol is processed verbatim\n\
4452 in that the %-constructs below are not recognized.\n\
4453 For a list of the form `(:eval FORM)', FORM is evaluated and the result\n\
4454 is used as a mode line element.\n\
4455 For a list whose car is a symbol, the symbol's value is taken,\n\
4456 and if that is non-nil, the cadr of the list is processed recursively.\n\
4457 Otherwise, the caddr of the list (if there is one) is processed.\n\
4458 For a list whose car is a string or list, each element is processed\n\
4459 recursively and the results are effectively concatenated.\n\
4460 For a list whose car is an integer, the cdr of the list is processed\n\
4461 and padded (if the number is positive) or truncated (if negative)\n\
4462 to the width specified by that number.\n\
4463 A string is printed verbatim in the mode line except for %-constructs:\n\
4464 (%-constructs are allowed when the string is the entire mode-line-format\n\
4465 or when it is found in a cons-cell or a list)\n\
4466 %b -- print buffer name. %f -- print visited file name.\n\
4467 %F -- print frame name.\n\
4468 %* -- print %, * or hyphen. %+ -- print *, % or hyphen.\n\
4469 %& is like %*, but ignore read-only-ness.\n\
4470 % means buffer is read-only and * means it is modified.\n\
4471 For a modified read-only buffer, %* gives % and %+ gives *.\n\
4472 %s -- print process status. %l -- print the current line number.\n\
4473 %c -- print the current column number (this makes editing slower).\n\
4474 To make the column number update correctly in all cases,\n\
4475 `column-number-mode' must be non-nil.\n\
4476 %p -- print percent of buffer above top of window, or Top, Bot or All.\n\
4477 %P -- print percent of buffer above bottom of window, perhaps plus Top,\n\
4478 or print Bottom or All.\n\
4479 %m -- print the mode name.\n\
4480 %n -- print Narrow if appropriate.\n\
4481 %z -- print mnemonics of buffer, terminal, and keyboard coding systems.\n\
4482 %Z -- like %z, but including the end-of-line format.\n\
4483 %[ -- print one [ for each recursive editing level. %] similar.\n\
4484 %% -- print %. %- -- print infinitely many dashes.\n\
4485 Decimal digits after the % specify field width to which to pad.");
4488 DEFVAR_LISP_NOPRO ("default-major-mode", &buffer_defaults.major_mode,
4489 "*Major mode for new buffers. Defaults to `fundamental-mode'.\n\
4490 nil here means use current buffer's major mode.");
4492 DEFVAR_PER_BUFFER ("major-mode", &current_buffer->major_mode,
4493 make_number (Lisp_Symbol),
4494 "Symbol for current buffer's major mode.");
4496 DEFVAR_PER_BUFFER ("mode-name", &current_buffer->mode_name,
4497 make_number (Lisp_String),
4498 "Pretty name of current buffer's major mode (a string).");
4500 DEFVAR_PER_BUFFER ("abbrev-mode", &current_buffer->abbrev_mode, Qnil,
4501 "Non-nil turns on automatic expansion of abbrevs as they are inserted.\n\
4502 Automatically becomes buffer-local when set in any fashion.");
4504 DEFVAR_PER_BUFFER ("case-fold-search", &current_buffer->case_fold_search,
4505 Qnil,
4506 "*Non-nil if searches and matches should ignore case.\n\
4507 Automatically becomes buffer-local when set in any fashion.");
4509 DEFVAR_PER_BUFFER ("fill-column", &current_buffer->fill_column,
4510 make_number (Lisp_Int),
4511 "*Column beyond which automatic line-wrapping should happen.\n\
4512 Automatically becomes buffer-local when set in any fashion.");
4514 DEFVAR_PER_BUFFER ("left-margin", &current_buffer->left_margin,
4515 make_number (Lisp_Int),
4516 "*Column for the default indent-line-function to indent to.\n\
4517 Linefeed indents to this column in Fundamental mode.\n\
4518 Automatically becomes buffer-local when set in any fashion.");
4520 DEFVAR_PER_BUFFER ("tab-width", &current_buffer->tab_width,
4521 make_number (Lisp_Int),
4522 "*Distance between tab stops (for display of tab characters), in columns.\n\
4523 Automatically becomes buffer-local when set in any fashion.");
4525 DEFVAR_PER_BUFFER ("ctl-arrow", &current_buffer->ctl_arrow, Qnil,
4526 "*Non-nil means display control chars with uparrow.\n\
4527 A value of nil means use backslash and octal digits.\n\
4528 Automatically becomes buffer-local when set in any fashion.\n\
4529 This variable does not apply to characters whose display is specified\n\
4530 in the current display table (if there is one).");
4532 DEFVAR_PER_BUFFER ("enable-multibyte-characters",
4533 &current_buffer->enable_multibyte_characters,
4534 make_number (-1),
4535 "Non-nil means the buffer contents are regarded as multi-byte characters.\n\
4536 Otherwise they are regarded as unibyte. This affects the display,\n\
4537 file I/O and the behavior of various editing commands.\n\
4539 This variable is buffer-local but you cannot set it directly;\n\
4540 use the function `set-buffer-multibyte' to change a buffer's representation.\n\
4541 Changing its default value with `setq-default' is supported.\n\
4542 See also variable `default-enable-multibyte-characters' and Info node\n\
4543 `(elisp)Text Representations'.");
4545 DEFVAR_PER_BUFFER ("buffer-file-coding-system",
4546 &current_buffer->buffer_file_coding_system, Qnil,
4547 "Coding system to be used for encoding the buffer contents on saving.\n\
4548 This variable applies to saving the buffer, and also to `write-region'\n\
4549 and other functions that use `write-region'.\n\
4550 It does not apply to sending output to subprocesses, however.\n\
4552 If this is nil, the buffer is saved without any code conversion\n\
4553 unless some coding system is specified in `file-coding-system-alist'\n\
4554 for the buffer file.\n\
4556 The variable `coding-system-for-write', if non-nil, overrides this variable.\n\
4558 This variable is never applied to a way of decoding\n\
4559 a file while reading it.");
4561 DEFVAR_PER_BUFFER ("direction-reversed", &current_buffer->direction_reversed,
4562 Qnil,
4563 "*Non-nil means lines in the buffer are displayed right to left.");
4565 DEFVAR_PER_BUFFER ("truncate-lines", &current_buffer->truncate_lines, Qnil,
4566 "*Non-nil means do not display continuation lines;\n\
4567 give each line of text one screen line.\n\
4568 Automatically becomes buffer-local when set in any fashion.\n\
4570 Note that this is overridden by the variable\n\
4571 `truncate-partial-width-windows' if that variable is non-nil\n\
4572 and this buffer is not full-frame width.");
4574 #ifdef DOS_NT
4575 DEFVAR_PER_BUFFER ("buffer-file-type", &current_buffer->buffer_file_type,
4576 Qnil,
4577 "Non-nil if the visited file is a binary file.\n\
4578 This variable is meaningful on MS-DOG and Windows NT.\n\
4579 On those systems, it is automatically local in every buffer.\n\
4580 On other systems, this variable is normally always nil.");
4581 #endif
4583 DEFVAR_PER_BUFFER ("default-directory", &current_buffer->directory,
4584 make_number (Lisp_String),
4585 "Name of default directory of current buffer. Should end with slash.\n\
4586 Each buffer has its own value of this variable.");
4588 DEFVAR_PER_BUFFER ("auto-fill-function", &current_buffer->auto_fill_function,
4589 Qnil,
4590 "Function called (if non-nil) to perform auto-fill.\n\
4591 It is called after self-inserting any character specified in\n\
4592 the `auto-fill-chars' table.\n\
4593 Each buffer has its own value of this variable.\n\
4594 NOTE: This variable is not a hook;\n\
4595 its value may not be a list of functions.");
4597 DEFVAR_PER_BUFFER ("buffer-file-name", &current_buffer->filename,
4598 make_number (Lisp_String),
4599 "Name of file visited in current buffer, or nil if not visiting a file.\n\
4600 Each buffer has its own value of this variable.");
4602 DEFVAR_PER_BUFFER ("buffer-file-truename", &current_buffer->file_truename,
4603 make_number (Lisp_String),
4604 "Abbreviated truename of file visited in current buffer, or nil if none.\n\
4605 The truename of a file is calculated by `file-truename'\n\
4606 and then abbreviated with `abbreviate-file-name'.\n\
4607 Each buffer has its own value of this variable.");
4609 DEFVAR_PER_BUFFER ("buffer-auto-save-file-name",
4610 &current_buffer->auto_save_file_name,
4611 make_number (Lisp_String),
4612 "Name of file for auto-saving current buffer,\n\
4613 or nil if buffer should not be auto-saved.\n\
4614 Each buffer has its own value of this variable.");
4616 DEFVAR_PER_BUFFER ("buffer-read-only", &current_buffer->read_only, Qnil,
4617 "Non-nil if this buffer is read-only.\n\
4618 Each buffer has its own value of this variable.");
4620 DEFVAR_PER_BUFFER ("buffer-backed-up", &current_buffer->backed_up, Qnil,
4621 "Non-nil if this buffer's file has been backed up.\n\
4622 Backing up is done before the first time the file is saved.\n\
4623 Each buffer has its own value of this variable.");
4625 DEFVAR_PER_BUFFER ("buffer-saved-size", &current_buffer->save_length,
4626 make_number (Lisp_Int),
4627 "Length of current buffer when last read in, saved or auto-saved.\n\
4628 0 initially.\n\
4629 Each buffer has its own value of this variable.");
4631 DEFVAR_PER_BUFFER ("selective-display", &current_buffer->selective_display,
4632 Qnil,
4633 "Non-nil enables selective display:\n\
4634 Integer N as value means display only lines\n\
4635 that start with less than n columns of space.\n\
4636 A value of t means, after a ^M, all the rest of the line is invisible.\n\
4637 Then ^M's in the file are written into files as newlines.\n\n\
4638 Automatically becomes buffer-local when set in any fashion.");
4640 #ifndef old
4641 DEFVAR_PER_BUFFER ("selective-display-ellipses",
4642 &current_buffer->selective_display_ellipses,
4643 Qnil,
4644 "t means display ... on previous line when a line is invisible.\n\
4645 Automatically becomes buffer-local when set in any fashion.");
4646 #endif
4648 DEFVAR_PER_BUFFER ("overwrite-mode", &current_buffer->overwrite_mode, Qnil,
4649 "Non-nil if self-insertion should replace existing text.\n\
4650 The value should be one of `overwrite-mode-textual',\n\
4651 `overwrite-mode-binary', or nil.\n\
4652 If it is `overwrite-mode-textual', self-insertion still\n\
4653 inserts at the end of a line, and inserts when point is before a tab,\n\
4654 until the tab is filled in.\n\
4655 If `overwrite-mode-binary', self-insertion replaces newlines and tabs too.\n\
4656 Automatically becomes buffer-local when set in any fashion.");
4658 #if 0 /* The doc string is too long for some compilers,
4659 but make-docfile can find it in this comment. */
4660 DEFVAR_PER_BUFFER ("buffer-display-table", &current_buffer->display_table,
4661 Qnil,
4662 "Display table that controls display of the contents of current buffer.\n\
4663 Automatically becomes buffer-local when set in any fashion.\n\
4664 The display table is a char-table created with `make-display-table'.\n\
4665 The ordinary char-table elements control how to display each possible text\n\
4666 character. Each value should be a vector of characters or nil;\n\
4667 nil means display the character in the default fashion.\n\
4668 There are six extra slots to control the display of\n\
4669 the end of a truncated screen line (extra-slot 0, a single character);\n\
4670 the end of a continued line (extra-slot 1, a single character);\n\
4671 the escape character used to display character codes in octal\n\
4672 (extra-slot 2, a single character);\n\
4673 the character used as an arrow for control characters (extra-slot 3,\n\
4674 a single character);\n\
4675 the decoration indicating the presence of invisible lines (extra-slot 4,\n\
4676 a vector of characters);\n\
4677 the character used to draw the border between side-by-side windows\n\
4678 (extra-slot 5, a single character).\n\
4679 See also the functions `display-table-slot' and `set-display-table-slot'.\n\
4680 If this variable is nil, the value of `standard-display-table' is used.\n\
4681 Each window can have its own, overriding display table.");
4682 #endif
4683 DEFVAR_PER_BUFFER ("buffer-display-table", &current_buffer->display_table,
4684 Qnil, 0);
4686 DEFVAR_PER_BUFFER ("left-margin-width", &current_buffer->left_margin_width,
4687 Qnil,
4688 "*Width of left marginal area for display of a buffer.\n\
4689 Automatically becomes buffer-local when set in any fashion.\n\
4690 A value of nil means no marginal area.");
4692 DEFVAR_PER_BUFFER ("right-margin-width", &current_buffer->right_margin_width,
4693 Qnil,
4694 "*Width of right marginal area for display of a buffer.\n\
4695 Automatically becomes buffer-local when set in any fashion.\n\
4696 A value of nil means no marginal area.");
4698 DEFVAR_PER_BUFFER ("indicate-empty-lines",
4699 &current_buffer->indicate_empty_lines, Qnil,
4700 "*Visually indicate empty lines after the buffer end.\n\
4701 If non-nil, a bitmap is displayed in the left fringe of a window on\n\
4702 window-systems.\n\
4703 Automatically becomes buffer-local when set in any fashion.\n");
4705 DEFVAR_PER_BUFFER ("scroll-up-aggressively",
4706 &current_buffer->scroll_up_aggressively, Qnil,
4707 "*If a number, scroll display up aggressively.\n\
4708 If scrolling a window because point is above the window start, choose\n\
4709 a new window start so that point ends up that fraction of the window's\n\
4710 height from the top of the window.\n\
4711 Automatically becomes buffer-local when set in any fashion.");
4713 DEFVAR_PER_BUFFER ("scroll-down-aggressively",
4714 &current_buffer->scroll_down_aggressively, Qnil,
4715 "*If a number, scroll display down aggressively.\n\
4716 If scrolling a window because point is below the window end, choose\n\
4717 a new window start so that point ends up that fraction of the window's\n\
4718 height from the bottom of the window.\n\
4719 Automatically becomes buffer-local when set in any fashion.");
4721 /*DEFVAR_LISP ("debug-check-symbol", &Vcheck_symbol,
4722 "Don't ask.");
4725 DEFVAR_LISP ("before-change-functions", &Vbefore_change_functions,
4726 "List of functions to call before each text change.\n\
4727 Two arguments are passed to each function: the positions of\n\
4728 the beginning and end of the range of old text to be changed.\n\
4729 \(For an insertion, the beginning and end are at the same place.)\n\
4730 No information is given about the length of the text after the change.\n\
4732 Buffer changes made while executing the `before-change-functions'\n\
4733 don't call any before-change or after-change functions.\n\
4734 That's because these variables are temporarily set to nil.\n\
4735 As a result, a hook function cannot straightforwardly alter the value of\n\
4736 these variables. See the Emacs Lisp manual for a way of\n\
4737 accomplishing an equivalent result by using other variables.\n\
4739 If an unhandled error happens in running these functions,\n\
4740 the variable's value remains nil. That prevents the error\n\
4741 from happening repeatedly and making Emacs nonfunctional.");
4742 Vbefore_change_functions = Qnil;
4744 DEFVAR_LISP ("after-change-functions", &Vafter_change_functions,
4745 "List of function to call after each text change.\n\
4746 Three arguments are passed to each function: the positions of\n\
4747 the beginning and end of the range of changed text,\n\
4748 and the length in bytes of the pre-change text replaced by that range.\n\
4749 \(For an insertion, the pre-change length is zero;\n\
4750 for a deletion, that length is the number of bytes deleted,\n\
4751 and the post-change beginning and end are at the same place.)\n\
4753 Buffer changes made while executing the `after-change-functions'\n\
4754 don't call any before-change or after-change functions.\n\
4755 That's because these variables are temporarily set to nil.\n\
4756 As a result, a hook function cannot straightforwardly alter the value of\n\
4757 these variables. See the Emacs Lisp manual for a way of\n\
4758 accomplishing an equivalent result by using other variables.\n\
4760 If an unhandled error happens in running these functions,\n\
4761 the variable's value remains nil. That prevents the error\n\
4762 from happening repeatedly and making Emacs nonfunctional.");
4763 Vafter_change_functions = Qnil;
4765 DEFVAR_LISP ("first-change-hook", &Vfirst_change_hook,
4766 "A list of functions to call before changing a buffer which is unmodified.\n\
4767 The functions are run using the `run-hooks' function.");
4768 Vfirst_change_hook = Qnil;
4770 #if 0 /* The doc string is too long for some compilers,
4771 but make-docfile can find it in this comment. */
4772 DEFVAR_PER_BUFFER ("buffer-undo-list", &current_buffer->undo_list, Qnil,
4773 "List of undo entries in current buffer.\n\
4774 This variable is always local in all buffers.\n\
4775 Recent changes come first; older changes follow newer.\n\
4777 An entry (BEG . END) represents an insertion which begins at\n\
4778 position BEG and ends at position END.\n\
4780 An entry (TEXT . POSITION) represents the deletion of the string TEXT\n\
4781 from (abs POSITION). If POSITION is positive, point was at the front\n\
4782 of the text being deleted; if negative, point was at the end.\n\
4784 An entry (t HIGH . LOW) indicates that the buffer previously had\n\
4785 \"unmodified\" status. HIGH and LOW are the high and low 16-bit portions\n\
4786 of the visited file's modification time, as of that time. If the\n\
4787 modification time of the most recent save is different, this entry is\n\
4788 obsolete.\n\
4790 An entry (nil PROPERTY VALUE BEG . END) indicates that a text property\n\
4791 was modified between BEG and END. PROPERTY is the property name,\n\
4792 and VALUE is the old value.\n\
4794 An entry (MARKER . DISTANCE) indicates that the marker MARKER\n\
4795 was adjusted in position by the offset DISTANCE (an integer).\n\
4797 An entry of the form POSITION indicates that point was at the buffer\n\
4798 location given by the integer. Undoing an entry of this form places\n\
4799 point at POSITION.\n\
4801 nil marks undo boundaries. The undo command treats the changes\n\
4802 between two undo boundaries as a single step to be undone.\n\
4804 If the value of the variable is t, undo information is not recorded.");
4805 #endif
4806 DEFVAR_PER_BUFFER ("buffer-undo-list", &current_buffer->undo_list, Qnil,
4809 DEFVAR_PER_BUFFER ("mark-active", &current_buffer->mark_active, Qnil,
4810 "Non-nil means the mark and region are currently active in this buffer.\n\
4811 Automatically local in all buffers.");
4813 DEFVAR_PER_BUFFER ("cache-long-line-scans", &current_buffer->cache_long_line_scans, Qnil,
4814 "Non-nil means that Emacs should use caches to handle long lines more quickly.\n\
4815 This variable is buffer-local, in all buffers.\n\
4817 Normally, the line-motion functions work by scanning the buffer for\n\
4818 newlines. Columnar operations (like move-to-column and\n\
4819 compute-motion) also work by scanning the buffer, summing character\n\
4820 widths as they go. This works well for ordinary text, but if the\n\
4821 buffer's lines are very long (say, more than 500 characters), these\n\
4822 motion functions will take longer to execute. Emacs may also take\n\
4823 longer to update the display.\n\
4825 If cache-long-line-scans is non-nil, these motion functions cache the\n\
4826 results of their scans, and consult the cache to avoid rescanning\n\
4827 regions of the buffer until the text is modified. The caches are most\n\
4828 beneficial when they prevent the most searching---that is, when the\n\
4829 buffer contains long lines and large regions of characters with the\n\
4830 same, fixed screen width.\n\
4832 When cache-long-line-scans is non-nil, processing short lines will\n\
4833 become slightly slower (because of the overhead of consulting the\n\
4834 cache), and the caches will use memory roughly proportional to the\n\
4835 number of newlines and characters whose screen width varies.\n\
4837 The caches require no explicit maintenance; their accuracy is\n\
4838 maintained internally by the Emacs primitives. Enabling or disabling\n\
4839 the cache should not affect the behavior of any of the motion\n\
4840 functions; it should only affect their performance.");
4842 DEFVAR_PER_BUFFER ("point-before-scroll", &current_buffer->point_before_scroll, Qnil,
4843 "Value of point before the last series of scroll operations, or nil.\n\
4844 This variable is always local in all buffers.");
4846 DEFVAR_PER_BUFFER ("buffer-file-format", &current_buffer->file_format, Qnil,
4847 "List of formats to use when saving this buffer.\n\
4848 This variable is always local in all buffers.\n\
4849 Formats are defined by `format-alist'. This variable is\n\
4850 set when a file is visited. Automatically local in all buffers.");
4852 DEFVAR_PER_BUFFER ("buffer-invisibility-spec",
4853 &current_buffer->invisibility_spec, Qnil,
4854 "Invisibility spec of this buffer.\n\
4855 This variable is always local in all buffers.\n\
4856 The default is t, which means that text is invisible\n\
4857 if it has a non-nil `invisible' property.\n\
4858 If the value is a list, a text character is invisible if its `invisible'\n\
4859 property is an element in that list.\n\
4860 If an element is a cons cell of the form (PROP . ELLIPSIS),\n\
4861 then characters with property value PROP are invisible,\n\
4862 and they have an ellipsis as well if ELLIPSIS is non-nil.");
4864 DEFVAR_PER_BUFFER ("buffer-display-count",
4865 &current_buffer->display_count, Qnil,
4866 "A number incremented each time this buffer is displayed in a window.\n\
4867 This variable is always local in all buffers.\n\
4868 The function `set-window-buffer increments it.");
4870 DEFVAR_PER_BUFFER ("buffer-display-time",
4871 &current_buffer->display_time, Qnil,
4872 "Time stamp updated each time this buffer is displayed in a window.\n\
4873 This variable is always local in all buffers.\n\
4874 The function `set-window-buffer' updates this variable\n\
4875 to the value obtained by calling `current-time'.\n\
4876 If the buffer has never been shown in a window, the value is nil.");
4878 DEFVAR_LISP ("transient-mark-mode", &Vtransient_mark_mode,
4879 "*Non-nil means deactivate the mark when the buffer contents change.\n\
4880 Non-nil also enables highlighting of the region whenever the mark is active.\n\
4881 The variable `highlight-nonselected-windows' controls whether to highlight\n\
4882 all windows or just the selected window.");
4883 Vtransient_mark_mode = Qnil;
4885 DEFVAR_LISP ("inhibit-read-only", &Vinhibit_read_only,
4886 "*Non-nil means disregard read-only status of buffers or characters.\n\
4887 If the value is t, disregard `buffer-read-only' and all `read-only'\n\
4888 text properties. If the value is a list, disregard `buffer-read-only'\n\
4889 and disregard a `read-only' text property if the property value\n\
4890 is a member of the list.");
4891 Vinhibit_read_only = Qnil;
4893 DEFVAR_PER_BUFFER ("cursor-type", &current_buffer->cursor_type, Qnil,
4894 "Cursor to use in window displaying this buffer.\n\
4895 Values are interpreted as follows:\n\
4897 t use the cursor specified for the frame\n\
4898 nil don't display a cursor\n\
4899 `bar' display a bar cursor with default width\n\
4900 (bar . WIDTH) display a bar cursor with width WIDTH\n\
4901 others display a box cursor.");
4903 DEFVAR_PER_BUFFER ("line-spacing",
4904 &current_buffer->extra_line_spacing, Qnil,
4905 "Additional space to put between lines when displaying a buffer.\n\
4906 The space is measured in pixels, and put below lines on window systems.");
4908 DEFVAR_LISP ("kill-buffer-query-functions", &Vkill_buffer_query_functions,
4909 "List of functions called with no args to query before killing a buffer.");
4910 Vkill_buffer_query_functions = Qnil;
4912 defsubr (&Sbuffer_live_p);
4913 defsubr (&Sbuffer_list);
4914 defsubr (&Sget_buffer);
4915 defsubr (&Sget_file_buffer);
4916 defsubr (&Sget_buffer_create);
4917 defsubr (&Smake_indirect_buffer);
4918 defsubr (&Sgenerate_new_buffer_name);
4919 defsubr (&Sbuffer_name);
4920 /*defsubr (&Sbuffer_number);*/
4921 defsubr (&Sbuffer_file_name);
4922 defsubr (&Sbuffer_base_buffer);
4923 defsubr (&Sbuffer_local_variables);
4924 defsubr (&Sbuffer_modified_p);
4925 defsubr (&Sset_buffer_modified_p);
4926 defsubr (&Sbuffer_modified_tick);
4927 defsubr (&Srename_buffer);
4928 defsubr (&Sother_buffer);
4929 defsubr (&Sbuffer_disable_undo);
4930 defsubr (&Sbuffer_enable_undo);
4931 defsubr (&Skill_buffer);
4932 defsubr (&Sset_buffer_major_mode);
4933 defsubr (&Sswitch_to_buffer);
4934 defsubr (&Spop_to_buffer);
4935 defsubr (&Scurrent_buffer);
4936 defsubr (&Sset_buffer);
4937 defsubr (&Sbarf_if_buffer_read_only);
4938 defsubr (&Sbury_buffer);
4939 defsubr (&Serase_buffer);
4940 defsubr (&Sset_buffer_multibyte);
4941 defsubr (&Skill_all_local_variables);
4943 defsubr (&Soverlayp);
4944 defsubr (&Smake_overlay);
4945 defsubr (&Sdelete_overlay);
4946 defsubr (&Smove_overlay);
4947 defsubr (&Soverlay_start);
4948 defsubr (&Soverlay_end);
4949 defsubr (&Soverlay_buffer);
4950 defsubr (&Soverlay_properties);
4951 defsubr (&Soverlays_at);
4952 defsubr (&Soverlays_in);
4953 defsubr (&Snext_overlay_change);
4954 defsubr (&Sprevious_overlay_change);
4955 defsubr (&Soverlay_recenter);
4956 defsubr (&Soverlay_lists);
4957 defsubr (&Soverlay_get);
4958 defsubr (&Soverlay_put);
4959 defsubr (&Srestore_buffer_modified_p);
4962 void
4963 keys_of_buffer ()
4965 initial_define_key (control_x_map, 'b', "switch-to-buffer");
4966 initial_define_key (control_x_map, 'k', "kill-buffer");
4968 /* This must not be in syms_of_buffer, because Qdisabled is not
4969 initialized when that function gets called. */
4970 Fput (intern ("erase-buffer"), Qdisabled, Qt);