1 /* Buffer manipulation primitives for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995
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)
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. */
23 #include <sys/types.h>
25 #include <sys/param.h>
28 /* in 4.1, param.h fails to define this. */
29 #define MAXPATHLEN 1024
30 #endif /* not MAXPATHLEN */
34 #include "intervals.h"
38 #include "region-cache.h"
40 #include "blockinput.h"
42 struct buffer
*current_buffer
; /* the current buffer */
44 /* First buffer in chain of all buffers (in reverse order of creation).
45 Threaded through ->next. */
47 struct buffer
*all_buffers
;
49 /* This structure holds the default values of the buffer-local variables
50 defined with DEFVAR_PER_BUFFER, that have special slots in each buffer.
51 The default value occupies the same slot in this structure
52 as an individual buffer's value occupies in that buffer.
53 Setting the default value also goes through the alist of buffers
54 and stores into each buffer that does not say it has a local value. */
56 struct buffer buffer_defaults
;
58 /* A Lisp_Object pointer to the above, used for staticpro */
60 static Lisp_Object Vbuffer_defaults
;
62 /* This structure marks which slots in a buffer have corresponding
63 default values in buffer_defaults.
64 Each such slot has a nonzero value in this structure.
65 The value has only one nonzero bit.
67 When a buffer has its own local value for a slot,
68 the bit for that slot (found in the same slot in this structure)
69 is turned on in the buffer's local_var_flags slot.
71 If a slot in this structure is -1, then even though there may
72 be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
73 and the corresponding slot in buffer_defaults is not used.
75 If a slot is -2, then there is no DEFVAR_PER_BUFFER for it,
76 but there is a default value which is copied into each buffer.
78 If a slot in this structure is negative, then even though there may
79 be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
80 and the corresponding slot in buffer_defaults is not used.
82 If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is
83 zero, that is a bug */
85 struct buffer buffer_local_flags
;
87 /* This structure holds the names of symbols whose values may be
88 buffer-local. It is indexed and accessed in the same way as the above. */
90 struct buffer buffer_local_symbols
;
91 /* A Lisp_Object pointer to the above, used for staticpro */
92 static Lisp_Object Vbuffer_local_symbols
;
94 /* This structure holds the required types for the values in the
95 buffer-local slots. If a slot contains Qnil, then the
96 corresponding buffer slot may contain a value of any type. If a
97 slot contains an integer, then prospective values' tags must be
98 equal to that integer. When a tag does not match, the function
99 buffer_slot_type_mismatch will signal an error. */
100 struct buffer buffer_local_types
;
102 Lisp_Object
Fset_buffer ();
103 void set_buffer_internal ();
104 void set_buffer_internal_1 ();
105 static void call_overlay_mod_hooks ();
106 static void swap_out_buffer_local_variables ();
108 /* Alist of all buffer names vs the buffers. */
109 /* This used to be a variable, but is no longer,
110 to prevent lossage due to user rplac'ing this alist or its elements. */
111 Lisp_Object Vbuffer_alist
;
113 /* Functions to call before and after each text change. */
114 Lisp_Object Vbefore_change_function
;
115 Lisp_Object Vafter_change_function
;
116 Lisp_Object Vbefore_change_functions
;
117 Lisp_Object Vafter_change_functions
;
119 Lisp_Object Vtransient_mark_mode
;
121 /* t means ignore all read-only text properties.
122 A list means ignore such a property if its value is a member of the list.
123 Any non-nil value means ignore buffer-read-only. */
124 Lisp_Object Vinhibit_read_only
;
126 /* List of functions to call that can query about killing a buffer.
127 If any of these functions returns nil, we don't kill it. */
128 Lisp_Object Vkill_buffer_query_functions
;
130 /* List of functions to call before changing an unmodified buffer. */
131 Lisp_Object Vfirst_change_hook
;
133 Lisp_Object Qfirst_change_hook
;
134 Lisp_Object Qbefore_change_functions
;
135 Lisp_Object Qafter_change_functions
;
137 Lisp_Object Qfundamental_mode
, Qmode_class
, Qpermanent_local
;
139 Lisp_Object Qprotected_field
;
141 Lisp_Object QSFundamental
; /* A string "Fundamental" */
143 Lisp_Object Qkill_buffer_hook
;
145 Lisp_Object Qget_file_buffer
;
147 Lisp_Object Qoverlayp
;
149 Lisp_Object Qpriority
, Qwindow
, Qevaporate
, Qbefore_string
, Qafter_string
;
151 Lisp_Object Qmodification_hooks
;
152 Lisp_Object Qinsert_in_front_hooks
;
153 Lisp_Object Qinsert_behind_hooks
;
155 /* For debugging; temporary. See set_buffer_internal. */
156 /* Lisp_Object Qlisp_mode, Vcheck_symbol; */
162 error ("No buffer named %s", XSTRING (spec
)->data
);
163 error ("Invalid buffer argument");
166 DEFUN ("buffer-list", Fbuffer_list
, Sbuffer_list
, 0, 0, 0,
167 "Return a list of all existing live buffers.")
170 return Fmapcar (Qcdr
, Vbuffer_alist
);
173 /* Like Fassoc, but use Fstring_equal to compare
174 (which ignores text properties),
175 and don't ever QUIT. */
178 assoc_ignore_text_properties (key
, list
)
179 register Lisp_Object key
;
182 register Lisp_Object tail
;
183 for (tail
= list
; !NILP (tail
); tail
= Fcdr (tail
))
185 register Lisp_Object elt
, tem
;
187 tem
= Fstring_equal (Fcar (elt
), key
);
194 DEFUN ("get-buffer", Fget_buffer
, Sget_buffer
, 1, 1, 0,
195 "Return the buffer named NAME (a string).\n\
196 If there is no live buffer named NAME, return nil.\n\
197 NAME may also be a buffer; if so, the value is that buffer.")
199 register Lisp_Object name
;
203 CHECK_STRING (name
, 0);
205 return Fcdr (assoc_ignore_text_properties (name
, Vbuffer_alist
));
208 DEFUN ("get-file-buffer", Fget_file_buffer
, Sget_file_buffer
, 1, 1, 0,
209 "Return the buffer visiting file FILENAME (a string).\n\
210 The buffer's `buffer-file-name' must match exactly the expansion of FILENAME.\n\
211 If there is no such live buffer, return nil.\n\
212 See also `find-buffer-visiting'.")
214 register Lisp_Object filename
;
216 register Lisp_Object tail
, buf
, tem
;
219 CHECK_STRING (filename
, 0);
220 filename
= Fexpand_file_name (filename
, Qnil
);
222 /* If the file name has special constructs in it,
223 call the corresponding file handler. */
224 handler
= Ffind_file_name_handler (filename
, Qget_file_buffer
);
226 return call2 (handler
, Qget_file_buffer
, filename
);
228 for (tail
= Vbuffer_alist
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
230 buf
= Fcdr (XCONS (tail
)->car
);
231 if (!BUFFERP (buf
)) continue;
232 if (!STRINGP (XBUFFER (buf
)->filename
)) continue;
233 tem
= Fstring_equal (XBUFFER (buf
)->filename
, filename
);
241 get_truename_buffer (filename
)
242 register Lisp_Object filename
;
244 register Lisp_Object tail
, buf
, tem
;
246 for (tail
= Vbuffer_alist
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
248 buf
= Fcdr (XCONS (tail
)->car
);
249 if (!BUFFERP (buf
)) continue;
250 if (!STRINGP (XBUFFER (buf
)->file_truename
)) continue;
251 tem
= Fstring_equal (XBUFFER (buf
)->file_truename
, filename
);
258 /* Incremented for each buffer created, to assign the buffer number. */
261 DEFUN ("get-buffer-create", Fget_buffer_create
, Sget_buffer_create
, 1, 1, 0,
262 "Return the buffer named NAME, or create such a buffer and return it.\n\
263 A new buffer is created if there is no live buffer named NAME.\n\
264 If NAME starts with a space, the new buffer does not keep undo information.\n\
265 If NAME is a buffer instead of a string, then it is the value returned.\n\
266 The value is never nil.")
268 register Lisp_Object name
;
270 register Lisp_Object buf
;
271 register struct buffer
*b
;
273 buf
= Fget_buffer (name
);
277 if (XSTRING (name
)->size
== 0)
278 error ("Empty string for buffer name is not allowed");
280 b
= (struct buffer
*) xmalloc (sizeof (struct buffer
));
282 b
->size
= sizeof (struct buffer
) / sizeof (EMACS_INT
);
284 /* An ordinary buffer uses its own struct buffer_text. */
285 b
->text
= &b
->own_text
;
288 BUF_GAP_SIZE (b
) = 20;
290 BUFFER_ALLOC (BUF_BEG_ADDR (b
), BUF_GAP_SIZE (b
));
292 if (! BUF_BEG_ADDR (b
))
293 buffer_memory_full ();
301 BUF_SAVE_MODIFF (b
) = 1;
302 BUF_INTERVALS (b
) = 0;
304 b
->newline_cache
= 0;
305 b
->width_run_cache
= 0;
306 b
->width_table
= Qnil
;
308 /* Put this on the chain of all buffers including killed ones. */
309 b
->next
= all_buffers
;
312 /* An ordinary buffer normally doesn't need markers
313 to handle BEGV and ZV. */
315 b
->begv_marker
= Qnil
;
318 name
= Fcopy_sequence (name
);
319 INITIALIZE_INTERVAL (XSTRING (name
), NULL_INTERVAL
);
322 if (XSTRING (name
)->data
[0] != ' ')
328 reset_buffer_local_variables (b
);
330 /* Put this in the alist of all live buffers. */
332 Vbuffer_alist
= nconc2 (Vbuffer_alist
, Fcons (Fcons (name
, buf
), Qnil
));
334 b
->mark
= Fmake_marker ();
335 BUF_MARKERS (b
) = Qnil
;
340 DEFUN ("make-indirect-buffer", Fmake_indirect_buffer
, Smake_indirect_buffer
, 2, 2,
341 "bMake indirect buffer (to buffer): \nBName of indirect buffer: ",
342 "Create and return an indirect buffer for buffer BASE-BUFFER, named NAME.\n\
343 BASE-BUFFER should be an existing buffer (or buffer name).\n\
344 NAME should be a string which is not the name of an existing buffer.")
346 register Lisp_Object base_buffer
, name
;
348 register Lisp_Object buf
;
349 register struct buffer
*b
;
351 buf
= Fget_buffer (name
);
353 error ("Buffer name `%s' is in use", XSTRING (name
)->data
);
355 base_buffer
= Fget_buffer (base_buffer
);
356 if (NILP (base_buffer
))
357 error ("No such buffer: `%s'",
358 XSTRING (XBUFFER (base_buffer
)->name
)->data
);
360 if (XSTRING (name
)->size
== 0)
361 error ("Empty string for buffer name is not allowed");
363 b
= (struct buffer
*) xmalloc (sizeof (struct buffer
));
365 b
->size
= sizeof (struct buffer
) / sizeof (EMACS_INT
);
367 if (XBUFFER (base_buffer
)->base_buffer
)
368 b
->base_buffer
= XBUFFER (base_buffer
)->base_buffer
;
370 b
->base_buffer
= XBUFFER (base_buffer
);
372 /* Use the base buffer's text object. */
373 b
->text
= b
->base_buffer
->text
;
375 BUF_BEGV (b
) = BUF_BEGV (b
->base_buffer
);
376 BUF_ZV (b
) = BUF_ZV (b
->base_buffer
);
377 BUF_PT (b
) = BUF_PT (b
->base_buffer
);
379 b
->newline_cache
= 0;
380 b
->width_run_cache
= 0;
381 b
->width_table
= Qnil
;
383 /* Put this on the chain of all buffers including killed ones. */
384 b
->next
= all_buffers
;
387 name
= Fcopy_sequence (name
);
388 INITIALIZE_INTERVAL (XSTRING (name
), NULL_INTERVAL
);
392 reset_buffer_local_variables (b
);
394 /* Put this in the alist of all live buffers. */
396 Vbuffer_alist
= nconc2 (Vbuffer_alist
, Fcons (Fcons (name
, buf
), Qnil
));
398 b
->mark
= Fmake_marker ();
401 /* Make sure the base buffer has markers for its narrowing. */
402 if (NILP (b
->base_buffer
->pt_marker
))
404 b
->base_buffer
->pt_marker
= Fmake_marker ();
405 Fset_marker (b
->base_buffer
->pt_marker
,
406 make_number (BUF_PT (b
->base_buffer
)), base_buffer
);
408 if (NILP (b
->base_buffer
->begv_marker
))
410 b
->base_buffer
->begv_marker
= Fmake_marker ();
411 Fset_marker (b
->base_buffer
->begv_marker
,
412 make_number (BUF_BEGV (b
->base_buffer
)), base_buffer
);
414 if (NILP (b
->base_buffer
->zv_marker
))
416 b
->base_buffer
->zv_marker
= Fmake_marker ();
417 Fset_marker (b
->base_buffer
->zv_marker
,
418 make_number (BUF_ZV (b
->base_buffer
)), base_buffer
);
419 XMARKER (b
->base_buffer
->zv_marker
)->insertion_type
= 1;
422 /* Give the indirect buffer markers for its narrowing. */
423 b
->pt_marker
= Fmake_marker ();
424 Fset_marker (b
->pt_marker
, make_number (BUF_PT (b
)), buf
);
425 b
->begv_marker
= Fmake_marker ();
426 Fset_marker (b
->begv_marker
, make_number (BUF_BEGV (b
)), buf
);
427 b
->zv_marker
= Fmake_marker ();
428 Fset_marker (b
->zv_marker
, make_number (BUF_ZV (b
)), buf
);
430 XMARKER (b
->zv_marker
)->insertion_type
= 1;
435 /* Reinitialize everything about a buffer except its name and contents
436 and local variables. */
440 register struct buffer
*b
;
443 b
->file_truename
= Qnil
;
444 b
->directory
= (current_buffer
) ? current_buffer
->directory
: Qnil
;
446 XSETFASTINT (b
->save_length
, 0);
447 b
->last_window_start
= 1;
449 b
->auto_save_modified
= 0;
450 b
->auto_save_failure_time
= -1;
451 b
->auto_save_file_name
= Qnil
;
453 b
->overlays_before
= Qnil
;
454 b
->overlays_after
= Qnil
;
455 XSETFASTINT (b
->overlay_center
, 1);
456 b
->mark_active
= Qnil
;
457 b
->point_before_scroll
= Qnil
;
458 b
->file_format
= Qnil
;
464 /* Reset buffer B's local variables info.
465 Don't use this on a buffer that has already been in use;
466 it does not treat permanent locals consistently.
467 Instead, use Fkill_all_local_variables. */
469 reset_buffer_local_variables (b
)
470 register struct buffer
*b
;
474 /* Reset the major mode to Fundamental, together with all the
475 things that depend on the major mode.
476 default-major-mode is handled at a higher level.
477 We ignore it here. */
478 b
->major_mode
= Qfundamental_mode
;
480 b
->abbrev_table
= Vfundamental_mode_abbrev_table
;
481 b
->mode_name
= QSFundamental
;
482 b
->minor_modes
= Qnil
;
484 /* If the standard case table has been altered and invalidated,
485 fix up its insides first. */
486 if (! (CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table
)->extras
[0])
487 && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table
)->extras
[1])
488 && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table
)->extras
[2])))
489 Fset_standard_case_table (Vascii_downcase_table
);
491 b
->downcase_table
= Vascii_downcase_table
;
492 b
->upcase_table
= XCHAR_TABLE (Vascii_downcase_table
)->extras
[0];
493 b
->case_canon_table
= XCHAR_TABLE (Vascii_downcase_table
)->extras
[1];
494 b
->case_eqv_table
= XCHAR_TABLE (Vascii_downcase_table
)->extras
[2];
495 b
->buffer_file_type
= Qnil
;
496 b
->invisibility_spec
= Qt
;
499 b
->sort_table
= XSTRING (Vascii_sort_table
);
500 b
->folding_sort_table
= XSTRING (Vascii_folding_sort_table
);
503 /* Reset all per-buffer variables to their defaults. */
504 b
->local_var_alist
= Qnil
;
505 b
->local_var_flags
= 0;
507 /* For each slot that has a default value,
508 copy that into the slot. */
510 for (offset
= (char *)&buffer_local_flags
.name
- (char *)&buffer_local_flags
;
511 offset
< sizeof (struct buffer
);
512 offset
+= sizeof (Lisp_Object
)) /* sizeof EMACS_INT == sizeof Lisp_Object */
514 int flag
= XINT (*(Lisp_Object
*)(offset
+ (char *)&buffer_local_flags
));
515 if (flag
> 0 || flag
== -2)
516 *(Lisp_Object
*)(offset
+ (char *)b
) =
517 *(Lisp_Object
*)(offset
+ (char *)&buffer_defaults
);
521 /* We split this away from generate-new-buffer, because rename-buffer
522 and set-visited-file-name ought to be able to use this to really
523 rename the buffer properly. */
525 DEFUN ("generate-new-buffer-name", Fgenerate_new_buffer_name
, Sgenerate_new_buffer_name
,
527 "Return a string that is the name of no existing buffer based on NAME.\n\
528 If there is no live buffer named NAME, then return NAME.\n\
529 Otherwise modify name by appending `<NUMBER>', incrementing NUMBER\n\
530 until an unused name is found, and then return that name.\n\
531 Optional second argument IGNORE specifies a name that is okay to use\n\
532 \(if it is in the sequence to be tried)\n\
533 even if a buffer with that name exists.")
535 register Lisp_Object name
, ignore
;
537 register Lisp_Object gentemp
, tem
;
541 CHECK_STRING (name
, 0);
543 tem
= Fget_buffer (name
);
550 sprintf (number
, "<%d>", ++count
);
551 gentemp
= concat2 (name
, build_string (number
));
552 tem
= Fstring_equal (gentemp
, ignore
);
555 tem
= Fget_buffer (gentemp
);
562 DEFUN ("buffer-name", Fbuffer_name
, Sbuffer_name
, 0, 1, 0,
563 "Return the name of BUFFER, as a string.\n\
564 With no argument or nil as argument, return the name of the current buffer.")
566 register Lisp_Object buffer
;
569 return current_buffer
->name
;
570 CHECK_BUFFER (buffer
, 0);
571 return XBUFFER (buffer
)->name
;
574 DEFUN ("buffer-file-name", Fbuffer_file_name
, Sbuffer_file_name
, 0, 1, 0,
575 "Return name of file BUFFER is visiting, or nil if none.\n\
576 No argument or nil as argument means use the current buffer.")
578 register Lisp_Object buffer
;
581 return current_buffer
->filename
;
582 CHECK_BUFFER (buffer
, 0);
583 return XBUFFER (buffer
)->filename
;
586 DEFUN ("buffer-base-buffer", Fbuffer_base_buffer
, Sbuffer_base_buffer
,
588 "Return the base buffer of indirect buffer BUFFER.\n\
589 If BUFFER is not indirect, return nil.")
591 register Lisp_Object buffer
;
594 Lisp_Object base_buffer
;
597 base
= current_buffer
->base_buffer
;
600 CHECK_BUFFER (buffer
, 0);
601 base
= XBUFFER (buffer
)->base_buffer
;
606 XSETBUFFER (base_buffer
, base
);
610 DEFUN ("buffer-local-variables", Fbuffer_local_variables
,
611 Sbuffer_local_variables
, 0, 1, 0,
612 "Return an alist of variables that are buffer-local in BUFFER.\n\
613 Most elements look like (SYMBOL . VALUE), describing one variable.\n\
614 For a symbol that is locally unbound, just the symbol appears in the value.\n\
615 Note that storing new VALUEs in these elements doesn't change the variables.\n\
616 No argument or nil as argument means use current buffer as BUFFER.")
618 register Lisp_Object buffer
;
620 register struct buffer
*buf
;
621 register Lisp_Object result
;
624 buf
= current_buffer
;
627 CHECK_BUFFER (buffer
, 0);
628 buf
= XBUFFER (buffer
);
634 register Lisp_Object tail
;
635 for (tail
= buf
->local_var_alist
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
637 Lisp_Object val
, elt
;
639 elt
= XCONS (tail
)->car
;
641 /* Reference each variable in the alist in buf.
642 If inquiring about the current buffer, this gets the current values,
643 so store them into the alist so the alist is up to date.
644 If inquiring about some other buffer, this swaps out any values
645 for that buffer, making the alist up to date automatically. */
646 val
= find_symbol_value (XCONS (elt
)->car
);
647 /* Use the current buffer value only if buf is the current buffer. */
648 if (buf
!= current_buffer
)
649 val
= XCONS (elt
)->cdr
;
651 /* If symbol is unbound, put just the symbol in the list. */
652 if (EQ (val
, Qunbound
))
653 result
= Fcons (XCONS (elt
)->car
, result
);
654 /* Otherwise, put (symbol . value) in the list. */
656 result
= Fcons (Fcons (XCONS (elt
)->car
, val
), result
);
660 /* Add on all the variables stored in special slots. */
662 register int offset
, mask
;
664 for (offset
= (char *)&buffer_local_symbols
.name
- (char *)&buffer_local_symbols
;
665 offset
< sizeof (struct buffer
);
666 offset
+= (sizeof (EMACS_INT
))) /* sizeof EMACS_INT == sizeof Lisp_Object */
668 mask
= XINT (*(Lisp_Object
*)(offset
+ (char *)&buffer_local_flags
));
669 if (mask
== -1 || (buf
->local_var_flags
& mask
))
670 if (SYMBOLP (*(Lisp_Object
*)(offset
671 + (char *)&buffer_local_symbols
)))
672 result
= Fcons (Fcons (*((Lisp_Object
*)
673 (offset
+ (char *)&buffer_local_symbols
)),
674 *(Lisp_Object
*)(offset
+ (char *)buf
)),
683 DEFUN ("buffer-modified-p", Fbuffer_modified_p
, Sbuffer_modified_p
,
685 "Return t if BUFFER was modified since its file was last read or saved.\n\
686 No argument or nil as argument means use current buffer as BUFFER.")
688 register Lisp_Object buffer
;
690 register struct buffer
*buf
;
692 buf
= current_buffer
;
695 CHECK_BUFFER (buffer
, 0);
696 buf
= XBUFFER (buffer
);
699 return BUF_SAVE_MODIFF (buf
) < BUF_MODIFF (buf
) ? Qt
: Qnil
;
702 DEFUN ("set-buffer-modified-p", Fset_buffer_modified_p
, Sset_buffer_modified_p
,
704 "Mark current buffer as modified or unmodified according to FLAG.\n\
705 A non-nil FLAG means mark the buffer modified.")
707 register Lisp_Object flag
;
709 register int already
;
710 register Lisp_Object fn
;
712 #ifdef CLASH_DETECTION
713 /* If buffer becoming modified, lock the file.
714 If buffer becoming unmodified, unlock the file. */
716 fn
= current_buffer
->file_truename
;
719 already
= SAVE_MODIFF
< MODIFF
;
720 if (!already
&& !NILP (flag
))
722 else if (already
&& NILP (flag
))
725 #endif /* CLASH_DETECTION */
727 SAVE_MODIFF
= NILP (flag
) ? MODIFF
: 0;
732 DEFUN ("buffer-modified-tick", Fbuffer_modified_tick
, Sbuffer_modified_tick
,
734 "Return BUFFER's tick counter, incremented for each change in text.\n\
735 Each buffer has a tick counter which is incremented each time the text in\n\
736 that buffer is changed. It wraps around occasionally.\n\
737 No argument or nil as argument means use current buffer as BUFFER.")
739 register Lisp_Object buffer
;
741 register struct buffer
*buf
;
743 buf
= current_buffer
;
746 CHECK_BUFFER (buffer
, 0);
747 buf
= XBUFFER (buffer
);
750 return make_number (BUF_MODIFF (buf
));
753 DEFUN ("rename-buffer", Frename_buffer
, Srename_buffer
, 1, 2,
754 "sRename buffer (to new name): \nP",
755 "Change current buffer's name to NEWNAME (a string).\n\
756 If second arg UNIQUE is nil or omitted, it is an error if a\n\
757 buffer named NEWNAME already exists.\n\
758 If UNIQUE is non-nil, come up with a new name using\n\
759 `generate-new-buffer-name'.\n\
760 Interactively, you can set UNIQUE with a prefix argument.\n\
761 We return the name we actually gave the buffer.\n\
762 This does not change the name of the visited file (if any).")
764 register Lisp_Object newname
, unique
;
766 register Lisp_Object tem
, buf
;
768 CHECK_STRING (newname
, 0);
770 if (XSTRING (newname
)->size
== 0)
771 error ("Empty string is invalid as a buffer name");
773 tem
= Fget_buffer (newname
);
774 /* Don't short-circuit if UNIQUE is t. That is a useful way to rename
775 the buffer automatically so you can create another with the original name.
776 It makes UNIQUE equivalent to
777 (rename-buffer (generate-new-buffer-name NEWNAME)). */
778 if (NILP (unique
) && XBUFFER (tem
) == current_buffer
)
779 return current_buffer
->name
;
783 newname
= Fgenerate_new_buffer_name (newname
, current_buffer
->name
);
785 error ("Buffer name `%s' is in use", XSTRING (newname
)->data
);
788 current_buffer
->name
= newname
;
790 /* Catch redisplay's attention. Unless we do this, the mode lines for
791 any windows displaying current_buffer will stay unchanged. */
794 XSETBUFFER (buf
, current_buffer
);
795 Fsetcar (Frassq (buf
, Vbuffer_alist
), newname
);
796 if (NILP (current_buffer
->filename
)
797 && !NILP (current_buffer
->auto_save_file_name
))
798 call0 (intern ("rename-auto-save-file"));
799 /* Refetch since that last call may have done GC. */
800 return current_buffer
->name
;
803 DEFUN ("other-buffer", Fother_buffer
, Sother_buffer
, 0, 2, 0,
804 "Return most recently selected buffer other than BUFFER.\n\
805 Buffers not visible in windows are preferred to visible buffers,\n\
806 unless optional second argument VISIBLE-OK is non-nil.\n\
807 If no other buffer exists, the buffer `*scratch*' is returned.\n\
808 If BUFFER is omitted or nil, some interesting buffer is returned.")
810 register Lisp_Object buffer
, visible_ok
;
812 register Lisp_Object tail
, buf
, notsogood
, tem
;
815 for (tail
= Vbuffer_alist
; !NILP (tail
); tail
= Fcdr (tail
))
817 buf
= Fcdr (Fcar (tail
));
818 if (EQ (buf
, buffer
))
820 if (XSTRING (XBUFFER (buf
)->name
)->data
[0] == ' ')
823 /* If the selected frame has a buffer_predicate,
824 disregard buffers that don't fit the predicate. */
825 tem
= frame_buffer_predicate ();
828 tem
= call1 (tem
, buf
);
834 if (NILP (visible_ok
))
835 tem
= Fget_buffer_window (buf
, Qt
);
840 if (NILP (notsogood
))
843 if (!NILP (notsogood
))
845 return Fget_buffer_create (build_string ("*scratch*"));
848 DEFUN ("buffer-disable-undo", Fbuffer_disable_undo
, Sbuffer_disable_undo
,
850 "Make BUFFER stop keeping undo information.\n\
851 No argument or nil as argument means do this for the current buffer.")
853 register Lisp_Object buffer
;
855 Lisp_Object real_buffer
;
858 XSETBUFFER (real_buffer
, current_buffer
);
861 real_buffer
= Fget_buffer (buffer
);
862 if (NILP (real_buffer
))
866 XBUFFER (real_buffer
)->undo_list
= Qt
;
871 DEFUN ("buffer-enable-undo", Fbuffer_enable_undo
, Sbuffer_enable_undo
,
873 "Start keeping undo information for buffer BUFFER.\n\
874 No argument or nil as argument means do this for the current buffer.")
876 register Lisp_Object buffer
;
878 Lisp_Object real_buffer
;
881 XSETBUFFER (real_buffer
, current_buffer
);
884 real_buffer
= Fget_buffer (buffer
);
885 if (NILP (real_buffer
))
889 if (EQ (XBUFFER (real_buffer
)->undo_list
, Qt
))
890 XBUFFER (real_buffer
)->undo_list
= Qnil
;
896 DEFVAR_LISP ("kill-buffer-hook", no_cell, "\
897 Hook to be run (by `run-hooks', which see) when a buffer is killed.\n\
898 The buffer being killed will be current while the hook is running.\n\
901 DEFUN ("kill-buffer", Fkill_buffer
, Skill_buffer
, 1, 1, "bKill buffer: ",
902 "Kill the buffer BUFFER.\n\
903 The argument may be a buffer or may be the name of a buffer.\n\
904 An argument of nil means kill the current buffer.\n\n\
905 Value is t if the buffer is actually killed, nil if user says no.\n\n\
906 The value of `kill-buffer-hook' (which may be local to that buffer),\n\
907 if not void, is a list of functions to be called, with no arguments,\n\
908 before the buffer is actually killed. The buffer to be killed is current\n\
909 when the hook functions are called.\n\n\
910 Any processes that have this buffer as the `process-buffer' are killed\n\
911 with `delete-process'.")
916 register struct buffer
*b
;
917 register Lisp_Object tem
;
918 register struct Lisp_Marker
*m
;
919 struct gcpro gcpro1
, gcpro2
;
922 buf
= Fcurrent_buffer ();
924 buf
= Fget_buffer (buffer
);
930 /* Avoid trouble for buffer already dead. */
934 /* Query if the buffer is still modified. */
935 if (INTERACTIVE
&& !NILP (b
->filename
)
936 && BUF_MODIFF (b
) > BUF_SAVE_MODIFF (b
))
939 tem
= do_yes_or_no_p (format1 ("Buffer %s modified; kill anyway? ",
940 XSTRING (b
->name
)->data
));
946 /* Run hooks with the buffer to be killed the current buffer. */
948 register Lisp_Object val
;
949 int count
= specpdl_ptr
- specpdl
;
952 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
953 set_buffer_internal (b
);
955 /* First run the query functions; if any query is answered no,
956 don't kill the buffer. */
957 for (list
= Vkill_buffer_query_functions
; !NILP (list
); list
= Fcdr (list
))
959 tem
= call0 (Fcar (list
));
961 return unbind_to (count
, Qnil
);
964 /* Then run the hooks. */
965 if (!NILP (Vrun_hooks
))
966 call1 (Vrun_hooks
, Qkill_buffer_hook
);
967 unbind_to (count
, Qnil
);
970 /* We have no more questions to ask. Verify that it is valid
971 to kill the buffer. This must be done after the questions
972 since anything can happen within do_yes_or_no_p. */
974 /* Don't kill the minibuffer now current. */
975 if (EQ (buf
, XWINDOW (minibuf_window
)->buffer
))
981 /* When we kill a base buffer, kill all its indirect buffers.
982 We do it at this stage so nothing terrible happens if they
983 ask questions or their hooks get errors. */
984 if (! b
->base_buffer
)
986 struct buffer
*other
;
990 for (other
= all_buffers
; other
; other
= other
->next
)
991 /* all_buffers contains dead buffers too;
992 don't re-kill them. */
993 if (other
->base_buffer
== b
&& !NILP (other
->name
))
996 XSETBUFFER (buf
, other
);
1003 /* Make this buffer not be current.
1004 In the process, notice if this is the sole visible buffer
1005 and give up if so. */
1006 if (b
== current_buffer
)
1008 tem
= Fother_buffer (buf
, Qnil
);
1010 if (b
== current_buffer
)
1014 /* Now there is no question: we can kill the buffer. */
1016 #ifdef CLASH_DETECTION
1017 /* Unlock this buffer's file, if it is locked. */
1019 #endif /* CLASH_DETECTION */
1021 kill_buffer_processes (buf
);
1023 tem
= Vinhibit_quit
;
1025 replace_buffer_in_all_windows (buf
);
1026 Vbuffer_alist
= Fdelq (Frassq (buf
, Vbuffer_alist
), Vbuffer_alist
);
1027 Vinhibit_quit
= tem
;
1029 /* Delete any auto-save file, if we saved it in this session. */
1030 if (STRINGP (b
->auto_save_file_name
)
1031 && b
->auto_save_modified
!= 0
1032 && SAVE_MODIFF
< b
->auto_save_modified
)
1035 tem
= Fsymbol_value (intern ("delete-auto-save-files"));
1037 internal_delete_file (b
->auto_save_file_name
);
1042 /* Unchain all markers that belong to this indirect buffer.
1043 Don't unchain the markers that belong to the base buffer
1044 or its other indirect buffers. */
1045 for (tem
= BUF_MARKERS (b
); !NILP (tem
); )
1051 unchain_marker (tem
);
1057 /* Unchain all markers of this buffer and its indirect buffers.
1058 and leave them pointing nowhere. */
1059 for (tem
= BUF_MARKERS (b
); !NILP (tem
); )
1066 BUF_MARKERS (b
) = Qnil
;
1068 #ifdef USE_TEXT_PROPERTIES
1069 BUF_INTERVALS (b
) = NULL_INTERVAL
;
1072 /* Perhaps we should explicitly free the interval tree here... */
1075 /* Reset the local variables, so that this buffer's local values
1076 won't be protected from GC. They would be protected
1077 if they happened to remain encached in their symbols.
1078 This gets rid of them for certain. */
1079 swap_out_buffer_local_variables (b
);
1080 reset_buffer_local_variables (b
);
1085 if (! b
->base_buffer
)
1086 BUFFER_FREE (BUF_BEG_ADDR (b
));
1088 if (b
->newline_cache
)
1090 free_region_cache (b
->newline_cache
);
1091 b
->newline_cache
= 0;
1093 if (b
->width_run_cache
)
1095 free_region_cache (b
->width_run_cache
);
1096 b
->width_run_cache
= 0;
1098 b
->width_table
= Qnil
;
1100 b
->undo_list
= Qnil
;
1105 /* Move the assoc for buffer BUF to the front of buffer-alist. Since
1106 we do this each time BUF is selected visibly, the more recently
1107 selected buffers are always closer to the front of the list. This
1108 means that other_buffer is more likely to choose a relevant buffer. */
1113 register Lisp_Object link
, prev
;
1116 for (link
= Vbuffer_alist
; CONSP (link
); link
= XCONS (link
)->cdr
)
1118 if (EQ (XCONS (XCONS (link
)->car
)->cdr
, buf
))
1123 /* Effectively do Vbuffer_alist = Fdelq (link, Vbuffer_alist);
1124 we cannot use Fdelq itself here because it allows quitting. */
1127 Vbuffer_alist
= XCONS (Vbuffer_alist
)->cdr
;
1129 XCONS (prev
)->cdr
= XCONS (XCONS (prev
)->cdr
)->cdr
;
1131 XCONS(link
)->cdr
= Vbuffer_alist
;
1132 Vbuffer_alist
= link
;
1135 DEFUN ("set-buffer-major-mode", Fset_buffer_major_mode
, Sset_buffer_major_mode
, 1, 1, 0,
1136 "Set an appropriate major mode for BUFFER, according to `default-major-mode'.\n\
1137 Use this function before selecting the buffer, since it may need to inspect\n\
1138 the current buffer's major mode.")
1143 Lisp_Object function
;
1145 function
= buffer_defaults
.major_mode
;
1146 if (NILP (function
) && NILP (Fget (current_buffer
->major_mode
, Qmode_class
)))
1147 function
= current_buffer
->major_mode
;
1149 if (NILP (function
) || EQ (function
, Qfundamental_mode
))
1152 count
= specpdl_ptr
- specpdl
;
1154 /* To select a nonfundamental mode,
1155 select the buffer temporarily and then call the mode function. */
1157 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1159 Fset_buffer (buffer
);
1162 return unbind_to (count
, Qnil
);
1165 DEFUN ("switch-to-buffer", Fswitch_to_buffer
, Sswitch_to_buffer
, 1, 2, "BSwitch to buffer: ",
1166 "Select buffer BUFFER in the current window.\n\
1167 BUFFER may be a buffer or a buffer name.\n\
1168 Optional second arg NORECORD non-nil means\n\
1169 do not put this buffer at the front of the list of recently selected ones.\n\
1171 WARNING: This is NOT the way to work on another buffer temporarily\n\
1172 within a Lisp program! Use `set-buffer' instead. That avoids messing with\n\
1173 the window-buffer correspondences.")
1175 Lisp_Object buffer
, norecord
;
1177 register Lisp_Object buf
;
1180 if (EQ (minibuf_window
, selected_window
))
1181 error ("Cannot switch buffers in minibuffer window");
1182 tem
= Fwindow_dedicated_p (selected_window
);
1184 error ("Cannot switch buffers in a dedicated window");
1187 buf
= Fother_buffer (Fcurrent_buffer (), Qnil
);
1190 buf
= Fget_buffer (buffer
);
1193 buf
= Fget_buffer_create (buffer
);
1194 Fset_buffer_major_mode (buf
);
1198 if (NILP (norecord
))
1199 record_buffer (buf
);
1201 Fset_window_buffer (EQ (selected_window
, minibuf_window
)
1202 ? Fnext_window (minibuf_window
, Qnil
, Qnil
)
1209 DEFUN ("pop-to-buffer", Fpop_to_buffer
, Spop_to_buffer
, 1, 2, 0,
1210 "Select buffer BUFFER in some window, preferably a different one.\n\
1211 If BUFFER is nil, then some other buffer is chosen.\n\
1212 If `pop-up-windows' is non-nil, windows can be split to do this.\n\
1213 If optional second arg OTHER-WINDOW is non-nil, insist on finding another\n\
1214 window even if BUFFER is already visible in the selected window.")
1215 (buffer
, other_window
)
1216 Lisp_Object buffer
, other_window
;
1218 register Lisp_Object buf
;
1220 buf
= Fother_buffer (Fcurrent_buffer (), Qnil
);
1223 buf
= Fget_buffer (buffer
);
1226 buf
= Fget_buffer_create (buffer
);
1227 Fset_buffer_major_mode (buf
);
1231 record_buffer (buf
);
1232 Fselect_window (Fdisplay_buffer (buf
, other_window
));
1236 DEFUN ("current-buffer", Fcurrent_buffer
, Scurrent_buffer
, 0, 0, 0,
1237 "Return the current buffer as a Lisp object.")
1240 register Lisp_Object buf
;
1241 XSETBUFFER (buf
, current_buffer
);
1245 /* Set the current buffer to B. */
1248 set_buffer_internal (b
)
1249 register struct buffer
*b
;
1251 register struct buffer
*old_buf
;
1252 register Lisp_Object tail
, valcontents
;
1255 if (current_buffer
== b
)
1258 windows_or_buffers_changed
= 1;
1259 set_buffer_internal_1 (b
);
1262 /* Set the current buffer to B, and do not set windows_or_buffers_changed.
1263 This is used by redisplay. */
1266 set_buffer_internal_1 (b
)
1267 register struct buffer
*b
;
1269 register struct buffer
*old_buf
;
1270 register Lisp_Object tail
, valcontents
;
1273 if (current_buffer
== b
)
1276 old_buf
= current_buffer
;
1278 last_known_column_point
= -1; /* invalidate indentation cache */
1282 /* Put the undo list back in the base buffer, so that it appears
1283 that an indirect buffer shares the undo list of its base. */
1284 if (old_buf
->base_buffer
)
1285 old_buf
->base_buffer
->undo_list
= old_buf
->undo_list
;
1287 /* If the old current buffer has markers to record PT, BEGV and ZV
1288 when it is not current, update them now. */
1289 if (! NILP (old_buf
->pt_marker
))
1292 XSETBUFFER (obuf
, old_buf
);
1293 Fset_marker (old_buf
->pt_marker
, BUF_PT (old_buf
), obuf
);
1295 if (! NILP (old_buf
->begv_marker
))
1298 XSETBUFFER (obuf
, old_buf
);
1299 Fset_marker (old_buf
->begv_marker
, BUF_BEGV (old_buf
), obuf
);
1301 if (! NILP (old_buf
->zv_marker
))
1304 XSETBUFFER (obuf
, old_buf
);
1305 Fset_marker (old_buf
->zv_marker
, BUF_ZV (old_buf
), obuf
);
1309 /* Get the undo list from the base buffer, so that it appears
1310 that an indirect buffer shares the undo list of its base. */
1312 b
->undo_list
= b
->base_buffer
->undo_list
;
1314 /* If the new current buffer has markers to record PT, BEGV and ZV
1315 when it is not current, fetch them now. */
1316 if (! NILP (b
->pt_marker
))
1317 BUF_PT (b
) = marker_position (b
->pt_marker
);
1318 if (! NILP (b
->begv_marker
))
1319 BUF_BEGV (b
) = marker_position (b
->begv_marker
);
1320 if (! NILP (b
->zv_marker
))
1321 BUF_ZV (b
) = marker_position (b
->zv_marker
);
1323 /* Look down buffer's list of local Lisp variables
1324 to find and update any that forward into C variables. */
1326 for (tail
= b
->local_var_alist
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1328 valcontents
= XSYMBOL (XCONS (XCONS (tail
)->car
)->car
)->value
;
1329 if ((BUFFER_LOCAL_VALUEP (valcontents
)
1330 || SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1331 && (tem
= XBUFFER_LOCAL_VALUE (valcontents
)->car
,
1332 (BOOLFWDP (tem
) || INTFWDP (tem
) || OBJFWDP (tem
))))
1333 /* Just reference the variable
1334 to cause it to become set for this buffer. */
1335 Fsymbol_value (XCONS (XCONS (tail
)->car
)->car
);
1338 /* Do the same with any others that were local to the previous buffer */
1341 for (tail
= old_buf
->local_var_alist
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1343 valcontents
= XSYMBOL (XCONS (XCONS (tail
)->car
)->car
)->value
;
1344 if ((BUFFER_LOCAL_VALUEP (valcontents
)
1345 || SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1346 && (tem
= XBUFFER_LOCAL_VALUE (valcontents
)->car
,
1347 (BOOLFWDP (tem
) || INTFWDP (tem
) || OBJFWDP (tem
))))
1348 /* Just reference the variable
1349 to cause it to become set for this buffer. */
1350 Fsymbol_value (XCONS (XCONS (tail
)->car
)->car
);
1354 /* Switch to buffer B temporarily for redisplay purposes.
1355 This avoids certain things that don't need to be done within redisplay. */
1361 register struct buffer
*old_buf
;
1363 if (current_buffer
== b
)
1366 old_buf
= current_buffer
;
1371 /* If the old current buffer has markers to record PT, BEGV and ZV
1372 when it is not current, update them now. */
1373 if (! NILP (old_buf
->pt_marker
))
1376 XSETBUFFER (obuf
, old_buf
);
1377 Fset_marker (old_buf
->pt_marker
, BUF_PT (old_buf
), obuf
);
1379 if (! NILP (old_buf
->begv_marker
))
1382 XSETBUFFER (obuf
, old_buf
);
1383 Fset_marker (old_buf
->begv_marker
, BUF_BEGV (old_buf
), obuf
);
1385 if (! NILP (old_buf
->zv_marker
))
1388 XSETBUFFER (obuf
, old_buf
);
1389 Fset_marker (old_buf
->zv_marker
, BUF_ZV (old_buf
), obuf
);
1393 /* If the new current buffer has markers to record PT, BEGV and ZV
1394 when it is not current, fetch them now. */
1395 if (! NILP (b
->pt_marker
))
1396 BUF_PT (b
) = marker_position (b
->pt_marker
);
1397 if (! NILP (b
->begv_marker
))
1398 BUF_BEGV (b
) = marker_position (b
->begv_marker
);
1399 if (! NILP (b
->zv_marker
))
1400 BUF_ZV (b
) = marker_position (b
->zv_marker
);
1403 DEFUN ("set-buffer", Fset_buffer
, Sset_buffer
, 1, 1, 0,
1404 "Make the buffer BUFFER current for editing operations.\n\
1405 BUFFER may be a buffer or the name of an existing buffer.\n\
1406 See also `save-excursion' when you want to make a buffer current temporarily.\n\
1407 This function does not display the buffer, so its effect ends\n\
1408 when the current command terminates.\n\
1409 Use `switch-to-buffer' or `pop-to-buffer' to switch buffers permanently.")
1411 register Lisp_Object buffer
;
1413 register Lisp_Object buf
;
1414 buf
= Fget_buffer (buffer
);
1417 if (NILP (XBUFFER (buf
)->name
))
1418 error ("Selecting deleted buffer");
1419 set_buffer_internal (XBUFFER (buf
));
1423 DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only
,
1424 Sbarf_if_buffer_read_only
, 0, 0, 0,
1425 "Signal a `buffer-read-only' error if the current buffer is read-only.")
1428 if (!NILP (current_buffer
->read_only
)
1429 && NILP (Vinhibit_read_only
))
1430 Fsignal (Qbuffer_read_only
, (Fcons (Fcurrent_buffer (), Qnil
)));
1434 DEFUN ("bury-buffer", Fbury_buffer
, Sbury_buffer
, 0, 1, "",
1435 "Put BUFFER at the end of the list of all buffers.\n\
1436 There it is the least likely candidate for `other-buffer' to return;\n\
1437 thus, the least likely buffer for \\[switch-to-buffer] to select by default.\n\
1438 If BUFFER is nil or omitted, bury the current buffer.\n\
1439 Also, if BUFFER is nil or omitted, remove the current buffer from the\n\
1440 selected window if it is displayed there.")
1442 register Lisp_Object buffer
;
1444 /* Figure out what buffer we're going to bury. */
1447 XSETBUFFER (buffer
, current_buffer
);
1449 /* If we're burying the current buffer, unshow it. */
1450 Fswitch_to_buffer (Fother_buffer (buffer
, Qnil
), Qnil
);
1456 buf1
= Fget_buffer (buffer
);
1462 /* Move buffer to the end of the buffer list. */
1464 register Lisp_Object aelt
, link
;
1466 aelt
= Frassq (buffer
, Vbuffer_alist
);
1467 link
= Fmemq (aelt
, Vbuffer_alist
);
1468 Vbuffer_alist
= Fdelq (aelt
, Vbuffer_alist
);
1469 XCONS (link
)->cdr
= Qnil
;
1470 Vbuffer_alist
= nconc2 (Vbuffer_alist
, link
);
1476 DEFUN ("erase-buffer", Ferase_buffer
, Serase_buffer
, 0, 0, "*",
1477 "Delete the entire contents of the current buffer.\n\
1478 Any narrowing restriction in effect (see `narrow-to-region') is removed,\n\
1479 so the buffer is truly empty after this.")
1484 current_buffer
->last_window_start
= 1;
1485 /* Prevent warnings, or suspension of auto saving, that would happen
1486 if future size is less than past size. Use of erase-buffer
1487 implies that the future text is not really related to the past text. */
1488 XSETFASTINT (current_buffer
->save_length
, 0);
1492 validate_region (b
, e
)
1493 register Lisp_Object
*b
, *e
;
1495 CHECK_NUMBER_COERCE_MARKER (*b
, 0);
1496 CHECK_NUMBER_COERCE_MARKER (*e
, 1);
1498 if (XINT (*b
) > XINT (*e
))
1501 tem
= *b
; *b
= *e
; *e
= tem
;
1504 if (!(BEGV
<= XINT (*b
) && XINT (*b
) <= XINT (*e
)
1505 && XINT (*e
) <= ZV
))
1506 args_out_of_range (*b
, *e
);
1509 DEFUN ("kill-all-local-variables", Fkill_all_local_variables
, Skill_all_local_variables
,
1511 "Switch to Fundamental mode by killing current buffer's local variables.\n\
1512 Most local variable bindings are eliminated so that the default values\n\
1513 become effective once more. Also, the syntax table is set from\n\
1514 `standard-syntax-table', the local keymap is set to nil,\n\
1515 and the abbrev table from `fundamental-mode-abbrev-table'.\n\
1516 This function also forces redisplay of the mode line.\n\
1518 Every function to select a new major mode starts by\n\
1519 calling this function.\n\n\
1520 As a special exception, local variables whose names have\n\
1521 a non-nil `permanent-local' property are not eliminated by this function.\n\
1523 The first thing this function does is run\n\
1524 the normal hook `change-major-mode-hook'.")
1527 register Lisp_Object alist
, sym
, tem
;
1530 if (!NILP (Vrun_hooks
))
1531 call1 (Vrun_hooks
, intern ("change-major-mode-hook"));
1532 oalist
= current_buffer
->local_var_alist
;
1534 /* Make sure none of the bindings in oalist
1535 remain swapped in, in their symbols. */
1537 swap_out_buffer_local_variables (current_buffer
);
1539 /* Actually eliminate all local bindings of this buffer. */
1541 reset_buffer_local_variables (current_buffer
);
1543 /* Redisplay mode lines; we are changing major mode. */
1545 update_mode_lines
++;
1547 /* Any which are supposed to be permanent,
1548 make local again, with the same values they had. */
1550 for (alist
= oalist
; !NILP (alist
); alist
= XCONS (alist
)->cdr
)
1552 sym
= XCONS (XCONS (alist
)->car
)->car
;
1553 tem
= Fget (sym
, Qpermanent_local
);
1556 Fmake_local_variable (sym
);
1557 Fset (sym
, XCONS (XCONS (alist
)->car
)->cdr
);
1561 /* Force mode-line redisplay. Useful here because all major mode
1562 commands call this function. */
1563 update_mode_lines
++;
1568 /* Make sure no local variables remain set up with buffer B
1569 for their current values. */
1572 swap_out_buffer_local_variables (b
)
1575 Lisp_Object oalist
, alist
, sym
, tem
, buffer
;
1577 XSETBUFFER (buffer
, b
);
1578 oalist
= b
->local_var_alist
;
1580 for (alist
= oalist
; !NILP (alist
); alist
= XCONS (alist
)->cdr
)
1582 sym
= XCONS (XCONS (alist
)->car
)->car
;
1584 /* Need not do anything if some other buffer's binding is now encached. */
1585 tem
= XCONS (XBUFFER_LOCAL_VALUE (XSYMBOL (sym
)->value
)->cdr
)->car
;
1586 if (XBUFFER (tem
) == current_buffer
)
1588 /* Symbol is set up for this buffer's old local value.
1589 Set it up for the current buffer with the default value. */
1591 tem
= XCONS (XBUFFER_LOCAL_VALUE (XSYMBOL (sym
)->value
)->cdr
)->cdr
;
1592 /* Store the symbol's current value into the alist entry
1593 it is currently set up for. This is so that, if the
1594 local is marked permanent, and we make it local again
1595 later in Fkill_all_local_variables, we don't lose the value. */
1596 XCONS (XCONS (tem
)->car
)->cdr
1597 = do_symval_forwarding (XBUFFER_LOCAL_VALUE (XSYMBOL (sym
)->value
)->car
);
1598 /* Switch to the symbol's default-value alist entry. */
1599 XCONS (tem
)->car
= tem
;
1600 /* Mark it as current for buffer B. */
1601 XCONS (XBUFFER_LOCAL_VALUE (XSYMBOL (sym
)->value
)->cdr
)->car
1603 /* Store the current value into any forwarding in the symbol. */
1604 store_symval_forwarding (sym
, XBUFFER_LOCAL_VALUE (XSYMBOL (sym
)->value
)->car
,
1610 /* Find all the overlays in the current buffer that contain position POS.
1611 Return the number found, and store them in a vector in *VEC_PTR.
1612 Store in *LEN_PTR the size allocated for the vector.
1613 Store in *NEXT_PTR the next position after POS where an overlay starts,
1614 or ZV if there are no more overlays.
1615 Store in *PREV_PTR the previous position before POS where an overlay ends,
1616 or BEGV if there are no previous overlays.
1617 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
1619 *VEC_PTR and *LEN_PTR should contain a valid vector and size
1620 when this function is called.
1622 If EXTEND is non-zero, we make the vector bigger if necessary.
1623 If EXTEND is zero, we never extend the vector,
1624 and we store only as many overlays as will fit.
1625 But we still return the total number of overlays. */
1628 overlays_at (pos
, extend
, vec_ptr
, len_ptr
, next_ptr
, prev_ptr
)
1631 Lisp_Object
**vec_ptr
;
1636 Lisp_Object tail
, overlay
, start
, end
, result
;
1639 Lisp_Object
*vec
= *vec_ptr
;
1642 int inhibit_storing
= 0;
1644 for (tail
= current_buffer
->overlays_before
;
1646 tail
= XCONS (tail
)->cdr
)
1648 int startpos
, endpos
;
1650 overlay
= XCONS (tail
)->car
;
1652 start
= OVERLAY_START (overlay
);
1653 end
= OVERLAY_END (overlay
);
1654 endpos
= OVERLAY_POSITION (end
);
1663 startpos
= OVERLAY_POSITION (start
);
1664 if (startpos
<= pos
)
1668 /* The supplied vector is full.
1669 Either make it bigger, or don't store any more in it. */
1672 *len_ptr
= len
*= 2;
1673 vec
= (Lisp_Object
*) xrealloc (vec
, len
* sizeof (Lisp_Object
));
1677 inhibit_storing
= 1;
1680 if (!inhibit_storing
)
1682 /* Keep counting overlays even if we can't return them all. */
1685 else if (startpos
< next
)
1689 for (tail
= current_buffer
->overlays_after
;
1691 tail
= XCONS (tail
)->cdr
)
1693 int startpos
, endpos
;
1695 overlay
= XCONS (tail
)->car
;
1697 start
= OVERLAY_START (overlay
);
1698 end
= OVERLAY_END (overlay
);
1699 startpos
= OVERLAY_POSITION (start
);
1702 if (startpos
< next
)
1706 endpos
= OVERLAY_POSITION (end
);
1713 *len_ptr
= len
*= 2;
1714 vec
= (Lisp_Object
*) xrealloc (vec
, len
* sizeof (Lisp_Object
));
1718 inhibit_storing
= 1;
1721 if (!inhibit_storing
)
1725 else if (endpos
< pos
&& endpos
> prev
)
1736 /* Find all the overlays in the current buffer that overlap the range BEG-END
1737 or are empty at BEG.
1739 Return the number found, and store them in a vector in *VEC_PTR.
1740 Store in *LEN_PTR the size allocated for the vector.
1741 Store in *NEXT_PTR the next position after POS where an overlay starts,
1742 or ZV if there are no more overlays.
1743 Store in *PREV_PTR the previous position before POS where an overlay ends,
1744 or BEGV if there are no previous overlays.
1745 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
1747 *VEC_PTR and *LEN_PTR should contain a valid vector and size
1748 when this function is called.
1750 If EXTEND is non-zero, we make the vector bigger if necessary.
1751 If EXTEND is zero, we never extend the vector,
1752 and we store only as many overlays as will fit.
1753 But we still return the total number of overlays. */
1756 overlays_in (beg
, end
, extend
, vec_ptr
, len_ptr
, next_ptr
, prev_ptr
)
1759 Lisp_Object
**vec_ptr
;
1764 Lisp_Object tail
, overlay
, ostart
, oend
, result
;
1767 Lisp_Object
*vec
= *vec_ptr
;
1770 int inhibit_storing
= 0;
1772 for (tail
= current_buffer
->overlays_before
;
1774 tail
= XCONS (tail
)->cdr
)
1776 int startpos
, endpos
;
1778 overlay
= XCONS (tail
)->car
;
1780 ostart
= OVERLAY_START (overlay
);
1781 oend
= OVERLAY_END (overlay
);
1782 endpos
= OVERLAY_POSITION (oend
);
1789 startpos
= OVERLAY_POSITION (ostart
);
1790 /* Count an interval if it either overlaps the range
1791 or is empty at the start of the range. */
1792 if ((beg
< endpos
&& startpos
< end
)
1793 || (startpos
== endpos
&& beg
== endpos
))
1797 /* The supplied vector is full.
1798 Either make it bigger, or don't store any more in it. */
1801 *len_ptr
= len
*= 2;
1802 vec
= (Lisp_Object
*) xrealloc (vec
, len
* sizeof (Lisp_Object
));
1806 inhibit_storing
= 1;
1809 if (!inhibit_storing
)
1811 /* Keep counting overlays even if we can't return them all. */
1814 else if (startpos
< next
)
1818 for (tail
= current_buffer
->overlays_after
;
1820 tail
= XCONS (tail
)->cdr
)
1822 int startpos
, endpos
;
1824 overlay
= XCONS (tail
)->car
;
1826 ostart
= OVERLAY_START (overlay
);
1827 oend
= OVERLAY_END (overlay
);
1828 startpos
= OVERLAY_POSITION (ostart
);
1831 if (startpos
< next
)
1835 endpos
= OVERLAY_POSITION (oend
);
1836 /* Count an interval if it either overlaps the range
1837 or is empty at the start of the range. */
1838 if ((beg
< endpos
&& startpos
< end
)
1839 || (startpos
== endpos
&& beg
== endpos
))
1845 *len_ptr
= len
*= 2;
1846 vec
= (Lisp_Object
*) xrealloc (vec
, len
* sizeof (Lisp_Object
));
1850 inhibit_storing
= 1;
1853 if (!inhibit_storing
)
1857 else if (endpos
< beg
&& endpos
> prev
)
1868 /* Fast function to just test if we're at an overlay boundary. */
1870 overlay_touches_p (pos
)
1873 Lisp_Object tail
, overlay
;
1875 for (tail
= current_buffer
->overlays_before
; GC_CONSP (tail
);
1876 tail
= XCONS (tail
)->cdr
)
1880 overlay
= XCONS (tail
)->car
;
1881 if (!GC_OVERLAYP (overlay
))
1884 endpos
= OVERLAY_POSITION (OVERLAY_END (overlay
));
1887 if (endpos
== pos
|| OVERLAY_POSITION (OVERLAY_START (overlay
)) == pos
)
1891 for (tail
= current_buffer
->overlays_after
; GC_CONSP (tail
);
1892 tail
= XCONS (tail
)->cdr
)
1896 overlay
= XCONS (tail
)->car
;
1897 if (!GC_OVERLAYP (overlay
))
1900 startpos
= OVERLAY_POSITION (OVERLAY_START (overlay
));
1903 if (startpos
== pos
|| OVERLAY_POSITION (OVERLAY_END (overlay
)) == pos
)
1911 Lisp_Object overlay
;
1917 compare_overlays (s1
, s2
)
1918 struct sortvec
*s1
, *s2
;
1920 if (s1
->priority
!= s2
->priority
)
1921 return s1
->priority
- s2
->priority
;
1922 if (s1
->beg
!= s2
->beg
)
1923 return s1
->beg
- s2
->beg
;
1924 if (s1
->end
!= s2
->end
)
1925 return s2
->end
- s1
->end
;
1929 /* Sort an array of overlays by priority. The array is modified in place.
1930 The return value is the new size; this may be smaller than the original
1931 size if some of the overlays were invalid or were window-specific. */
1933 sort_overlays (overlay_vec
, noverlays
, w
)
1934 Lisp_Object
*overlay_vec
;
1939 struct sortvec
*sortvec
;
1940 sortvec
= (struct sortvec
*) alloca (noverlays
* sizeof (struct sortvec
));
1942 /* Put the valid and relevant overlays into sortvec. */
1944 for (i
= 0, j
= 0; i
< noverlays
; i
++)
1947 Lisp_Object overlay
;
1949 overlay
= overlay_vec
[i
];
1950 if (OVERLAY_VALID (overlay
)
1951 && OVERLAY_POSITION (OVERLAY_START (overlay
)) > 0
1952 && OVERLAY_POSITION (OVERLAY_END (overlay
)) > 0)
1954 /* If we're interested in a specific window, then ignore
1955 overlays that are limited to some other window. */
1960 window
= Foverlay_get (overlay
, Qwindow
);
1961 if (WINDOWP (window
) && XWINDOW (window
) != w
)
1965 /* This overlay is good and counts: put it into sortvec. */
1966 sortvec
[j
].overlay
= overlay
;
1967 sortvec
[j
].beg
= OVERLAY_POSITION (OVERLAY_START (overlay
));
1968 sortvec
[j
].end
= OVERLAY_POSITION (OVERLAY_END (overlay
));
1969 tem
= Foverlay_get (overlay
, Qpriority
);
1971 sortvec
[j
].priority
= XINT (tem
);
1973 sortvec
[j
].priority
= 0;
1979 /* Sort the overlays into the proper order: increasing priority. */
1982 qsort (sortvec
, noverlays
, sizeof (struct sortvec
), compare_overlays
);
1984 for (i
= 0; i
< noverlays
; i
++)
1985 overlay_vec
[i
] = sortvec
[i
].overlay
;
1991 Lisp_Object string
, string2
;
1998 struct sortstr
*buf
; /* An array that expands as needed; never freed. */
1999 int size
; /* Allocated length of that array. */
2000 int used
; /* How much of the array is currently in use. */
2001 int bytes
; /* Total length of the strings in buf. */
2004 /* Buffers for storing information about the overlays touching a given
2005 position. These could be automatic variables in overlay_strings, but
2006 it's more efficient to hold onto the memory instead of repeatedly
2007 allocating and freeing it. */
2008 static struct sortstrlist overlay_heads
, overlay_tails
;
2009 static char *overlay_str_buf
;
2011 /* Allocated length of overlay_str_buf. */
2012 static int overlay_str_len
;
2014 /* A comparison function suitable for passing to qsort. */
2016 cmp_for_strings (as1
, as2
)
2019 struct sortstr
*s1
= (struct sortstr
*)as1
;
2020 struct sortstr
*s2
= (struct sortstr
*)as2
;
2021 if (s1
->size
!= s2
->size
)
2022 return s2
->size
- s1
->size
;
2023 if (s1
->priority
!= s2
->priority
)
2024 return s1
->priority
- s2
->priority
;
2029 record_overlay_string (ssl
, str
, str2
, pri
, size
)
2030 struct sortstrlist
*ssl
;
2031 Lisp_Object str
, str2
, pri
;
2034 if (ssl
->used
== ssl
->size
)
2040 ssl
->buf
= ((struct sortstr
*)
2041 xrealloc (ssl
->buf
, ssl
->size
* sizeof (struct sortstr
)));
2043 ssl
->buf
[ssl
->used
].string
= str
;
2044 ssl
->buf
[ssl
->used
].string2
= str2
;
2045 ssl
->buf
[ssl
->used
].size
= size
;
2046 ssl
->buf
[ssl
->used
].priority
= (INTEGERP (pri
) ? XINT (pri
) : 0);
2048 ssl
->bytes
+= XSTRING (str
)->size
;
2050 ssl
->bytes
+= XSTRING (str2
)->size
;
2053 /* Return the concatenation of the strings associated with overlays that
2054 begin or end at POS, ignoring overlays that are specific to a window
2055 other than W. The strings are concatenated in the appropriate order:
2056 shorter overlays nest inside longer ones, and higher priority inside
2057 lower. Normally all of the after-strings come first, but zero-sized
2058 overlays have their after-strings ride along with the before-strings
2059 because it would look strange to print them inside-out.
2061 Returns the string length, and stores the contents indirectly through
2062 PSTR, if that variable is non-null. The string may be overwritten by
2063 subsequent calls. */
2065 overlay_strings (pos
, w
, pstr
)
2070 Lisp_Object ov
, overlay
, window
, str
;
2071 int startpos
, endpos
;
2073 overlay_heads
.used
= overlay_heads
.bytes
= 0;
2074 overlay_tails
.used
= overlay_tails
.bytes
= 0;
2075 for (ov
= current_buffer
->overlays_before
; CONSP (ov
); ov
= XCONS (ov
)->cdr
)
2077 overlay
= XCONS (ov
)->car
;
2078 if (!OVERLAYP (overlay
))
2081 startpos
= OVERLAY_POSITION (OVERLAY_START (overlay
));
2082 endpos
= OVERLAY_POSITION (OVERLAY_END (overlay
));
2085 if (endpos
!= pos
&& startpos
!= pos
)
2087 window
= Foverlay_get (overlay
, Qwindow
);
2088 if (WINDOWP (window
) && XWINDOW (window
) != w
)
2091 && (str
= Foverlay_get (overlay
, Qbefore_string
), STRINGP (str
)))
2092 record_overlay_string (&overlay_heads
, str
,
2094 ? Foverlay_get (overlay
, Qafter_string
)
2096 Foverlay_get (overlay
, Qpriority
),
2098 else if (endpos
== pos
2099 && (str
= Foverlay_get (overlay
, Qafter_string
), STRINGP (str
)))
2100 record_overlay_string (&overlay_tails
, str
, Qnil
,
2101 Foverlay_get (overlay
, Qpriority
),
2104 for (ov
= current_buffer
->overlays_after
; CONSP (ov
); ov
= XCONS (ov
)->cdr
)
2106 overlay
= XCONS (ov
)->car
;
2107 if (!OVERLAYP (overlay
))
2110 startpos
= OVERLAY_POSITION (OVERLAY_START (overlay
));
2111 endpos
= OVERLAY_POSITION (OVERLAY_END (overlay
));
2114 if (endpos
!= pos
&& startpos
!= pos
)
2116 window
= Foverlay_get (overlay
, Qwindow
);
2117 if (WINDOWP (window
) && XWINDOW (window
) != w
)
2120 && (str
= Foverlay_get (overlay
, Qbefore_string
), STRINGP (str
)))
2121 record_overlay_string (&overlay_heads
, str
,
2123 ? Foverlay_get (overlay
, Qafter_string
)
2125 Foverlay_get (overlay
, Qpriority
),
2127 else if (endpos
== pos
2128 && (str
= Foverlay_get (overlay
, Qafter_string
), STRINGP (str
)))
2129 record_overlay_string (&overlay_tails
, str
, Qnil
,
2130 Foverlay_get (overlay
, Qpriority
),
2133 if (overlay_tails
.used
> 1)
2134 qsort (overlay_tails
.buf
, overlay_tails
.used
, sizeof (struct sortstr
),
2136 if (overlay_heads
.used
> 1)
2137 qsort (overlay_heads
.buf
, overlay_heads
.used
, sizeof (struct sortstr
),
2139 if (overlay_heads
.bytes
|| overlay_tails
.bytes
)
2144 int total
= overlay_heads
.bytes
+ overlay_tails
.bytes
;
2146 if (total
> overlay_str_len
)
2147 overlay_str_buf
= (char *)xrealloc (overlay_str_buf
,
2148 overlay_str_len
= total
);
2149 p
= overlay_str_buf
;
2150 for (i
= overlay_tails
.used
; --i
>= 0;)
2152 tem
= overlay_tails
.buf
[i
].string
;
2153 bcopy (XSTRING (tem
)->data
, p
, XSTRING (tem
)->size
);
2154 p
+= XSTRING (tem
)->size
;
2156 for (i
= 0; i
< overlay_heads
.used
; ++i
)
2158 tem
= overlay_heads
.buf
[i
].string
;
2159 bcopy (XSTRING (tem
)->data
, p
, XSTRING (tem
)->size
);
2160 p
+= XSTRING (tem
)->size
;
2161 tem
= overlay_heads
.buf
[i
].string2
;
2164 bcopy (XSTRING (tem
)->data
, p
, XSTRING (tem
)->size
);
2165 p
+= XSTRING (tem
)->size
;
2168 if (p
!= overlay_str_buf
+ total
)
2171 *pstr
= overlay_str_buf
;
2177 /* Shift overlays in BUF's overlay lists, to center the lists at POS. */
2180 recenter_overlay_lists (buf
, pos
)
2184 Lisp_Object overlay
, tail
, next
, prev
, beg
, end
;
2186 /* See if anything in overlays_before should move to overlays_after. */
2188 /* We don't strictly need prev in this loop; it should always be nil.
2189 But we use it for symmetry and in case that should cease to be true
2190 with some future change. */
2192 for (tail
= buf
->overlays_before
;
2194 prev
= tail
, tail
= next
)
2196 next
= XCONS (tail
)->cdr
;
2197 overlay
= XCONS (tail
)->car
;
2199 /* If the overlay is not valid, get rid of it. */
2200 if (!OVERLAY_VALID (overlay
))
2205 /* Splice the cons cell TAIL out of overlays_before. */
2207 XCONS (prev
)->cdr
= next
;
2209 buf
->overlays_before
= next
;
2215 beg
= OVERLAY_START (overlay
);
2216 end
= OVERLAY_END (overlay
);
2218 if (OVERLAY_POSITION (end
) > pos
)
2220 /* OVERLAY needs to be moved. */
2221 int where
= OVERLAY_POSITION (beg
);
2222 Lisp_Object other
, other_prev
;
2224 /* Splice the cons cell TAIL out of overlays_before. */
2226 XCONS (prev
)->cdr
= next
;
2228 buf
->overlays_before
= next
;
2230 /* Search thru overlays_after for where to put it. */
2232 for (other
= buf
->overlays_after
;
2234 other_prev
= other
, other
= XCONS (other
)->cdr
)
2236 Lisp_Object otherbeg
, otheroverlay
, follower
;
2239 otheroverlay
= XCONS (other
)->car
;
2240 if (! OVERLAY_VALID (otheroverlay
))
2243 otherbeg
= OVERLAY_START (otheroverlay
);
2244 if (OVERLAY_POSITION (otherbeg
) >= where
)
2248 /* Add TAIL to overlays_after before OTHER. */
2249 XCONS (tail
)->cdr
= other
;
2250 if (!NILP (other_prev
))
2251 XCONS (other_prev
)->cdr
= tail
;
2253 buf
->overlays_after
= tail
;
2257 /* We've reached the things that should stay in overlays_before.
2258 All the rest of overlays_before must end even earlier,
2263 /* See if anything in overlays_after should be in overlays_before. */
2265 for (tail
= buf
->overlays_after
;
2267 prev
= tail
, tail
= next
)
2269 next
= XCONS (tail
)->cdr
;
2270 overlay
= XCONS (tail
)->car
;
2272 /* If the overlay is not valid, get rid of it. */
2273 if (!OVERLAY_VALID (overlay
))
2278 /* Splice the cons cell TAIL out of overlays_after. */
2280 XCONS (prev
)->cdr
= next
;
2282 buf
->overlays_after
= next
;
2288 beg
= OVERLAY_START (overlay
);
2289 end
= OVERLAY_END (overlay
);
2291 /* Stop looking, when we know that nothing further
2292 can possibly end before POS. */
2293 if (OVERLAY_POSITION (beg
) > pos
)
2296 if (OVERLAY_POSITION (end
) <= pos
)
2298 /* OVERLAY needs to be moved. */
2299 int where
= OVERLAY_POSITION (end
);
2300 Lisp_Object other
, other_prev
;
2302 /* Splice the cons cell TAIL out of overlays_after. */
2304 XCONS (prev
)->cdr
= next
;
2306 buf
->overlays_after
= next
;
2308 /* Search thru overlays_before for where to put it. */
2310 for (other
= buf
->overlays_before
;
2312 other_prev
= other
, other
= XCONS (other
)->cdr
)
2314 Lisp_Object otherend
, otheroverlay
;
2317 otheroverlay
= XCONS (other
)->car
;
2318 if (! OVERLAY_VALID (otheroverlay
))
2321 otherend
= OVERLAY_END (otheroverlay
);
2322 if (OVERLAY_POSITION (otherend
) <= where
)
2326 /* Add TAIL to overlays_before before OTHER. */
2327 XCONS (tail
)->cdr
= other
;
2328 if (!NILP (other_prev
))
2329 XCONS (other_prev
)->cdr
= tail
;
2331 buf
->overlays_before
= tail
;
2336 XSETFASTINT (buf
->overlay_center
, pos
);
2340 adjust_overlays_for_insert (pos
, length
)
2344 /* After an insertion, the lists are still sorted properly,
2345 but we may need to update the value of the overlay center. */
2346 if (XFASTINT (current_buffer
->overlay_center
) >= pos
)
2347 XSETFASTINT (current_buffer
->overlay_center
,
2348 XFASTINT (current_buffer
->overlay_center
) + length
);
2352 adjust_overlays_for_delete (pos
, length
)
2356 if (XFASTINT (current_buffer
->overlay_center
) < pos
)
2357 /* The deletion was to our right. No change needed; the before- and
2358 after-lists are still consistent. */
2360 else if (XFASTINT (current_buffer
->overlay_center
) > pos
+ length
)
2361 /* The deletion was to our left. We need to adjust the center value
2362 to account for the change in position, but the lists are consistent
2363 given the new value. */
2364 XSETFASTINT (current_buffer
->overlay_center
,
2365 XFASTINT (current_buffer
->overlay_center
) - length
);
2367 /* We're right in the middle. There might be things on the after-list
2368 that now belong on the before-list. Recentering will move them,
2369 and also update the center point. */
2370 recenter_overlay_lists (current_buffer
, pos
);
2373 /* Fix up overlays that were garbled as a result of permuting markers
2374 in the range START through END. Any overlay with at least one
2375 endpoint in this range will need to be unlinked from the overlay
2376 list and reinserted in its proper place.
2377 Such an overlay might even have negative size at this point.
2378 If so, we'll reverse the endpoints. Can you think of anything
2379 better to do in this situation? */
2381 fix_overlays_in_range (start
, end
)
2382 register int start
, end
;
2384 Lisp_Object tem
, overlay
;
2385 Lisp_Object before_list
, after_list
;
2386 Lisp_Object
*ptail
, *pbefore
= &before_list
, *pafter
= &after_list
;
2387 int startpos
, endpos
;
2389 /* This algorithm shifts links around instead of consing and GCing.
2390 The loop invariant is that before_list (resp. after_list) is a
2391 well-formed list except that its last element, the one that
2392 *pbefore (resp. *pafter) points to, is still uninitialized.
2393 So it's not a bug that before_list isn't initialized, although
2394 it may look strange. */
2395 for (ptail
= ¤t_buffer
->overlays_before
; CONSP (*ptail
);)
2397 overlay
= XCONS (*ptail
)->car
;
2398 endpos
= OVERLAY_POSITION (OVERLAY_END (overlay
));
2401 startpos
= OVERLAY_POSITION (OVERLAY_START (overlay
));
2403 || (startpos
>= start
&& startpos
< end
))
2405 /* If the overlay is backwards, fix that now. */
2406 if (startpos
> endpos
)
2409 Fset_marker (OVERLAY_START (overlay
), endpos
, Qnil
);
2410 Fset_marker (OVERLAY_END (overlay
), startpos
, Qnil
);
2411 tem
= startpos
; startpos
= endpos
; endpos
= tem
;
2413 /* Add it to the end of the wrong list. Later on,
2414 recenter_overlay_lists will move it to the right place. */
2415 if (endpos
< XINT (current_buffer
->overlay_center
))
2418 pafter
= &XCONS (*ptail
)->cdr
;
2423 pbefore
= &XCONS (*ptail
)->cdr
;
2425 *ptail
= XCONS (*ptail
)->cdr
;
2428 ptail
= &XCONS (*ptail
)->cdr
;
2430 for (ptail
= ¤t_buffer
->overlays_after
; CONSP (*ptail
);)
2432 overlay
= XCONS (*ptail
)->car
;
2433 startpos
= OVERLAY_POSITION (OVERLAY_START (overlay
));
2434 if (startpos
>= end
)
2436 endpos
= OVERLAY_POSITION (OVERLAY_END (overlay
));
2437 if (startpos
>= start
2438 || (endpos
>= start
&& endpos
< end
))
2440 if (startpos
> endpos
)
2443 Fset_marker (OVERLAY_START (overlay
), endpos
, Qnil
);
2444 Fset_marker (OVERLAY_END (overlay
), startpos
, Qnil
);
2445 tem
= startpos
; startpos
= endpos
; endpos
= tem
;
2447 if (endpos
< XINT (current_buffer
->overlay_center
))
2450 pafter
= &XCONS (*ptail
)->cdr
;
2455 pbefore
= &XCONS (*ptail
)->cdr
;
2457 *ptail
= XCONS (*ptail
)->cdr
;
2460 ptail
= &XCONS (*ptail
)->cdr
;
2463 /* Splice the constructed (wrong) lists into the buffer's lists,
2464 and let the recenter function make it sane again. */
2465 *pbefore
= current_buffer
->overlays_before
;
2466 current_buffer
->overlays_before
= before_list
;
2467 recenter_overlay_lists (current_buffer
,
2468 XINT (current_buffer
->overlay_center
));
2470 *pafter
= current_buffer
->overlays_after
;
2471 current_buffer
->overlays_after
= after_list
;
2472 recenter_overlay_lists (current_buffer
,
2473 XINT (current_buffer
->overlay_center
));
2476 DEFUN ("overlayp", Foverlayp
, Soverlayp
, 1, 1, 0,
2477 "Return t if OBJECT is an overlay.")
2481 return (OVERLAYP (object
) ? Qt
: Qnil
);
2484 DEFUN ("make-overlay", Fmake_overlay
, Smake_overlay
, 2, 5, 0,
2485 "Create a new overlay with range BEG to END in BUFFER.\n\
2486 If omitted, BUFFER defaults to the current buffer.\n\
2487 BEG and END may be integers or markers.\n\
2488 The fourth arg FRONT-ADVANCE, if non-nil, makes the\n\
2489 front delimiter advance when text is inserted there.\n\
2490 The fifth arg REAR-ADVANCE, if non-nil, makes the\n\
2491 rear delimiter advance when text is inserted there.")
2492 (beg
, end
, buffer
, front_advance
, rear_advance
)
2493 Lisp_Object beg
, end
, buffer
;
2494 Lisp_Object front_advance
, rear_advance
;
2496 Lisp_Object overlay
;
2500 XSETBUFFER (buffer
, current_buffer
);
2502 CHECK_BUFFER (buffer
, 2);
2504 && ! EQ (Fmarker_buffer (beg
), buffer
))
2505 error ("Marker points into wrong buffer");
2507 && ! EQ (Fmarker_buffer (end
), buffer
))
2508 error ("Marker points into wrong buffer");
2510 CHECK_NUMBER_COERCE_MARKER (beg
, 1);
2511 CHECK_NUMBER_COERCE_MARKER (end
, 1);
2513 if (XINT (beg
) > XINT (end
))
2516 temp
= beg
; beg
= end
; end
= temp
;
2519 b
= XBUFFER (buffer
);
2521 beg
= Fset_marker (Fmake_marker (), beg
, buffer
);
2522 end
= Fset_marker (Fmake_marker (), end
, buffer
);
2524 if (!NILP (front_advance
))
2525 XMARKER (beg
)->insertion_type
= 1;
2526 if (!NILP (rear_advance
))
2527 XMARKER (end
)->insertion_type
= 1;
2529 overlay
= allocate_misc ();
2530 XMISCTYPE (overlay
) = Lisp_Misc_Overlay
;
2531 XOVERLAY (overlay
)->start
= beg
;
2532 XOVERLAY (overlay
)->end
= end
;
2533 XOVERLAY (overlay
)->plist
= Qnil
;
2535 /* Put the new overlay on the wrong list. */
2536 end
= OVERLAY_END (overlay
);
2537 if (OVERLAY_POSITION (end
) < XINT (b
->overlay_center
))
2538 b
->overlays_after
= Fcons (overlay
, b
->overlays_after
);
2540 b
->overlays_before
= Fcons (overlay
, b
->overlays_before
);
2542 /* This puts it in the right list, and in the right order. */
2543 recenter_overlay_lists (b
, XINT (b
->overlay_center
));
2545 /* We don't need to redisplay the region covered by the overlay, because
2546 the overlay has no properties at the moment. */
2551 DEFUN ("move-overlay", Fmove_overlay
, Smove_overlay
, 3, 4, 0,
2552 "Set the endpoints of OVERLAY to BEG and END in BUFFER.\n\
2553 If BUFFER is omitted, leave OVERLAY in the same buffer it inhabits now.\n\
2554 If BUFFER is omitted, and OVERLAY is in no buffer, put it in the current\n\
2556 (overlay
, beg
, end
, buffer
)
2557 Lisp_Object overlay
, beg
, end
, buffer
;
2559 struct buffer
*b
, *ob
;
2560 Lisp_Object obuffer
;
2561 int count
= specpdl_ptr
- specpdl
;
2563 CHECK_OVERLAY (overlay
, 0);
2565 buffer
= Fmarker_buffer (OVERLAY_START (overlay
));
2567 XSETBUFFER (buffer
, current_buffer
);
2568 CHECK_BUFFER (buffer
, 3);
2571 && ! EQ (Fmarker_buffer (beg
), buffer
))
2572 error ("Marker points into wrong buffer");
2574 && ! EQ (Fmarker_buffer (end
), buffer
))
2575 error ("Marker points into wrong buffer");
2577 CHECK_NUMBER_COERCE_MARKER (beg
, 1);
2578 CHECK_NUMBER_COERCE_MARKER (end
, 1);
2580 if (XINT (beg
) == XINT (end
) && ! NILP (Foverlay_get (overlay
, Qevaporate
)))
2581 return Fdelete_overlay (overlay
);
2583 if (XINT (beg
) > XINT (end
))
2586 temp
= beg
; beg
= end
; end
= temp
;
2589 specbind (Qinhibit_quit
, Qt
);
2591 obuffer
= Fmarker_buffer (OVERLAY_START (overlay
));
2592 b
= XBUFFER (buffer
);
2593 ob
= XBUFFER (obuffer
);
2595 /* If the overlay has changed buffers, do a thorough redisplay. */
2596 if (!EQ (buffer
, obuffer
))
2598 /* Redisplay where the overlay was. */
2599 if (!NILP (obuffer
))
2604 o_beg
= OVERLAY_START (overlay
);
2605 o_end
= OVERLAY_END (overlay
);
2606 o_beg
= OVERLAY_POSITION (o_beg
);
2607 o_end
= OVERLAY_POSITION (o_end
);
2609 redisplay_region (ob
, XINT (o_beg
), XINT (o_end
));
2612 /* Redisplay where the overlay is going to be. */
2613 redisplay_region (b
, XINT (beg
), XINT (end
));
2616 /* Redisplay the area the overlay has just left, or just enclosed. */
2620 int change_beg
, change_end
;
2622 o_beg
= OVERLAY_START (overlay
);
2623 o_end
= OVERLAY_END (overlay
);
2624 o_beg
= OVERLAY_POSITION (o_beg
);
2625 o_end
= OVERLAY_POSITION (o_end
);
2627 if (XINT (o_beg
) == XINT (beg
))
2628 redisplay_region (b
, XINT (o_end
), XINT (end
));
2629 else if (XINT (o_end
) == XINT (end
))
2630 redisplay_region (b
, XINT (o_beg
), XINT (beg
));
2633 if (XINT (beg
) < XINT (o_beg
)) o_beg
= beg
;
2634 if (XINT (end
) > XINT (o_end
)) o_end
= end
;
2635 redisplay_region (b
, XINT (o_beg
), XINT (o_end
));
2639 if (!NILP (obuffer
))
2641 ob
->overlays_before
= Fdelq (overlay
, ob
->overlays_before
);
2642 ob
->overlays_after
= Fdelq (overlay
, ob
->overlays_after
);
2645 Fset_marker (OVERLAY_START (overlay
), beg
, buffer
);
2646 Fset_marker (OVERLAY_END (overlay
), end
, buffer
);
2648 /* Put the overlay on the wrong list. */
2649 end
= OVERLAY_END (overlay
);
2650 if (OVERLAY_POSITION (end
) < XINT (b
->overlay_center
))
2651 b
->overlays_after
= Fcons (overlay
, b
->overlays_after
);
2653 b
->overlays_before
= Fcons (overlay
, b
->overlays_before
);
2655 /* This puts it in the right list, and in the right order. */
2656 recenter_overlay_lists (b
, XINT (b
->overlay_center
));
2658 return unbind_to (count
, overlay
);
2661 DEFUN ("delete-overlay", Fdelete_overlay
, Sdelete_overlay
, 1, 1, 0,
2662 "Delete the overlay OVERLAY from its buffer.")
2664 Lisp_Object overlay
;
2668 int count
= specpdl_ptr
- specpdl
;
2670 CHECK_OVERLAY (overlay
, 0);
2672 buffer
= Fmarker_buffer (OVERLAY_START (overlay
));
2676 b
= XBUFFER (buffer
);
2678 specbind (Qinhibit_quit
, Qt
);
2680 b
->overlays_before
= Fdelq (overlay
, b
->overlays_before
);
2681 b
->overlays_after
= Fdelq (overlay
, b
->overlays_after
);
2683 redisplay_region (b
,
2684 marker_position (OVERLAY_START (overlay
)),
2685 marker_position (OVERLAY_END (overlay
)));
2687 Fset_marker (OVERLAY_START (overlay
), Qnil
, Qnil
);
2688 Fset_marker (OVERLAY_END (overlay
), Qnil
, Qnil
);
2690 return unbind_to (count
, Qnil
);
2693 /* Overlay dissection functions. */
2695 DEFUN ("overlay-start", Foverlay_start
, Soverlay_start
, 1, 1, 0,
2696 "Return the position at which OVERLAY starts.")
2698 Lisp_Object overlay
;
2700 CHECK_OVERLAY (overlay
, 0);
2702 return (Fmarker_position (OVERLAY_START (overlay
)));
2705 DEFUN ("overlay-end", Foverlay_end
, Soverlay_end
, 1, 1, 0,
2706 "Return the position at which OVERLAY ends.")
2708 Lisp_Object overlay
;
2710 CHECK_OVERLAY (overlay
, 0);
2712 return (Fmarker_position (OVERLAY_END (overlay
)));
2715 DEFUN ("overlay-buffer", Foverlay_buffer
, Soverlay_buffer
, 1, 1, 0,
2716 "Return the buffer OVERLAY belongs to.")
2718 Lisp_Object overlay
;
2720 CHECK_OVERLAY (overlay
, 0);
2722 return Fmarker_buffer (OVERLAY_START (overlay
));
2725 DEFUN ("overlay-properties", Foverlay_properties
, Soverlay_properties
, 1, 1, 0,
2726 "Return a list of the properties on OVERLAY.\n\
2727 This is a copy of OVERLAY's plist; modifying its conses has no effect on\n\
2730 Lisp_Object overlay
;
2732 CHECK_OVERLAY (overlay
, 0);
2734 return Fcopy_sequence (XOVERLAY (overlay
)->plist
);
2738 DEFUN ("overlays-at", Foverlays_at
, Soverlays_at
, 1, 1, 0,
2739 "Return a list of the overlays that contain position POS.")
2744 Lisp_Object
*overlay_vec
;
2748 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
2751 overlay_vec
= (Lisp_Object
*) xmalloc (len
* sizeof (Lisp_Object
));
2753 /* Put all the overlays we want in a vector in overlay_vec.
2754 Store the length in len. */
2755 noverlays
= overlays_at (XINT (pos
), 1, &overlay_vec
, &len
,
2756 (int *) 0, (int *) 0);
2758 /* Make a list of them all. */
2759 result
= Flist (noverlays
, overlay_vec
);
2761 xfree (overlay_vec
);
2765 DEFUN ("overlays-in", Foverlays_in
, Soverlays_in
, 2, 2, 0,
2766 "Return a list of the overlays that overlap the region BEG ... END.\n\
2767 Overlap means that at least one character is contained within the overlay\n\
2768 and also contained within the specified region.\n\
2769 Empty overlays are included in the result if they are located at BEG\n\
2770 or between BEG and END.")
2772 Lisp_Object beg
, end
;
2775 Lisp_Object
*overlay_vec
;
2779 CHECK_NUMBER_COERCE_MARKER (beg
, 0);
2780 CHECK_NUMBER_COERCE_MARKER (end
, 0);
2783 overlay_vec
= (Lisp_Object
*) xmalloc (len
* sizeof (Lisp_Object
));
2785 /* Put all the overlays we want in a vector in overlay_vec.
2786 Store the length in len. */
2787 noverlays
= overlays_in (XINT (beg
), XINT (end
), 1, &overlay_vec
, &len
,
2788 (int *) 0, (int *) 0);
2790 /* Make a list of them all. */
2791 result
= Flist (noverlays
, overlay_vec
);
2793 xfree (overlay_vec
);
2797 DEFUN ("next-overlay-change", Fnext_overlay_change
, Snext_overlay_change
,
2799 "Return the next position after POS where an overlay starts or ends.\n\
2800 If there are no more overlay boundaries after POS, return (point-max).")
2806 Lisp_Object
*overlay_vec
;
2810 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
2813 overlay_vec
= (Lisp_Object
*) xmalloc (len
* sizeof (Lisp_Object
));
2815 /* Put all the overlays we want in a vector in overlay_vec.
2816 Store the length in len.
2817 endpos gets the position where the next overlay starts. */
2818 noverlays
= overlays_at (XINT (pos
), 1, &overlay_vec
, &len
,
2819 &endpos
, (int *) 0);
2821 /* If any of these overlays ends before endpos,
2822 use its ending point instead. */
2823 for (i
= 0; i
< noverlays
; i
++)
2828 oend
= OVERLAY_END (overlay_vec
[i
]);
2829 oendpos
= OVERLAY_POSITION (oend
);
2830 if (oendpos
< endpos
)
2834 xfree (overlay_vec
);
2835 return make_number (endpos
);
2838 DEFUN ("previous-overlay-change", Fprevious_overlay_change
,
2839 Sprevious_overlay_change
, 1, 1, 0,
2840 "Return the previous position before POS where an overlay starts or ends.\n\
2841 If there are no more overlay boundaries before POS, return (point-min).")
2847 Lisp_Object
*overlay_vec
;
2852 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
2855 overlay_vec
= (Lisp_Object
*) xmalloc (len
* sizeof (Lisp_Object
));
2857 /* At beginning of buffer, we know the answer;
2858 avoid bug subtracting 1 below. */
2859 if (XINT (pos
) == BEGV
)
2862 /* Put all the overlays we want in a vector in overlay_vec.
2863 Store the length in len.
2864 prevpos gets the position of an overlay end. */
2865 noverlays
= overlays_at (XINT (pos
), 1, &overlay_vec
, &len
,
2866 (int *) 0, &prevpos
);
2868 /* If any of these overlays starts after prevpos,
2869 maybe use its starting point instead. */
2870 for (i
= 0; i
< noverlays
; i
++)
2875 ostart
= OVERLAY_START (overlay_vec
[i
]);
2876 ostartpos
= OVERLAY_POSITION (ostart
);
2877 if (ostartpos
> prevpos
&& ostartpos
< XINT (pos
))
2878 prevpos
= ostartpos
;
2881 /* If any overlay ends at pos, consider its starting point too. */
2882 for (tail
= current_buffer
->overlays_before
;
2884 tail
= XCONS (tail
)->cdr
)
2886 Lisp_Object overlay
, ostart
;
2889 overlay
= XCONS (tail
)->car
;
2891 ostart
= OVERLAY_START (overlay
);
2892 ostartpos
= OVERLAY_POSITION (ostart
);
2893 if (ostartpos
> prevpos
&& ostartpos
< XINT (pos
))
2894 prevpos
= ostartpos
;
2897 xfree (overlay_vec
);
2898 return make_number (prevpos
);
2901 /* These functions are for debugging overlays. */
2903 DEFUN ("overlay-lists", Foverlay_lists
, Soverlay_lists
, 0, 0, 0,
2904 "Return a pair of lists giving all the overlays of the current buffer.\n\
2905 The car has all the overlays before the overlay center;\n\
2906 the cdr has all the overlays after the overlay center.\n\
2907 Recentering overlays moves overlays between these lists.\n\
2908 The lists you get are copies, so that changing them has no effect.\n\
2909 However, the overlays you get are the real objects that the buffer uses.")
2912 Lisp_Object before
, after
;
2913 before
= current_buffer
->overlays_before
;
2915 before
= Fcopy_sequence (before
);
2916 after
= current_buffer
->overlays_after
;
2918 after
= Fcopy_sequence (after
);
2920 return Fcons (before
, after
);
2923 DEFUN ("overlay-recenter", Foverlay_recenter
, Soverlay_recenter
, 1, 1, 0,
2924 "Recenter the overlays of the current buffer around position POS.")
2928 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
2930 recenter_overlay_lists (current_buffer
, XINT (pos
));
2934 DEFUN ("overlay-get", Foverlay_get
, Soverlay_get
, 2, 2, 0,
2935 "Get the property of overlay OVERLAY with property name PROP.")
2937 Lisp_Object overlay
, prop
;
2939 Lisp_Object plist
, fallback
;
2941 CHECK_OVERLAY (overlay
, 0);
2945 for (plist
= XOVERLAY (overlay
)->plist
;
2946 CONSP (plist
) && CONSP (XCONS (plist
)->cdr
);
2947 plist
= XCONS (XCONS (plist
)->cdr
)->cdr
)
2949 if (EQ (XCONS (plist
)->car
, prop
))
2950 return XCONS (XCONS (plist
)->cdr
)->car
;
2951 else if (EQ (XCONS (plist
)->car
, Qcategory
))
2954 tem
= Fcar (Fcdr (plist
));
2956 fallback
= Fget (tem
, prop
);
2963 DEFUN ("overlay-put", Foverlay_put
, Soverlay_put
, 3, 3, 0,
2964 "Set one property of overlay OVERLAY: give property PROP value VALUE.")
2965 (overlay
, prop
, value
)
2966 Lisp_Object overlay
, prop
, value
;
2968 Lisp_Object tail
, buffer
;
2971 CHECK_OVERLAY (overlay
, 0);
2973 buffer
= Fmarker_buffer (OVERLAY_START (overlay
));
2975 for (tail
= XOVERLAY (overlay
)->plist
;
2976 CONSP (tail
) && CONSP (XCONS (tail
)->cdr
);
2977 tail
= XCONS (XCONS (tail
)->cdr
)->cdr
)
2978 if (EQ (XCONS (tail
)->car
, prop
))
2980 changed
= !EQ (XCONS (XCONS (tail
)->cdr
)->car
, value
);
2981 XCONS (XCONS (tail
)->cdr
)->car
= value
;
2984 /* It wasn't in the list, so add it to the front. */
2985 changed
= !NILP (value
);
2986 XOVERLAY (overlay
)->plist
2987 = Fcons (prop
, Fcons (value
, XOVERLAY (overlay
)->plist
));
2989 if (! NILP (buffer
))
2992 redisplay_region (XBUFFER (buffer
),
2993 marker_position (OVERLAY_START (overlay
)),
2994 marker_position (OVERLAY_END (overlay
)));
2995 if (EQ (prop
, Qevaporate
) && ! NILP (value
)
2996 && (OVERLAY_POSITION (OVERLAY_START (overlay
))
2997 == OVERLAY_POSITION (OVERLAY_END (overlay
))))
2998 Fdelete_overlay (overlay
);
3003 /* Subroutine of report_overlay_modification. */
3005 /* Lisp vector holding overlay hook functions to call.
3006 Vector elements come in pairs.
3007 Each even-index element is a list of hook functions.
3008 The following odd-index element is the overlay they came from.
3010 Before the buffer change, we fill in this vector
3011 as we call overlay hook functions.
3012 After the buffer change, we get the functions to call from this vector.
3013 This way we always call the same functions before and after the change. */
3014 static Lisp_Object last_overlay_modification_hooks
;
3016 /* Number of elements actually used in last_overlay_modification_hooks. */
3017 static int last_overlay_modification_hooks_used
;
3019 /* Add one functionlist/overlay pair
3020 to the end of last_overlay_modification_hooks. */
3023 add_overlay_mod_hooklist (functionlist
, overlay
)
3024 Lisp_Object functionlist
, overlay
;
3026 int oldsize
= XVECTOR (last_overlay_modification_hooks
)->size
;
3028 if (last_overlay_modification_hooks_used
== oldsize
)
3031 old
= last_overlay_modification_hooks
;
3032 last_overlay_modification_hooks
3033 = Fmake_vector (make_number (oldsize
* 2), Qnil
);
3034 bcopy (XVECTOR (last_overlay_modification_hooks
)->contents
,
3035 XVECTOR (old
)->contents
,
3036 sizeof (Lisp_Object
) * oldsize
);
3038 XVECTOR (last_overlay_modification_hooks
)->contents
[last_overlay_modification_hooks_used
++] = functionlist
;
3039 XVECTOR (last_overlay_modification_hooks
)->contents
[last_overlay_modification_hooks_used
++] = overlay
;
3042 /* Run the modification-hooks of overlays that include
3043 any part of the text in START to END.
3044 If this change is an insertion, also
3045 run the insert-before-hooks of overlay starting at END,
3046 and the insert-after-hooks of overlay ending at START.
3048 This is called both before and after the modification.
3049 AFTER is nonzero when we call after the modification.
3051 ARG1, ARG2, ARG3 are arguments to pass to the hook functions.
3052 When AFTER is nonzero, they are the start position,
3053 the position after the inserted new text,
3054 and the length of deleted or replaced old text. */
3057 report_overlay_modification (start
, end
, after
, arg1
, arg2
, arg3
)
3058 Lisp_Object start
, end
;
3060 Lisp_Object arg1
, arg2
, arg3
;
3062 Lisp_Object prop
, overlay
, tail
;
3063 /* 1 if this change is an insertion. */
3064 int insertion
= (after
? XFASTINT (arg3
) == 0 : EQ (start
, end
));
3066 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3070 GCPRO5 (overlay
, tail
, arg1
, arg2
, arg3
);
3074 /* Call the functions recorded in last_overlay_modification_hooks
3075 rather than scanning the overlays again.
3076 First copy the vector contents, in case some of these hooks
3077 do subsequent modification of the buffer. */
3078 int size
= last_overlay_modification_hooks_used
;
3079 Lisp_Object
*copy
= (Lisp_Object
*) alloca (size
* sizeof (Lisp_Object
));
3082 bcopy (XVECTOR (last_overlay_modification_hooks
)->contents
,
3083 copy
, size
* sizeof (Lisp_Object
));
3085 gcpro1
.nvars
= size
;
3087 for (i
= 0; i
< size
;)
3089 Lisp_Object prop
, overlay
;
3091 overlay
= copy
[i
++];
3092 call_overlay_mod_hooks (prop
, overlay
, after
, arg1
, arg2
, arg3
);
3098 /* We are being called before a change.
3099 Scan the overlays to find the functions to call. */
3100 last_overlay_modification_hooks_used
= 0;
3102 for (tail
= current_buffer
->overlays_before
;
3104 tail
= XCONS (tail
)->cdr
)
3106 int startpos
, endpos
;
3107 Lisp_Object ostart
, oend
;
3109 overlay
= XCONS (tail
)->car
;
3111 ostart
= OVERLAY_START (overlay
);
3112 oend
= OVERLAY_END (overlay
);
3113 endpos
= OVERLAY_POSITION (oend
);
3114 if (XFASTINT (start
) > endpos
)
3116 startpos
= OVERLAY_POSITION (ostart
);
3117 if (insertion
&& (XFASTINT (start
) == startpos
3118 || XFASTINT (end
) == startpos
))
3120 prop
= Foverlay_get (overlay
, Qinsert_in_front_hooks
);
3123 /* Copy TAIL in case the hook recenters the overlay lists. */
3125 tail
= Fcopy_sequence (tail
);
3127 call_overlay_mod_hooks (prop
, overlay
, after
, arg1
, arg2
, arg3
);
3130 if (insertion
&& (XFASTINT (start
) == endpos
3131 || XFASTINT (end
) == endpos
))
3133 prop
= Foverlay_get (overlay
, Qinsert_behind_hooks
);
3137 tail
= Fcopy_sequence (tail
);
3139 call_overlay_mod_hooks (prop
, overlay
, after
, arg1
, arg2
, arg3
);
3142 /* Test for intersecting intervals. This does the right thing
3143 for both insertion and deletion. */
3144 if (XFASTINT (end
) > startpos
&& XFASTINT (start
) < endpos
)
3146 prop
= Foverlay_get (overlay
, Qmodification_hooks
);
3150 tail
= Fcopy_sequence (tail
);
3152 call_overlay_mod_hooks (prop
, overlay
, after
, arg1
, arg2
, arg3
);
3158 for (tail
= current_buffer
->overlays_after
;
3160 tail
= XCONS (tail
)->cdr
)
3162 int startpos
, endpos
;
3163 Lisp_Object ostart
, oend
;
3165 overlay
= XCONS (tail
)->car
;
3167 ostart
= OVERLAY_START (overlay
);
3168 oend
= OVERLAY_END (overlay
);
3169 startpos
= OVERLAY_POSITION (ostart
);
3170 endpos
= OVERLAY_POSITION (oend
);
3171 if (XFASTINT (end
) < startpos
)
3173 if (insertion
&& (XFASTINT (start
) == startpos
3174 || XFASTINT (end
) == startpos
))
3176 prop
= Foverlay_get (overlay
, Qinsert_in_front_hooks
);
3180 tail
= Fcopy_sequence (tail
);
3182 call_overlay_mod_hooks (prop
, overlay
, after
, arg1
, arg2
, arg3
);
3185 if (insertion
&& (XFASTINT (start
) == endpos
3186 || XFASTINT (end
) == endpos
))
3188 prop
= Foverlay_get (overlay
, Qinsert_behind_hooks
);
3192 tail
= Fcopy_sequence (tail
);
3194 call_overlay_mod_hooks (prop
, overlay
, after
, arg1
, arg2
, arg3
);
3197 /* Test for intersecting intervals. This does the right thing
3198 for both insertion and deletion. */
3199 if (XFASTINT (end
) > startpos
&& XFASTINT (start
) < endpos
)
3201 prop
= Foverlay_get (overlay
, Qmodification_hooks
);
3205 tail
= Fcopy_sequence (tail
);
3207 call_overlay_mod_hooks (prop
, overlay
, after
, arg1
, arg2
, arg3
);
3216 call_overlay_mod_hooks (list
, overlay
, after
, arg1
, arg2
, arg3
)
3217 Lisp_Object list
, overlay
;
3219 Lisp_Object arg1
, arg2
, arg3
;
3221 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3223 GCPRO4 (list
, arg1
, arg2
, arg3
);
3225 add_overlay_mod_hooklist (list
, overlay
);
3227 while (!NILP (list
))
3230 call4 (Fcar (list
), overlay
, after
? Qt
: Qnil
, arg1
, arg2
);
3232 call5 (Fcar (list
), overlay
, after
? Qt
: Qnil
, arg1
, arg2
, arg3
);
3238 /* Delete any zero-sized overlays at position POS, if the `evaporate'
3241 evaporate_overlays (pos
)
3244 Lisp_Object tail
, overlay
, hit_list
;
3247 if (pos
<= XFASTINT (current_buffer
->overlay_center
))
3248 for (tail
= current_buffer
->overlays_before
; CONSP (tail
);
3249 tail
= XCONS (tail
)->cdr
)
3252 overlay
= XCONS (tail
)->car
;
3253 endpos
= OVERLAY_POSITION (OVERLAY_END (overlay
));
3256 if (endpos
== pos
&& OVERLAY_POSITION (OVERLAY_START (overlay
)) == pos
3257 && ! NILP (Foverlay_get (overlay
, Qevaporate
)))
3258 hit_list
= Fcons (overlay
, hit_list
);
3261 for (tail
= current_buffer
->overlays_after
; CONSP (tail
);
3262 tail
= XCONS (tail
)->cdr
)
3265 overlay
= XCONS (tail
)->car
;
3266 startpos
= OVERLAY_POSITION (OVERLAY_START (overlay
));
3269 if (startpos
== pos
&& OVERLAY_POSITION (OVERLAY_END (overlay
)) == pos
3270 && ! NILP (Foverlay_get (overlay
, Qevaporate
)))
3271 hit_list
= Fcons (overlay
, hit_list
);
3273 for (; CONSP (hit_list
); hit_list
= XCONS (hit_list
)->cdr
)
3274 Fdelete_overlay (XCONS (hit_list
)->car
);
3277 /* Somebody has tried to store a value with an unacceptable type
3278 into the buffer-local slot with offset OFFSET. */
3280 buffer_slot_type_mismatch (offset
)
3285 sym
= *(Lisp_Object
*)(offset
+ (char *)&buffer_local_symbols
);
3286 switch (XINT (*(Lisp_Object
*)(offset
+ (char *)&buffer_local_types
)))
3288 case Lisp_Int
: type_name
= "integers"; break;
3289 case Lisp_String
: type_name
= "strings"; break;
3290 case Lisp_Symbol
: type_name
= "symbols"; break;
3295 error ("only %s should be stored in the buffer-local variable %s",
3296 type_name
, XSYMBOL (sym
)->name
->data
);
3301 register Lisp_Object tem
;
3303 /* Make sure all markable slots in buffer_defaults
3304 are initialized reasonably, so mark_buffer won't choke. */
3305 reset_buffer (&buffer_defaults
);
3306 reset_buffer_local_variables (&buffer_defaults
);
3307 reset_buffer (&buffer_local_symbols
);
3308 reset_buffer_local_variables (&buffer_local_symbols
);
3309 /* Prevent GC from getting confused. */
3310 buffer_defaults
.text
= &buffer_defaults
.own_text
;
3311 buffer_local_symbols
.text
= &buffer_local_symbols
.own_text
;
3312 #ifdef USE_TEXT_PROPERTIES
3313 BUF_INTERVALS (&buffer_defaults
) = 0;
3314 BUF_INTERVALS (&buffer_local_symbols
) = 0;
3316 XSETBUFFER (Vbuffer_defaults
, &buffer_defaults
);
3317 XSETBUFFER (Vbuffer_local_symbols
, &buffer_local_symbols
);
3319 /* Set up the default values of various buffer slots. */
3320 /* Must do these before making the first buffer! */
3322 /* real setup is done in loaddefs.el */
3323 buffer_defaults
.mode_line_format
= build_string ("%-");
3324 buffer_defaults
.abbrev_mode
= Qnil
;
3325 buffer_defaults
.overwrite_mode
= Qnil
;
3326 buffer_defaults
.case_fold_search
= Qt
;
3327 buffer_defaults
.auto_fill_function
= Qnil
;
3328 buffer_defaults
.selective_display
= Qnil
;
3330 buffer_defaults
.selective_display_ellipses
= Qt
;
3332 buffer_defaults
.abbrev_table
= Qnil
;
3333 buffer_defaults
.display_table
= Qnil
;
3334 buffer_defaults
.undo_list
= Qnil
;
3335 buffer_defaults
.mark_active
= Qnil
;
3336 buffer_defaults
.file_format
= Qnil
;
3337 buffer_defaults
.overlays_before
= Qnil
;
3338 buffer_defaults
.overlays_after
= Qnil
;
3339 XSETFASTINT (buffer_defaults
.overlay_center
, BEG
);
3341 XSETFASTINT (buffer_defaults
.tab_width
, 8);
3342 buffer_defaults
.truncate_lines
= Qnil
;
3343 buffer_defaults
.ctl_arrow
= Qt
;
3346 buffer_defaults
.buffer_file_type
= Qnil
; /* TEXT */
3348 XSETFASTINT (buffer_defaults
.fill_column
, 70);
3349 XSETFASTINT (buffer_defaults
.left_margin
, 0);
3350 buffer_defaults
.cache_long_line_scans
= Qnil
;
3351 buffer_defaults
.file_truename
= Qnil
;
3353 /* Assign the local-flags to the slots that have default values.
3354 The local flag is a bit that is used in the buffer
3355 to say that it has its own local value for the slot.
3356 The local flag bits are in the local_var_flags slot of the buffer. */
3358 /* Nothing can work if this isn't true */
3359 if (sizeof (EMACS_INT
) != sizeof (Lisp_Object
)) abort ();
3361 /* 0 means not a lisp var, -1 means always local, else mask */
3362 bzero (&buffer_local_flags
, sizeof buffer_local_flags
);
3363 XSETINT (buffer_local_flags
.filename
, -1);
3364 XSETINT (buffer_local_flags
.directory
, -1);
3365 XSETINT (buffer_local_flags
.backed_up
, -1);
3366 XSETINT (buffer_local_flags
.save_length
, -1);
3367 XSETINT (buffer_local_flags
.auto_save_file_name
, -1);
3368 XSETINT (buffer_local_flags
.read_only
, -1);
3369 XSETINT (buffer_local_flags
.major_mode
, -1);
3370 XSETINT (buffer_local_flags
.mode_name
, -1);
3371 XSETINT (buffer_local_flags
.undo_list
, -1);
3372 XSETINT (buffer_local_flags
.mark_active
, -1);
3373 XSETINT (buffer_local_flags
.point_before_scroll
, -1);
3374 XSETINT (buffer_local_flags
.file_truename
, -1);
3375 XSETINT (buffer_local_flags
.invisibility_spec
, -1);
3376 XSETINT (buffer_local_flags
.file_format
, -1);
3378 XSETFASTINT (buffer_local_flags
.mode_line_format
, 1);
3379 XSETFASTINT (buffer_local_flags
.abbrev_mode
, 2);
3380 XSETFASTINT (buffer_local_flags
.overwrite_mode
, 4);
3381 XSETFASTINT (buffer_local_flags
.case_fold_search
, 8);
3382 XSETFASTINT (buffer_local_flags
.auto_fill_function
, 0x10);
3383 XSETFASTINT (buffer_local_flags
.selective_display
, 0x20);
3385 XSETFASTINT (buffer_local_flags
.selective_display_ellipses
, 0x40);
3387 XSETFASTINT (buffer_local_flags
.tab_width
, 0x80);
3388 XSETFASTINT (buffer_local_flags
.truncate_lines
, 0x100);
3389 XSETFASTINT (buffer_local_flags
.ctl_arrow
, 0x200);
3390 XSETFASTINT (buffer_local_flags
.fill_column
, 0x400);
3391 XSETFASTINT (buffer_local_flags
.left_margin
, 0x800);
3392 XSETFASTINT (buffer_local_flags
.abbrev_table
, 0x1000);
3393 XSETFASTINT (buffer_local_flags
.display_table
, 0x2000);
3394 XSETFASTINT (buffer_local_flags
.syntax_table
, 0x8000);
3395 XSETFASTINT (buffer_local_flags
.cache_long_line_scans
, 0x10000);
3397 XSETFASTINT (buffer_local_flags
.buffer_file_type
, 0x4000);
3400 Vbuffer_alist
= Qnil
;
3404 QSFundamental
= build_string ("Fundamental");
3406 Qfundamental_mode
= intern ("fundamental-mode");
3407 buffer_defaults
.major_mode
= Qfundamental_mode
;
3409 Qmode_class
= intern ("mode-class");
3411 Qprotected_field
= intern ("protected-field");
3413 Qpermanent_local
= intern ("permanent-local");
3415 Qkill_buffer_hook
= intern ("kill-buffer-hook");
3417 Vprin1_to_string_buffer
= Fget_buffer_create (build_string (" prin1"));
3418 /* super-magic invisible buffer */
3419 Vbuffer_alist
= Qnil
;
3421 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
3426 char buf
[MAXPATHLEN
+1];
3428 struct stat dotstat
, pwdstat
;
3432 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
3434 /* If PWD is accurate, use it instead of calling getwd. This is faster
3435 when PWD is right, and may avoid a fatal error. */
3436 if ((pwd
= getenv ("PWD")) != 0 && IS_DIRECTORY_SEP (*pwd
)
3437 && stat (pwd
, &pwdstat
) == 0
3438 && stat (".", &dotstat
) == 0
3439 && dotstat
.st_ino
== pwdstat
.st_ino
3440 && dotstat
.st_dev
== pwdstat
.st_dev
3441 && strlen (pwd
) < MAXPATHLEN
)
3443 else if (getwd (buf
) == 0)
3444 fatal ("`getwd' failed: %s\n", buf
);
3447 /* Maybe this should really use some standard subroutine
3448 whose definition is filename syntax dependent. */
3450 if (!(IS_DIRECTORY_SEP (buf
[rc
- 1])))
3452 buf
[rc
] = DIRECTORY_SEP
;
3455 #endif /* not VMS */
3456 current_buffer
->directory
= build_string (buf
);
3458 temp
= get_minibuffer (0);
3459 XBUFFER (temp
)->directory
= current_buffer
->directory
;
3462 /* initialize the buffer routines */
3465 extern Lisp_Object Qdisabled
;
3467 staticpro (&last_overlay_modification_hooks
);
3468 last_overlay_modification_hooks
3469 = Fmake_vector (make_number (10), Qnil
);
3471 staticpro (&Vbuffer_defaults
);
3472 staticpro (&Vbuffer_local_symbols
);
3473 staticpro (&Qfundamental_mode
);
3474 staticpro (&Qmode_class
);
3475 staticpro (&QSFundamental
);
3476 staticpro (&Vbuffer_alist
);
3477 staticpro (&Qprotected_field
);
3478 staticpro (&Qpermanent_local
);
3479 staticpro (&Qkill_buffer_hook
);
3480 Qoverlayp
= intern ("overlayp");
3481 staticpro (&Qoverlayp
);
3482 Qevaporate
= intern ("evaporate");
3483 staticpro (&Qevaporate
);
3484 Qmodification_hooks
= intern ("modification-hooks");
3485 staticpro (&Qmodification_hooks
);
3486 Qinsert_in_front_hooks
= intern ("insert-in-front-hooks");
3487 staticpro (&Qinsert_in_front_hooks
);
3488 Qinsert_behind_hooks
= intern ("insert-behind-hooks");
3489 staticpro (&Qinsert_behind_hooks
);
3490 Qget_file_buffer
= intern ("get-file-buffer");
3491 staticpro (&Qget_file_buffer
);
3492 Qpriority
= intern ("priority");
3493 staticpro (&Qpriority
);
3494 Qwindow
= intern ("window");
3495 staticpro (&Qwindow
);
3496 Qbefore_string
= intern ("before-string");
3497 staticpro (&Qbefore_string
);
3498 Qafter_string
= intern ("after-string");
3499 staticpro (&Qafter_string
);
3500 Qfirst_change_hook
= intern ("first-change-hook");
3501 staticpro (&Qfirst_change_hook
);
3502 Qbefore_change_functions
= intern ("before-change-functions");
3503 staticpro (&Qbefore_change_functions
);
3504 Qafter_change_functions
= intern ("after-change-functions");
3505 staticpro (&Qafter_change_functions
);
3507 Fput (Qprotected_field
, Qerror_conditions
,
3508 Fcons (Qprotected_field
, Fcons (Qerror
, Qnil
)));
3509 Fput (Qprotected_field
, Qerror_message
,
3510 build_string ("Attempt to modify a protected field"));
3512 /* All these use DEFVAR_LISP_NOPRO because the slots in
3513 buffer_defaults will all be marked via Vbuffer_defaults. */
3515 DEFVAR_LISP_NOPRO ("default-mode-line-format",
3516 &buffer_defaults
.mode_line_format
,
3517 "Default value of `mode-line-format' for buffers that don't override it.\n\
3518 This is the same as (default-value 'mode-line-format).");
3520 DEFVAR_LISP_NOPRO ("default-abbrev-mode",
3521 &buffer_defaults
.abbrev_mode
,
3522 "Default value of `abbrev-mode' for buffers that do not override it.\n\
3523 This is the same as (default-value 'abbrev-mode).");
3525 DEFVAR_LISP_NOPRO ("default-ctl-arrow",
3526 &buffer_defaults
.ctl_arrow
,
3527 "Default value of `ctl-arrow' for buffers that do not override it.\n\
3528 This is the same as (default-value 'ctl-arrow).");
3530 DEFVAR_LISP_NOPRO ("default-truncate-lines",
3531 &buffer_defaults
.truncate_lines
,
3532 "Default value of `truncate-lines' for buffers that do not override it.\n\
3533 This is the same as (default-value 'truncate-lines).");
3535 DEFVAR_LISP_NOPRO ("default-fill-column",
3536 &buffer_defaults
.fill_column
,
3537 "Default value of `fill-column' for buffers that do not override it.\n\
3538 This is the same as (default-value 'fill-column).");
3540 DEFVAR_LISP_NOPRO ("default-left-margin",
3541 &buffer_defaults
.left_margin
,
3542 "Default value of `left-margin' for buffers that do not override it.\n\
3543 This is the same as (default-value 'left-margin).");
3545 DEFVAR_LISP_NOPRO ("default-tab-width",
3546 &buffer_defaults
.tab_width
,
3547 "Default value of `tab-width' for buffers that do not override it.\n\
3548 This is the same as (default-value 'tab-width).");
3550 DEFVAR_LISP_NOPRO ("default-case-fold-search",
3551 &buffer_defaults
.case_fold_search
,
3552 "Default value of `case-fold-search' for buffers that don't override it.\n\
3553 This is the same as (default-value 'case-fold-search).");
3556 DEFVAR_LISP_NOPRO ("default-buffer-file-type",
3557 &buffer_defaults
.buffer_file_type
,
3558 "Default file type for buffers that do not override it.\n\
3559 This is the same as (default-value 'buffer-file-type).\n\
3560 The file type is nil for text, t for binary.");
3563 DEFVAR_PER_BUFFER ("mode-line-format", ¤t_buffer
->mode_line_format
,
3566 /* This doc string is too long for cpp; cpp dies if it isn't in a comment.
3567 But make-docfile finds it!
3568 DEFVAR_PER_BUFFER ("mode-line-format", ¤t_buffer->mode_line_format,
3570 "Template for displaying mode line for current buffer.\n\
3571 Each buffer has its own value of this variable.\n\
3572 Value may be a string, a symbol or a list or cons cell.\n\
3573 For a symbol, its value is used (but it is ignored if t or nil).\n\
3574 A string appearing directly as the value of a symbol is processed verbatim\n\
3575 in that the %-constructs below are not recognized.\n\
3576 For a list whose car is a symbol, the symbol's value is taken,\n\
3577 and if that is non-nil, the cadr of the list is processed recursively.\n\
3578 Otherwise, the caddr of the list (if there is one) is processed.\n\
3579 For a list whose car is a string or list, each element is processed\n\
3580 recursively and the results are effectively concatenated.\n\
3581 For a list whose car is an integer, the cdr of the list is processed\n\
3582 and padded (if the number is positive) or truncated (if negative)\n\
3583 to the width specified by that number.\n\
3584 A string is printed verbatim in the mode line except for %-constructs:\n\
3585 (%-constructs are allowed when the string is the entire mode-line-format\n\
3586 or when it is found in a cons-cell or a list)\n\
3587 %b -- print buffer name. %f -- print visited file name.\n\
3588 %* -- print %, * or hyphen. %+ -- print *, % or hyphen.\n\
3589 % means buffer is read-only and * means it is modified.\n\
3590 For a modified read-only buffer, %* gives % and %+ gives *.\n\
3591 %s -- print process status. %l -- print the current line number.\n\
3592 %p -- print percent of buffer above top of window, or Top, Bot or All.\n\
3593 %P -- print percent of buffer above bottom of window, perhaps plus Top,\n\
3594 or print Bottom or All.\n\
3595 %n -- print Narrow if appropriate.\n\
3596 %t -- print T if files is text, B if binary.\n\
3597 %[ -- print one [ for each recursive editing level. %] similar.\n\
3598 %% -- print %. %- -- print infinitely many dashes.\n\
3599 Decimal digits after the % specify field width to which to pad.");
3602 DEFVAR_LISP_NOPRO ("default-major-mode", &buffer_defaults
.major_mode
,
3603 "*Major mode for new buffers. Defaults to `fundamental-mode'.\n\
3604 nil here means use current buffer's major mode.");
3606 DEFVAR_PER_BUFFER ("major-mode", ¤t_buffer
->major_mode
,
3607 make_number (Lisp_Symbol
),
3608 "Symbol for current buffer's major mode.");
3610 DEFVAR_PER_BUFFER ("mode-name", ¤t_buffer
->mode_name
,
3611 make_number (Lisp_String
),
3612 "Pretty name of current buffer's major mode (a string).");
3614 DEFVAR_PER_BUFFER ("abbrev-mode", ¤t_buffer
->abbrev_mode
, Qnil
,
3615 "Non-nil turns on automatic expansion of abbrevs as they are inserted.\n\
3616 Automatically becomes buffer-local when set in any fashion.");
3618 DEFVAR_PER_BUFFER ("case-fold-search", ¤t_buffer
->case_fold_search
,
3620 "*Non-nil if searches should ignore case.\n\
3621 Automatically becomes buffer-local when set in any fashion.");
3623 DEFVAR_PER_BUFFER ("fill-column", ¤t_buffer
->fill_column
,
3624 make_number (Lisp_Int
),
3625 "*Column beyond which automatic line-wrapping should happen.\n\
3626 Automatically becomes buffer-local when set in any fashion.");
3628 DEFVAR_PER_BUFFER ("left-margin", ¤t_buffer
->left_margin
,
3629 make_number (Lisp_Int
),
3630 "*Column for the default indent-line-function to indent to.\n\
3631 Linefeed indents to this column in Fundamental mode.\n\
3632 Automatically becomes buffer-local when set in any fashion.");
3634 DEFVAR_PER_BUFFER ("tab-width", ¤t_buffer
->tab_width
,
3635 make_number (Lisp_Int
),
3636 "*Distance between tab stops (for display of tab characters), in columns.\n\
3637 Automatically becomes buffer-local when set in any fashion.");
3639 DEFVAR_PER_BUFFER ("ctl-arrow", ¤t_buffer
->ctl_arrow
, Qnil
,
3640 "*Non-nil means display control chars with uparrow.\n\
3641 Nil means use backslash and octal digits.\n\
3642 Automatically becomes buffer-local when set in any fashion.\n\
3643 This variable does not apply to characters whose display is specified\n\
3644 in the current display table (if there is one).");
3646 DEFVAR_PER_BUFFER ("truncate-lines", ¤t_buffer
->truncate_lines
, Qnil
,
3647 "*Non-nil means do not display continuation lines;\n\
3648 give each line of text one screen line.\n\
3649 Automatically becomes buffer-local when set in any fashion.\n\
3651 Note that this is overridden by the variable\n\
3652 `truncate-partial-width-windows' if that variable is non-nil\n\
3653 and this buffer is not full-frame width.");
3656 DEFVAR_PER_BUFFER ("buffer-file-type", ¤t_buffer
->buffer_file_type
,
3658 "Non-nil if the visited file is a binary file.\n\
3659 This variable is meaningful on MS-DOG and Windows NT.\n\
3660 On those systems, it is automatically local in every buffer.\n\
3661 On other systems, this variable is normally always nil.");
3664 DEFVAR_PER_BUFFER ("default-directory", ¤t_buffer
->directory
,
3665 make_number (Lisp_String
),
3666 "Name of default directory of current buffer. Should end with slash.\n\
3667 Each buffer has its own value of this variable.");
3669 DEFVAR_PER_BUFFER ("auto-fill-function", ¤t_buffer
->auto_fill_function
,
3671 "Function called (if non-nil) to perform auto-fill.\n\
3672 It is called after self-inserting a space at a column beyond `fill-column'.\n\
3673 Each buffer has its own value of this variable.\n\
3674 NOTE: This variable is not an ordinary hook;\n\
3675 It may not be a list of functions.");
3677 DEFVAR_PER_BUFFER ("buffer-file-name", ¤t_buffer
->filename
,
3678 make_number (Lisp_String
),
3679 "Name of file visited in current buffer, or nil if not visiting a file.\n\
3680 Each buffer has its own value of this variable.");
3682 DEFVAR_PER_BUFFER ("buffer-file-truename", ¤t_buffer
->file_truename
,
3683 make_number (Lisp_String
),
3684 "Abbreviated truename of file visited in current buffer, or nil if none.\n\
3685 The truename of a file is calculated by `file-truename'\n\
3686 and then abbreviated with `abbreviate-file-name'.\n\
3687 Each buffer has its own value of this variable.");
3689 DEFVAR_PER_BUFFER ("buffer-auto-save-file-name",
3690 ¤t_buffer
->auto_save_file_name
,
3691 make_number (Lisp_String
),
3692 "Name of file for auto-saving current buffer,\n\
3693 or nil if buffer should not be auto-saved.\n\
3694 Each buffer has its own value of this variable.");
3696 DEFVAR_PER_BUFFER ("buffer-read-only", ¤t_buffer
->read_only
, Qnil
,
3697 "Non-nil if this buffer is read-only.\n\
3698 Each buffer has its own value of this variable.");
3700 DEFVAR_PER_BUFFER ("buffer-backed-up", ¤t_buffer
->backed_up
, Qnil
,
3701 "Non-nil if this buffer's file has been backed up.\n\
3702 Backing up is done before the first time the file is saved.\n\
3703 Each buffer has its own value of this variable.");
3705 DEFVAR_PER_BUFFER ("buffer-saved-size", ¤t_buffer
->save_length
,
3706 make_number (Lisp_Int
),
3707 "Length of current buffer when last read in, saved or auto-saved.\n\
3709 Each buffer has its own value of this variable.");
3711 DEFVAR_PER_BUFFER ("selective-display", ¤t_buffer
->selective_display
,
3713 "Non-nil enables selective display:\n\
3714 Integer N as value means display only lines\n\
3715 that start with less than n columns of space.\n\
3716 A value of t means, after a ^M, all the rest of the line is invisible.\n\
3717 Then ^M's in the file are written into files as newlines.\n\n\
3718 Automatically becomes buffer-local when set in any fashion.");
3721 DEFVAR_PER_BUFFER ("selective-display-ellipses",
3722 ¤t_buffer
->selective_display_ellipses
,
3724 "t means display ... on previous line when a line is invisible.\n\
3725 Automatically becomes buffer-local when set in any fashion.");
3728 DEFVAR_PER_BUFFER ("overwrite-mode", ¤t_buffer
->overwrite_mode
, Qnil
,
3729 "Non-nil if self-insertion should replace existing text.\n\
3730 The value should be one of `overwrite-mode-textual',\n\
3731 `overwrite-mode-binary', or nil.\n\
3732 If it is `overwrite-mode-textual', self-insertion still\n\
3733 inserts at the end of a line, and inserts when point is before a tab,\n\
3734 until the tab is filled in.\n\
3735 If `overwrite-mode-binary', self-insertion replaces newlines and tabs too.\n\
3736 Automatically becomes buffer-local when set in any fashion.");
3738 #if 0 /* The doc string is too long for some compilers,
3739 but make-docfile can find it in this comment. */
3740 DEFVAR_PER_BUFFER ("buffer-display-table", ¤t_buffer
->display_table
,
3742 "Display table that controls display of the contents of current buffer.\n\
3743 Automatically becomes buffer-local when set in any fashion.\n\
3744 The display table is a char-table created with `make-display-table'.\n\
3745 The ordinary char-table elements control how to display each possible text\n\
3746 character. Each value should be a vector of characters or nil;\n\
3747 nil means display the character in the default fashion.\n\
3748 There are six extra slots to control the display of\n\
3749 the end of a truncated screen line (extra-slot 0, a single character);\n\
3750 the end of a continued line (extra-slot 1, a single character);\n\
3751 the escape character used to display character codes in octal\n\
3752 (extra-slot 2, a single character);\n\
3753 the character used as an arrow for control characters (extra-slot 3,\n\
3754 a single character);\n\
3755 the decoration indicating the presence of invisible lines (extra-slot 4,\n\
3756 a vector of characters);\n\
3757 the character used to draw the border between side-by-side windows\n\
3758 (extra-slot 5, a single character).\n\
3759 See also the functions `display-table-slot' and `set-display-table-slot'.\n\
3760 If this variable is nil, the value of `standard-display-table' is used.\n\
3761 Each window can have its own, overriding display table.");
3763 DEFVAR_PER_BUFFER ("buffer-display-table", ¤t_buffer
->display_table
,
3766 /*DEFVAR_LISP ("debug-check-symbol", &Vcheck_symbol,
3769 DEFVAR_LISP ("before-change-function", &Vbefore_change_function
,
3770 "Function to call before each text change.\n\
3771 Two arguments are passed to the function: the positions of\n\
3772 the beginning and end of the range of old text to be changed.\n\
3773 \(For an insertion, the beginning and end are at the same place.)\n\
3774 No information is given about the length of the text after the change.\n\
3776 Buffer changes made while executing the `before-change-function'\n\
3777 don't call any before-change or after-change functions.\n\
3778 That's because these variables are temporarily set to nil.\n\
3779 As a result, a hook function cannot straightforwardly alter the value of\n\
3780 these variables. See the Emacs Lisp manual for a way of\n\
3781 accomplishing an equivalent result by using other variables.");
3782 Vbefore_change_function
= Qnil
;
3784 DEFVAR_LISP ("after-change-function", &Vafter_change_function
,
3785 "Function to call after each text change.\n\
3786 Three arguments are passed to the function: the positions of\n\
3787 the beginning and end of the range of changed text,\n\
3788 and the length of the pre-change text replaced by that range.\n\
3789 \(For an insertion, the pre-change length is zero;\n\
3790 for a deletion, that length is the number of characters deleted,\n\
3791 and the post-change beginning and end are at the same place.)\n\
3793 Buffer changes made while executing the `after-change-function'\n\
3794 don't call any before-change or after-change functions.\n\
3795 That's because these variables are temporarily set to nil.\n\
3796 As a result, a hook function cannot straightforwardly alter the value of\n\
3797 these variables. See the Emacs Lisp manual for a way of\n\
3798 accomplishing an equivalent result by using other variables.");
3799 Vafter_change_function
= Qnil
;
3801 DEFVAR_LISP ("before-change-functions", &Vbefore_change_functions
,
3802 "List of functions to call before each text change.\n\
3803 Two arguments are passed to each function: the positions of\n\
3804 the beginning and end of the range of old text to be changed.\n\
3805 \(For an insertion, the beginning and end are at the same place.)\n\
3806 No information is given about the length of the text after the change.\n\
3808 Buffer changes made while executing the `before-change-functions'\n\
3809 don't call any before-change or after-change functions.\n\
3810 That's because these variables are temporarily set to nil.\n\
3811 As a result, a hook function cannot straightforwardly alter the value of\n\
3812 these variables. See the Emacs Lisp manual for a way of\n\
3813 accomplishing an equivalent result by using other variables.");
3814 Vbefore_change_functions
= Qnil
;
3816 DEFVAR_LISP ("after-change-functions", &Vafter_change_functions
,
3817 "List of function to call after each text change.\n\
3818 Three arguments are passed to each function: the positions of\n\
3819 the beginning and end of the range of changed text,\n\
3820 and the length of the pre-change text replaced by that range.\n\
3821 \(For an insertion, the pre-change length is zero;\n\
3822 for a deletion, that length is the number of characters deleted,\n\
3823 and the post-change beginning and end are at the same place.)\n\
3825 Buffer changes made while executing the `after-change-functions'\n\
3826 don't call any before-change or after-change functions.\n\
3827 That's because these variables are temporarily set to nil.\n\
3828 As a result, a hook function cannot straightforwardly alter the value of\n\
3829 these variables. See the Emacs Lisp manual for a way of\n\
3830 accomplishing an equivalent result by using other variables.");
3832 Vafter_change_functions
= Qnil
;
3834 DEFVAR_LISP ("first-change-hook", &Vfirst_change_hook
,
3835 "A list of functions to call before changing a buffer which is unmodified.\n\
3836 The functions are run using the `run-hooks' function.");
3837 Vfirst_change_hook
= Qnil
;
3839 #if 0 /* The doc string is too long for some compilers,
3840 but make-docfile can find it in this comment. */
3841 DEFVAR_PER_BUFFER ("buffer-undo-list", ¤t_buffer
->undo_list
, Qnil
,
3842 "List of undo entries in current buffer.\n\
3843 Recent changes come first; older changes follow newer.\n\
3845 An entry (BEG . END) represents an insertion which begins at\n\
3846 position BEG and ends at position END.\n\
3848 An entry (TEXT . POSITION) represents the deletion of the string TEXT\n\
3849 from (abs POSITION). If POSITION is positive, point was at the front\n\
3850 of the text being deleted; if negative, point was at the end.\n\
3852 An entry (t HIGH . LOW) indicates that the buffer previously had\n\
3853 \"unmodified\" status. HIGH and LOW are the high and low 16-bit portions\n\
3854 of the visited file's modification time, as of that time. If the\n\
3855 modification time of the most recent save is different, this entry is\n\
3858 An entry (nil PROPERTY VALUE BEG . END) indicates that a text property\n\
3859 was modified between BEG and END. PROPERTY is the property name,\n\
3860 and VALUE is the old value.\n\
3862 An entry of the form POSITION indicates that point was at the buffer\n\
3863 location given by the integer. Undoing an entry of this form places\n\
3864 point at POSITION.\n\
3866 nil marks undo boundaries. The undo command treats the changes\n\
3867 between two undo boundaries as a single step to be undone.\n\
3869 If the value of the variable is t, undo information is not recorded.");
3871 DEFVAR_PER_BUFFER ("buffer-undo-list", ¤t_buffer
->undo_list
, Qnil
,
3874 DEFVAR_PER_BUFFER ("mark-active", ¤t_buffer
->mark_active
, Qnil
,
3875 "Non-nil means the mark and region are currently active in this buffer.\n\
3876 Automatically local in all buffers.");
3878 DEFVAR_PER_BUFFER ("cache-long-line-scans", ¤t_buffer
->cache_long_line_scans
, Qnil
,
3879 "Non-nil means that Emacs should use caches to handle long lines more quickly.\n\
3880 This variable is buffer-local, in all buffers.\n\
3882 Normally, the line-motion functions work by scanning the buffer for\n\
3883 newlines. Columnar operations (like move-to-column and\n\
3884 compute-motion) also work by scanning the buffer, summing character\n\
3885 widths as they go. This works well for ordinary text, but if the\n\
3886 buffer's lines are very long (say, more than 500 characters), these\n\
3887 motion functions will take longer to execute. Emacs may also take\n\
3888 longer to update the display.\n\
3890 If cache-long-line-scans is non-nil, these motion functions cache the\n\
3891 results of their scans, and consult the cache to avoid rescanning\n\
3892 regions of the buffer until the text is modified. The caches are most\n\
3893 beneficial when they prevent the most searching---that is, when the\n\
3894 buffer contains long lines and large regions of characters with the\n\
3895 same, fixed screen width.\n\
3897 When cache-long-line-scans is non-nil, processing short lines will\n\
3898 become slightly slower (because of the overhead of consulting the\n\
3899 cache), and the caches will use memory roughly proportional to the\n\
3900 number of newlines and characters whose screen width varies.\n\
3902 The caches require no explicit maintenance; their accuracy is\n\
3903 maintained internally by the Emacs primitives. Enabling or disabling\n\
3904 the cache should not affect the behavior of any of the motion\n\
3905 functions; it should only affect their performance.");
3907 DEFVAR_PER_BUFFER ("point-before-scroll", ¤t_buffer
->point_before_scroll
, Qnil
,
3908 "Value of point before the last series of scroll operations, or nil.");
3910 DEFVAR_PER_BUFFER ("buffer-file-format", ¤t_buffer
->file_format
, Qnil
,
3911 "List of formats to use when saving this buffer.\n\
3912 Formats are defined by `format-alist'. This variable is\n\
3913 set when a file is visited. Automatically local in all buffers.");
3915 DEFVAR_PER_BUFFER ("buffer-invisibility-spec",
3916 ¤t_buffer
->invisibility_spec
, Qnil
,
3917 "Invisibility spec of this buffer.\n\
3918 The default is t, which means that text is invisible\n\
3919 if it has a non-nil `invisible' property.\n\
3920 If the value is a list, a text character is invisible if its `invisible'\n\
3921 property is an element in that list.\n\
3922 If an element is a cons cell of the form (PROP . ELLIPSIS),\n\
3923 then characters with property value PROP are invisible,\n\
3924 and they have an ellipsis as well if ELLIPSIS is non-nil.");
3926 DEFVAR_LISP ("transient-mark-mode", &Vtransient_mark_mode
,
3927 "*Non-nil means deactivate the mark when the buffer contents change.");
3928 Vtransient_mark_mode
= Qnil
;
3930 DEFVAR_LISP ("inhibit-read-only", &Vinhibit_read_only
,
3931 "*Non-nil means disregard read-only status of buffers or characters.\n\
3932 If the value is t, disregard `buffer-read-only' and all `read-only'\n\
3933 text properties. If the value is a list, disregard `buffer-read-only'\n\
3934 and disregard a `read-only' text property if the property value\n\
3935 is a member of the list.");
3936 Vinhibit_read_only
= Qnil
;
3938 DEFVAR_LISP ("kill-buffer-query-functions", &Vkill_buffer_query_functions
,
3939 "List of functions called with no args to query before killing a buffer.");
3940 Vkill_buffer_query_functions
= Qnil
;
3942 defsubr (&Sbuffer_list
);
3943 defsubr (&Sget_buffer
);
3944 defsubr (&Sget_file_buffer
);
3945 defsubr (&Sget_buffer_create
);
3946 defsubr (&Smake_indirect_buffer
);
3947 defsubr (&Sgenerate_new_buffer_name
);
3948 defsubr (&Sbuffer_name
);
3949 /*defsubr (&Sbuffer_number);*/
3950 defsubr (&Sbuffer_file_name
);
3951 defsubr (&Sbuffer_base_buffer
);
3952 defsubr (&Sbuffer_local_variables
);
3953 defsubr (&Sbuffer_modified_p
);
3954 defsubr (&Sset_buffer_modified_p
);
3955 defsubr (&Sbuffer_modified_tick
);
3956 defsubr (&Srename_buffer
);
3957 defsubr (&Sother_buffer
);
3958 defsubr (&Sbuffer_disable_undo
);
3959 defsubr (&Sbuffer_enable_undo
);
3960 defsubr (&Skill_buffer
);
3961 defsubr (&Serase_buffer
);
3962 defsubr (&Sset_buffer_major_mode
);
3963 defsubr (&Sswitch_to_buffer
);
3964 defsubr (&Spop_to_buffer
);
3965 defsubr (&Scurrent_buffer
);
3966 defsubr (&Sset_buffer
);
3967 defsubr (&Sbarf_if_buffer_read_only
);
3968 defsubr (&Sbury_buffer
);
3969 defsubr (&Skill_all_local_variables
);
3971 defsubr (&Soverlayp
);
3972 defsubr (&Smake_overlay
);
3973 defsubr (&Sdelete_overlay
);
3974 defsubr (&Smove_overlay
);
3975 defsubr (&Soverlay_start
);
3976 defsubr (&Soverlay_end
);
3977 defsubr (&Soverlay_buffer
);
3978 defsubr (&Soverlay_properties
);
3979 defsubr (&Soverlays_at
);
3980 defsubr (&Soverlays_in
);
3981 defsubr (&Snext_overlay_change
);
3982 defsubr (&Sprevious_overlay_change
);
3983 defsubr (&Soverlay_recenter
);
3984 defsubr (&Soverlay_lists
);
3985 defsubr (&Soverlay_get
);
3986 defsubr (&Soverlay_put
);
3991 initial_define_key (control_x_map
, 'b', "switch-to-buffer");
3992 initial_define_key (control_x_map
, 'k', "kill-buffer");
3994 /* This must not be in syms_of_buffer, because Qdisabled is not
3995 initialized when that function gets called. */
3996 Fput (intern ("erase-buffer"), Qdisabled
, Qt
);