1 /* Buffer manipulation primitives for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994
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, 675 Mass Ave, Cambridge, MA 02139, USA. */
22 #include <sys/types.h>
24 #include <sys/param.h>
27 /* in 4.1, param.h fails to define this. */
28 #define MAXPATHLEN 1024
29 #endif /* not MAXPATHLEN */
33 #include "intervals.h"
37 #include "region-cache.h"
39 #include "blockinput.h"
41 struct buffer
*current_buffer
; /* the current buffer */
43 /* First buffer in chain of all buffers (in reverse order of creation).
44 Threaded through ->next. */
46 struct buffer
*all_buffers
;
48 /* This structure holds the default values of the buffer-local variables
49 defined with DEFVAR_PER_BUFFER, that have special slots in each buffer.
50 The default value occupies the same slot in this structure
51 as an individual buffer's value occupies in that buffer.
52 Setting the default value also goes through the alist of buffers
53 and stores into each buffer that does not say it has a local value. */
55 struct buffer buffer_defaults
;
57 /* A Lisp_Object pointer to the above, used for staticpro */
59 static Lisp_Object Vbuffer_defaults
;
61 /* This structure marks which slots in a buffer have corresponding
62 default values in buffer_defaults.
63 Each such slot has a nonzero value in this structure.
64 The value has only one nonzero bit.
66 When a buffer has its own local value for a slot,
67 the bit for that slot (found in the same slot in this structure)
68 is turned on in the buffer's local_var_flags slot.
70 If a slot in this structure is -1, then even though there may
71 be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
72 and the corresponding slot in buffer_defaults is not used.
74 If a slot is -2, then there is no DEFVAR_PER_BUFFER for it,
75 but there is a default value which is copied into each buffer.
77 If a slot in this structure is negative, then even though there may
78 be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
79 and the corresponding slot in buffer_defaults is not used.
81 If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is
82 zero, that is a bug */
84 struct buffer buffer_local_flags
;
86 /* This structure holds the names of symbols whose values may be
87 buffer-local. It is indexed and accessed in the same way as the above. */
89 struct buffer buffer_local_symbols
;
90 /* A Lisp_Object pointer to the above, used for staticpro */
91 static Lisp_Object Vbuffer_local_symbols
;
93 /* This structure holds the required types for the values in the
94 buffer-local slots. If a slot contains Qnil, then the
95 corresponding buffer slot may contain a value of any type. If a
96 slot contains an integer, then prospective values' tags must be
97 equal to that integer. When a tag does not match, the function
98 buffer_slot_type_mismatch will signal an error. */
99 struct buffer buffer_local_types
;
101 Lisp_Object
Fset_buffer ();
102 void set_buffer_internal ();
103 static void call_overlay_mod_hooks ();
105 /* Alist of all buffer names vs the buffers. */
106 /* This used to be a variable, but is no longer,
107 to prevent lossage due to user rplac'ing this alist or its elements. */
108 Lisp_Object Vbuffer_alist
;
110 /* Functions to call before and after each text change. */
111 Lisp_Object Vbefore_change_function
;
112 Lisp_Object Vafter_change_function
;
113 Lisp_Object Vbefore_change_functions
;
114 Lisp_Object Vafter_change_functions
;
116 Lisp_Object Vtransient_mark_mode
;
118 /* t means ignore all read-only text properties.
119 A list means ignore such a property if its value is a member of the list.
120 Any non-nil value means ignore buffer-read-only. */
121 Lisp_Object Vinhibit_read_only
;
123 /* List of functions to call that can query about killing a buffer.
124 If any of these functions returns nil, we don't kill it. */
125 Lisp_Object Vkill_buffer_query_functions
;
127 /* List of functions to call before changing an unmodified buffer. */
128 Lisp_Object Vfirst_change_hook
;
129 Lisp_Object Qfirst_change_hook
;
131 Lisp_Object Qfundamental_mode
, Qmode_class
, Qpermanent_local
;
133 Lisp_Object Qprotected_field
;
135 Lisp_Object QSFundamental
; /* A string "Fundamental" */
137 Lisp_Object Qkill_buffer_hook
;
139 Lisp_Object Qget_file_buffer
;
141 Lisp_Object Qoverlayp
;
143 Lisp_Object Qpriority
, Qwindow
, Qevaporate
;
145 Lisp_Object Qmodification_hooks
;
146 Lisp_Object Qinsert_in_front_hooks
;
147 Lisp_Object Qinsert_behind_hooks
;
149 /* For debugging; temporary. See set_buffer_internal. */
150 /* Lisp_Object Qlisp_mode, Vcheck_symbol; */
156 error ("No buffer named %s", XSTRING (spec
)->data
);
157 error ("Invalid buffer argument");
160 DEFUN ("buffer-list", Fbuffer_list
, Sbuffer_list
, 0, 0, 0,
161 "Return a list of all existing live buffers.")
164 return Fmapcar (Qcdr
, Vbuffer_alist
);
167 /* Like Fassoc, but use Fstring_equal to compare
168 (which ignores text properties),
169 and don't ever QUIT. */
172 assoc_ignore_text_properties (key
, list
)
173 register Lisp_Object key
;
176 register Lisp_Object tail
;
177 for (tail
= list
; !NILP (tail
); tail
= Fcdr (tail
))
179 register Lisp_Object elt
, tem
;
181 tem
= Fstring_equal (Fcar (elt
), key
);
188 DEFUN ("get-buffer", Fget_buffer
, Sget_buffer
, 1, 1, 0,
189 "Return the buffer named NAME (a string).\n\
190 If there is no live buffer named NAME, return nil.\n\
191 NAME may also be a buffer; if so, the value is that buffer.")
193 register Lisp_Object name
;
197 CHECK_STRING (name
, 0);
199 return Fcdr (assoc_ignore_text_properties (name
, Vbuffer_alist
));
202 DEFUN ("get-file-buffer", Fget_file_buffer
, Sget_file_buffer
, 1, 1, 0,
203 "Return the buffer visiting file FILENAME (a string).\n\
204 The buffer's `buffer-file-name' must match exactly the expansion of FILENAME.\n\
205 If there is no such live buffer, return nil.\n\
206 See also `find-buffer-visiting'.")
208 register Lisp_Object filename
;
210 register Lisp_Object tail
, buf
, tem
;
213 CHECK_STRING (filename
, 0);
214 filename
= Fexpand_file_name (filename
, Qnil
);
216 /* If the file name has special constructs in it,
217 call the corresponding file handler. */
218 handler
= Ffind_file_name_handler (filename
, Qget_file_buffer
);
220 return call2 (handler
, Qget_file_buffer
, filename
);
222 for (tail
= Vbuffer_alist
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
224 buf
= Fcdr (XCONS (tail
)->car
);
225 if (!BUFFERP (buf
)) continue;
226 if (!STRINGP (XBUFFER (buf
)->filename
)) continue;
227 tem
= Fstring_equal (XBUFFER (buf
)->filename
, filename
);
234 /* Incremented for each buffer created, to assign the buffer number. */
237 DEFUN ("get-buffer-create", Fget_buffer_create
, Sget_buffer_create
, 1, 1, 0,
238 "Return the buffer named NAME, or create such a buffer and return it.\n\
239 A new buffer is created if there is no live buffer named NAME.\n\
240 If NAME starts with a space, the new buffer does not keep undo information.\n\
241 If NAME is a buffer instead of a string, then it is the value returned.\n\
242 The value is never nil.")
244 register Lisp_Object name
;
246 register Lisp_Object buf
;
247 register struct buffer
*b
;
249 buf
= Fget_buffer (name
);
253 if (XSTRING (name
)->size
== 0)
254 error ("Empty string for buffer name is not allowed");
256 b
= (struct buffer
*) xmalloc (sizeof (struct buffer
));
258 b
->size
= sizeof (struct buffer
) / sizeof (EMACS_INT
);
260 /* An ordinary buffer uses its own struct buffer_text. */
261 b
->text
= &b
->own_text
;
264 BUF_GAP_SIZE (b
) = 20;
266 BUFFER_ALLOC (BUF_BEG_ADDR (b
), BUF_GAP_SIZE (b
));
268 if (! BUF_BEG_ADDR (b
))
277 BUF_SAVE_MODIFF (b
) = 1;
278 BUF_INTERVALS (b
) = 0;
280 b
->newline_cache
= 0;
281 b
->width_run_cache
= 0;
282 b
->width_table
= Qnil
;
284 /* Put this on the chain of all buffers including killed ones. */
285 b
->next
= all_buffers
;
288 /* An ordinary buffer normally doesn't need markers
289 to handle BEGV and ZV. */
291 b
->begv_marker
= Qnil
;
294 name
= Fcopy_sequence (name
);
295 INITIALIZE_INTERVAL (XSTRING (name
), NULL_INTERVAL
);
298 if (XSTRING (name
)->data
[0] != ' ')
304 reset_buffer_local_variables (b
);
306 /* Put this in the alist of all live buffers. */
308 Vbuffer_alist
= nconc2 (Vbuffer_alist
, Fcons (Fcons (name
, buf
), Qnil
));
310 b
->mark
= Fmake_marker ();
311 BUF_MARKERS (b
) = Qnil
;
316 DEFUN ("make-indirect-buffer",
317 Fmake_indirect_buffer
, Smake_indirect_buffer
, 2, 2,
318 "BMake indirect buffer: \nbIndirect to base buffer: ",
319 "Create and return an indirect buffer named NAME, with base buffer BASE.\n\
320 BASE should be an existing buffer (or buffer name).")
322 register Lisp_Object name
, base_buffer
;
324 register Lisp_Object buf
;
325 register struct buffer
*b
;
327 buf
= Fget_buffer (name
);
329 error ("Buffer name `%s' is in use", XSTRING (name
)->data
);
331 base_buffer
= Fget_buffer (base_buffer
);
332 if (NILP (base_buffer
))
333 error ("No such buffer: `%s'",
334 XSTRING (XBUFFER (base_buffer
)->name
)->data
);
336 if (XSTRING (name
)->size
== 0)
337 error ("Empty string for buffer name is not allowed");
339 b
= (struct buffer
*) xmalloc (sizeof (struct buffer
));
341 b
->size
= sizeof (struct buffer
) / sizeof (EMACS_INT
);
343 if (XBUFFER (base_buffer
)->base_buffer
)
344 b
->base_buffer
= XBUFFER (base_buffer
)->base_buffer
;
346 b
->base_buffer
= XBUFFER (base_buffer
);
348 /* Use the base buffer's text object. */
349 b
->text
= b
->base_buffer
->text
;
351 BUF_BEGV (b
) = BUF_BEGV (b
->base_buffer
);
352 BUF_ZV (b
) = BUF_ZV (b
->base_buffer
);
353 BUF_PT (b
) = BUF_PT (b
->base_buffer
);
355 b
->newline_cache
= 0;
356 b
->width_run_cache
= 0;
357 b
->width_table
= Qnil
;
359 /* Put this on the chain of all buffers including killed ones. */
360 b
->next
= all_buffers
;
363 name
= Fcopy_sequence (name
);
364 INITIALIZE_INTERVAL (XSTRING (name
), NULL_INTERVAL
);
368 reset_buffer_local_variables (b
);
370 /* Put this in the alist of all live buffers. */
372 Vbuffer_alist
= nconc2 (Vbuffer_alist
, Fcons (Fcons (name
, buf
), Qnil
));
374 b
->mark
= Fmake_marker ();
377 /* Make sure the base buffer has markers for its narrowing. */
378 if (NILP (b
->base_buffer
->pt_marker
))
380 b
->base_buffer
->pt_marker
= Fmake_marker ();
381 Fset_marker (b
->base_buffer
->pt_marker
,
382 make_number (BUF_PT (b
->base_buffer
)), base_buffer
);
384 if (NILP (b
->base_buffer
->begv_marker
))
386 b
->base_buffer
->begv_marker
= Fmake_marker ();
387 Fset_marker (b
->base_buffer
->begv_marker
,
388 make_number (BUF_BEGV (b
->base_buffer
)), base_buffer
);
390 if (NILP (b
->base_buffer
->zv_marker
))
392 b
->base_buffer
->zv_marker
= Fmake_marker ();
393 Fset_marker (b
->base_buffer
->zv_marker
,
394 make_number (BUF_ZV (b
->base_buffer
)), base_buffer
);
397 /* Give the indirect buffer markers for its narrowing. */
398 b
->pt_marker
= Fpoint_marker ();
399 b
->begv_marker
= Fpoint_min_marker ();
400 b
->zv_marker
= Fpoint_max_marker ();
405 /* Reinitialize everything about a buffer except its name and contents
406 and local variables. */
410 register struct buffer
*b
;
413 b
->directory
= (current_buffer
) ? current_buffer
->directory
: Qnil
;
415 XSETFASTINT (b
->save_length
, 0);
416 b
->last_window_start
= 1;
418 b
->auto_save_modified
= 0;
419 b
->auto_save_failure_time
= -1;
420 b
->auto_save_file_name
= Qnil
;
422 b
->overlays_before
= Qnil
;
423 b
->overlays_after
= Qnil
;
424 XSETFASTINT (b
->overlay_center
, 1);
425 b
->mark_active
= Qnil
;
428 /* Reset buffer B's local variables info.
429 Don't use this on a buffer that has already been in use;
430 it does not treat permanent locals consistently.
431 Instead, use Fkill_all_local_variables. */
433 reset_buffer_local_variables (b
)
434 register struct buffer
*b
;
438 /* Reset the major mode to Fundamental, together with all the
439 things that depend on the major mode.
440 default-major-mode is handled at a higher level.
441 We ignore it here. */
442 b
->major_mode
= Qfundamental_mode
;
444 b
->abbrev_table
= Vfundamental_mode_abbrev_table
;
445 b
->mode_name
= QSFundamental
;
446 b
->minor_modes
= Qnil
;
447 b
->downcase_table
= Vascii_downcase_table
;
448 b
->upcase_table
= Vascii_upcase_table
;
449 b
->case_canon_table
= Vascii_canon_table
;
450 b
->case_eqv_table
= Vascii_eqv_table
;
451 b
->buffer_file_type
= Qnil
;
453 b
->sort_table
= XSTRING (Vascii_sort_table
);
454 b
->folding_sort_table
= XSTRING (Vascii_folding_sort_table
);
457 /* Reset all per-buffer variables to their defaults. */
458 b
->local_var_alist
= Qnil
;
459 b
->local_var_flags
= 0;
461 /* For each slot that has a default value,
462 copy that into the slot. */
464 for (offset
= (char *)&buffer_local_flags
.name
- (char *)&buffer_local_flags
;
465 offset
< sizeof (struct buffer
);
466 offset
+= sizeof (Lisp_Object
)) /* sizeof EMACS_INT == sizeof Lisp_Object */
468 int flag
= XINT (*(Lisp_Object
*)(offset
+ (char *)&buffer_local_flags
));
469 if (flag
> 0 || flag
== -2)
470 *(Lisp_Object
*)(offset
+ (char *)b
) =
471 *(Lisp_Object
*)(offset
+ (char *)&buffer_defaults
);
475 /* We split this away from generate-new-buffer, because rename-buffer
476 and set-visited-file-name ought to be able to use this to really
477 rename the buffer properly. */
479 DEFUN ("generate-new-buffer-name", Fgenerate_new_buffer_name
, Sgenerate_new_buffer_name
,
481 "Return a string that is the name of no existing buffer based on NAME.\n\
482 If there is no live buffer named NAME, then return NAME.\n\
483 Otherwise modify name by appending `<NUMBER>', incrementing NUMBER\n\
484 until an unused name is found, and then return that name.\n\
485 Optional second argument IGNORE specifies a name that is okay to use\n\
486 \(if it is in the sequence to be tried)\n\
487 even if a buffer with that name exists.")
489 register Lisp_Object name
, ignore
;
491 register Lisp_Object gentemp
, tem
;
495 CHECK_STRING (name
, 0);
497 tem
= Fget_buffer (name
);
504 sprintf (number
, "<%d>", ++count
);
505 gentemp
= concat2 (name
, build_string (number
));
506 tem
= Fstring_equal (gentemp
, ignore
);
509 tem
= Fget_buffer (gentemp
);
516 DEFUN ("buffer-name", Fbuffer_name
, Sbuffer_name
, 0, 1, 0,
517 "Return the name of BUFFER, as a string.\n\
518 With no argument or nil as argument, return the name of the current buffer.")
520 register Lisp_Object buffer
;
523 return current_buffer
->name
;
524 CHECK_BUFFER (buffer
, 0);
525 return XBUFFER (buffer
)->name
;
528 DEFUN ("buffer-file-name", Fbuffer_file_name
, Sbuffer_file_name
, 0, 1, 0,
529 "Return name of file BUFFER is visiting, or nil if none.\n\
530 No argument or nil as argument means use the current buffer.")
532 register Lisp_Object buffer
;
535 return current_buffer
->filename
;
536 CHECK_BUFFER (buffer
, 0);
537 return XBUFFER (buffer
)->filename
;
540 DEFUN ("buffer-base-buffer", Fbuffer_base_buffer
, Sbuffer_base_buffer
,
542 "Return the base buffer of indirect buffer BUFFER.\n\
543 If BUFFER is not indirect, return nil.")
545 register Lisp_Object buffer
;
548 Lisp_Object base_buffer
;
551 base
= current_buffer
->base_buffer
;
554 CHECK_BUFFER (buffer
, 0);
555 base
= XBUFFER (buffer
)->base_buffer
;
560 XSETBUFFER (base_buffer
, base
);
564 DEFUN ("buffer-local-variables", Fbuffer_local_variables
,
565 Sbuffer_local_variables
, 0, 1, 0,
566 "Return an alist of variables that are buffer-local in BUFFER.\n\
567 Most elements look like (SYMBOL . VALUE), describing one variable.\n\
568 For a symbol that is locally unbound, just the symbol appears in the value.\n\
569 Note that storing new VALUEs in these elements doesn't change the variables.\n\
570 No argument or nil as argument means use current buffer as BUFFER.")
572 register Lisp_Object buffer
;
574 register struct buffer
*buf
;
575 register Lisp_Object result
;
578 buf
= current_buffer
;
581 CHECK_BUFFER (buffer
, 0);
582 buf
= XBUFFER (buffer
);
588 /* Reference each variable in the alist in our current buffer.
589 If inquiring about the current buffer, this gets the current values,
590 so store them into the alist so the alist is up to date.
591 If inquiring about some other buffer, this swaps out any values
592 for that buffer, making the alist up to date automatically. */
593 register Lisp_Object tail
;
594 for (tail
= buf
->local_var_alist
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
596 Lisp_Object val
, elt
;
598 elt
= XCONS (tail
)->car
;
600 if (buf
== current_buffer
)
601 val
= find_symbol_value (XCONS (elt
)->car
);
603 val
= XCONS (elt
)->cdr
;
605 /* If symbol is unbound, put just the symbol in the list. */
606 if (EQ (val
, Qunbound
))
607 result
= Fcons (XCONS (elt
)->car
, result
);
608 /* Otherwise, put (symbol . value) in the list. */
610 result
= Fcons (Fcons (XCONS (elt
)->car
, val
), result
);
614 /* Add on all the variables stored in special slots. */
616 register int offset
, mask
;
618 for (offset
= (char *)&buffer_local_symbols
.name
- (char *)&buffer_local_symbols
;
619 offset
< sizeof (struct buffer
);
620 offset
+= (sizeof (EMACS_INT
))) /* sizeof EMACS_INT == sizeof Lisp_Object */
622 mask
= XINT (*(Lisp_Object
*)(offset
+ (char *)&buffer_local_flags
));
623 if (mask
== -1 || (buf
->local_var_flags
& mask
))
624 if (SYMBOLP (*(Lisp_Object
*)(offset
625 + (char *)&buffer_local_symbols
)))
626 result
= Fcons (Fcons (*((Lisp_Object
*)
627 (offset
+ (char *)&buffer_local_symbols
)),
628 *(Lisp_Object
*)(offset
+ (char *)buf
)),
637 DEFUN ("buffer-modified-p", Fbuffer_modified_p
, Sbuffer_modified_p
,
639 "Return t if BUFFER was modified since its file was last read or saved.\n\
640 No argument or nil as argument means use current buffer as BUFFER.")
642 register Lisp_Object buffer
;
644 register struct buffer
*buf
;
646 buf
= current_buffer
;
649 CHECK_BUFFER (buffer
, 0);
650 buf
= XBUFFER (buffer
);
653 return BUF_SAVE_MODIFF (buf
) < BUF_MODIFF (buf
) ? Qt
: Qnil
;
656 DEFUN ("set-buffer-modified-p", Fset_buffer_modified_p
, Sset_buffer_modified_p
,
658 "Mark current buffer as modified or unmodified according to FLAG.\n\
659 A non-nil FLAG means mark the buffer modified.")
661 register Lisp_Object flag
;
663 register int already
;
664 register Lisp_Object fn
;
666 #ifdef CLASH_DETECTION
667 /* If buffer becoming modified, lock the file.
668 If buffer becoming unmodified, unlock the file. */
670 fn
= current_buffer
->filename
;
673 already
= SAVE_MODIFF
< MODIFF
;
674 if (!already
&& !NILP (flag
))
676 else if (already
&& NILP (flag
))
679 #endif /* CLASH_DETECTION */
681 SAVE_MODIFF
= NILP (flag
) ? MODIFF
: 0;
686 DEFUN ("buffer-modified-tick", Fbuffer_modified_tick
, Sbuffer_modified_tick
,
688 "Return BUFFER's tick counter, incremented for each change in text.\n\
689 Each buffer has a tick counter which is incremented each time the text in\n\
690 that buffer is changed. It wraps around occasionally.\n\
691 No argument or nil as argument means use current buffer as BUFFER.")
693 register Lisp_Object buffer
;
695 register struct buffer
*buf
;
697 buf
= current_buffer
;
700 CHECK_BUFFER (buffer
, 0);
701 buf
= XBUFFER (buffer
);
704 return make_number (BUF_MODIFF (buf
));
707 DEFUN ("rename-buffer", Frename_buffer
, Srename_buffer
, 1, 2,
708 "sRename buffer (to new name): \nP",
709 "Change current buffer's name to NEWNAME (a string).\n\
710 If second arg UNIQUE is nil or omitted, it is an error if a\n\
711 buffer named NEWNAME already exists.\n\
712 If UNIQUE is non-nil, come up with a new name using\n\
713 `generate-new-buffer-name'.\n\
714 Interactively, you can set UNIQUE with a prefix argument.\n\
715 We return the name we actually gave the buffer.\n\
716 This does not change the name of the visited file (if any).")
718 register Lisp_Object newname
, unique
;
720 register Lisp_Object tem
, buf
;
722 CHECK_STRING (newname
, 0);
724 if (XSTRING (newname
)->size
== 0)
725 error ("Empty string is invalid as a buffer name");
727 tem
= Fget_buffer (newname
);
728 /* Don't short-circuit if UNIQUE is t. That is a useful way to rename
729 the buffer automatically so you can create another with the original name.
730 It makes UNIQUE equivalent to
731 (rename-buffer (generate-new-buffer-name NEWNAME)). */
732 if (NILP (unique
) && XBUFFER (tem
) == current_buffer
)
733 return current_buffer
->name
;
737 newname
= Fgenerate_new_buffer_name (newname
, current_buffer
->name
);
739 error ("Buffer name `%s' is in use", XSTRING (newname
)->data
);
742 current_buffer
->name
= newname
;
744 /* Catch redisplay's attention. Unless we do this, the mode lines for
745 any windows displaying current_buffer will stay unchanged. */
748 XSETBUFFER (buf
, current_buffer
);
749 Fsetcar (Frassq (buf
, Vbuffer_alist
), newname
);
750 if (NILP (current_buffer
->filename
)
751 && !NILP (current_buffer
->auto_save_file_name
))
752 call0 (intern ("rename-auto-save-file"));
753 /* Refetch since that last call may have done GC. */
754 return current_buffer
->name
;
757 DEFUN ("other-buffer", Fother_buffer
, Sother_buffer
, 0, 2, 0,
758 "Return most recently selected buffer other than BUFFER.\n\
759 Buffers not visible in windows are preferred to visible buffers,\n\
760 unless optional second argument VISIBLE-OK is non-nil.\n\
761 If no other buffer exists, the buffer `*scratch*' is returned.\n\
762 If BUFFER is omitted or nil, some interesting buffer is returned.")
764 register Lisp_Object buffer
, visible_ok
;
766 register Lisp_Object tail
, buf
, notsogood
, tem
;
769 for (tail
= Vbuffer_alist
; !NILP (tail
); tail
= Fcdr (tail
))
771 buf
= Fcdr (Fcar (tail
));
772 if (EQ (buf
, buffer
))
774 if (XSTRING (XBUFFER (buf
)->name
)->data
[0] == ' ')
777 /* If the selected frame has a buffer_predicate,
778 disregard buffers that don't fit the predicate. */
779 tem
= frame_buffer_predicate ();
782 tem
= call1 (tem
, buf
);
788 if (NILP (visible_ok
))
789 tem
= Fget_buffer_window (buf
, Qt
);
794 if (NILP (notsogood
))
797 if (!NILP (notsogood
))
799 return Fget_buffer_create (build_string ("*scratch*"));
802 DEFUN ("buffer-disable-undo", Fbuffer_disable_undo
, Sbuffer_disable_undo
, 0, 1,
804 "Make BUFFER stop keeping undo information.\n\
805 No argument or nil as argument means do this for the current buffer.")
807 register Lisp_Object buffer
;
809 Lisp_Object real_buffer
;
812 XSETBUFFER (real_buffer
, current_buffer
);
815 real_buffer
= Fget_buffer (buffer
);
816 if (NILP (real_buffer
))
820 XBUFFER (real_buffer
)->undo_list
= Qt
;
825 DEFUN ("buffer-enable-undo", Fbuffer_enable_undo
, Sbuffer_enable_undo
,
827 "Start keeping undo information for buffer BUFFER.\n\
828 No argument or nil as argument means do this for the current buffer.")
830 register Lisp_Object buffer
;
832 Lisp_Object real_buffer
;
835 XSETBUFFER (real_buffer
, current_buffer
);
838 real_buffer
= Fget_buffer (buffer
);
839 if (NILP (real_buffer
))
843 if (EQ (XBUFFER (real_buffer
)->undo_list
, Qt
))
844 XBUFFER (real_buffer
)->undo_list
= Qnil
;
850 DEFVAR_LISP ("kill-buffer-hook", no_cell, "\
851 Hook to be run (by `run-hooks', which see) when a buffer is killed.\n\
852 The buffer being killed will be current while the hook is running.\n\
855 DEFUN ("kill-buffer", Fkill_buffer
, Skill_buffer
, 1, 1, "bKill buffer: ",
856 "Kill the buffer BUFFER.\n\
857 The argument may be a buffer or may be the name of a buffer.\n\
858 An argument of nil means kill the current buffer.\n\n\
859 Value is t if the buffer is actually killed, nil if user says no.\n\n\
860 The value of `kill-buffer-hook' (which may be local to that buffer),\n\
861 if not void, is a list of functions to be called, with no arguments,\n\
862 before the buffer is actually killed. The buffer to be killed is current\n\
863 when the hook functions are called.\n\n\
864 Any processes that have this buffer as the `process-buffer' are killed\n\
865 with `delete-process'.")
870 register struct buffer
*b
;
871 register Lisp_Object tem
;
872 register struct Lisp_Marker
*m
;
873 struct gcpro gcpro1
, gcpro2
;
876 buf
= Fcurrent_buffer ();
878 buf
= Fget_buffer (bufname
);
884 /* Query if the buffer is still modified. */
885 if (INTERACTIVE
&& !NILP (b
->filename
)
886 && BUF_MODIFF (b
) > BUF_SAVE_MODIFF (b
))
888 GCPRO2 (buf
, bufname
);
889 tem
= do_yes_or_no_p (format1 ("Buffer %s modified; kill anyway? ",
890 XSTRING (b
->name
)->data
));
896 /* Run hooks with the buffer to be killed the current buffer. */
898 register Lisp_Object val
;
899 int count
= specpdl_ptr
- specpdl
;
902 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
903 set_buffer_internal (b
);
905 /* First run the query functions; if any query is answered no,
906 don't kill the buffer. */
907 for (list
= Vkill_buffer_query_functions
; !NILP (list
); list
= Fcdr (list
))
909 tem
= call0 (Fcar (list
));
911 return unbind_to (count
, Qnil
);
914 /* Then run the hooks. */
915 if (!NILP (Vrun_hooks
))
916 call1 (Vrun_hooks
, Qkill_buffer_hook
);
917 unbind_to (count
, Qnil
);
920 /* We have no more questions to ask. Verify that it is valid
921 to kill the buffer. This must be done after the questions
922 since anything can happen within do_yes_or_no_p. */
924 /* Don't kill the minibuffer now current. */
925 if (EQ (buf
, XWINDOW (minibuf_window
)->buffer
))
931 /* When we kill a base buffer, kill all its indirect buffers.
932 We do it at this stage so nothing terrible happens if they
933 ask questions or their hooks get errors. */
934 if (! b
->base_buffer
)
936 struct buffer
*other
;
940 for (other
= all_buffers
; other
; other
= other
->next
)
941 if (other
->base_buffer
== b
)
944 XSETBUFFER (buf
, other
);
951 /* Make this buffer not be current.
952 In the process, notice if this is the sole visible buffer
953 and give up if so. */
954 if (b
== current_buffer
)
956 tem
= Fother_buffer (buf
, Qnil
);
958 if (b
== current_buffer
)
962 /* Now there is no question: we can kill the buffer. */
964 #ifdef CLASH_DETECTION
965 /* Unlock this buffer's file, if it is locked. */
967 #endif /* CLASH_DETECTION */
969 kill_buffer_processes (buf
);
973 Vbuffer_alist
= Fdelq (Frassq (buf
, Vbuffer_alist
), Vbuffer_alist
);
974 Freplace_buffer_in_windows (buf
);
977 /* Delete any auto-save file, if we saved it in this session. */
978 if (STRINGP (b
->auto_save_file_name
)
979 && b
->auto_save_modified
!= 0)
982 tem
= Fsymbol_value (intern ("delete-auto-save-files"));
984 internal_delete_file (b
->auto_save_file_name
);
987 if (! b
->base_buffer
)
989 /* Unchain all markers of this buffer
990 and leave them pointing nowhere. */
991 for (tem
= BUF_MARKERS (b
); !EQ (tem
, Qnil
); )
998 BUF_MARKERS (b
) = Qnil
;
1000 #ifdef USE_TEXT_PROPERTIES
1001 BUF_INTERVALS (b
) = NULL_INTERVAL
;
1004 /* Perhaps we should explicitly free the interval tree here... */
1010 if (! b
->base_buffer
)
1011 BUFFER_FREE (BUF_BEG_ADDR (b
));
1013 if (b
->newline_cache
)
1015 free_region_cache (b
->newline_cache
);
1016 b
->newline_cache
= 0;
1018 if (b
->width_run_cache
)
1020 free_region_cache (b
->width_run_cache
);
1021 b
->width_run_cache
= 0;
1023 b
->width_table
= Qnil
;
1025 b
->undo_list
= Qnil
;
1030 /* Move the assoc for buffer BUF to the front of buffer-alist. Since
1031 we do this each time BUF is selected visibly, the more recently
1032 selected buffers are always closer to the front of the list. This
1033 means that other_buffer is more likely to choose a relevant buffer. */
1038 register Lisp_Object link
, prev
;
1041 for (link
= Vbuffer_alist
; CONSP (link
); link
= XCONS (link
)->cdr
)
1043 if (EQ (XCONS (XCONS (link
)->car
)->cdr
, buf
))
1048 /* Effectively do Vbuffer_alist = Fdelq (link, Vbuffer_alist);
1049 we cannot use Fdelq itself here because it allows quitting. */
1052 Vbuffer_alist
= XCONS (Vbuffer_alist
)->cdr
;
1054 XCONS (prev
)->cdr
= XCONS (XCONS (prev
)->cdr
)->cdr
;
1056 XCONS(link
)->cdr
= Vbuffer_alist
;
1057 Vbuffer_alist
= link
;
1060 DEFUN ("set-buffer-major-mode", Fset_buffer_major_mode
, Sset_buffer_major_mode
, 1, 1, 0,
1061 "Set an appropriate major mode for BUFFER, according to `default-major-mode'.\n\
1062 Use this function before selecting the buffer, since it may need to inspect\n\
1063 the current buffer's major mode.")
1068 Lisp_Object function
;
1070 function
= buffer_defaults
.major_mode
;
1071 if (NILP (function
) && NILP (Fget (current_buffer
->major_mode
, Qmode_class
)))
1072 function
= current_buffer
->major_mode
;
1074 if (NILP (function
) || EQ (function
, Qfundamental_mode
))
1077 count
= specpdl_ptr
- specpdl
;
1079 /* To select a nonfundamental mode,
1080 select the buffer temporarily and then call the mode function. */
1082 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1087 return unbind_to (count
, Qnil
);
1090 DEFUN ("switch-to-buffer", Fswitch_to_buffer
, Sswitch_to_buffer
, 1, 2, "BSwitch to buffer: ",
1091 "Select buffer BUFFER in the current window.\n\
1092 BUFFER may be a buffer or a buffer name.\n\
1093 Optional second arg NORECORD non-nil means\n\
1094 do not put this buffer at the front of the list of recently selected ones.\n\
1096 WARNING: This is NOT the way to work on another buffer temporarily\n\
1097 within a Lisp program! Use `set-buffer' instead. That avoids messing with\n\
1098 the window-buffer correspondences.")
1100 Lisp_Object bufname
, norecord
;
1102 register Lisp_Object buf
;
1105 if (EQ (minibuf_window
, selected_window
))
1106 error ("Cannot switch buffers in minibuffer window");
1107 tem
= Fwindow_dedicated_p (selected_window
);
1109 error ("Cannot switch buffers in a dedicated window");
1112 buf
= Fother_buffer (Fcurrent_buffer (), Qnil
);
1115 buf
= Fget_buffer (bufname
);
1118 buf
= Fget_buffer_create (bufname
);
1119 Fset_buffer_major_mode (buf
);
1123 if (NILP (norecord
))
1124 record_buffer (buf
);
1126 Fset_window_buffer (EQ (selected_window
, minibuf_window
)
1127 ? Fnext_window (minibuf_window
, Qnil
, Qnil
)
1134 DEFUN ("pop-to-buffer", Fpop_to_buffer
, Spop_to_buffer
, 1, 2, 0,
1135 "Select buffer BUFFER in some window, preferably a different one.\n\
1136 If BUFFER is nil, then some other buffer is chosen.\n\
1137 If `pop-up-windows' is non-nil, windows can be split to do this.\n\
1138 If optional second arg OTHER-WINDOW is non-nil, insist on finding another\n\
1139 window even if BUFFER is already visible in the selected window.")
1141 Lisp_Object bufname
, other
;
1143 register Lisp_Object buf
;
1145 buf
= Fother_buffer (Fcurrent_buffer (), Qnil
);
1147 buf
= Fget_buffer_create (bufname
);
1149 record_buffer (buf
);
1150 Fselect_window (Fdisplay_buffer (buf
, other
));
1154 DEFUN ("current-buffer", Fcurrent_buffer
, Scurrent_buffer
, 0, 0, 0,
1155 "Return the current buffer as a Lisp object.")
1158 register Lisp_Object buf
;
1159 XSETBUFFER (buf
, current_buffer
);
1163 /* Set the current buffer to b */
1166 set_buffer_internal (b
)
1167 register struct buffer
*b
;
1169 register struct buffer
*old_buf
;
1170 register Lisp_Object tail
, valcontents
;
1173 if (current_buffer
== b
)
1176 windows_or_buffers_changed
= 1;
1177 old_buf
= current_buffer
;
1179 last_known_column_point
= -1; /* invalidate indentation cache */
1183 /* Put the undo list back in the base buffer, so that it appears
1184 that an indirect buffer shares the undo list of its base. */
1185 if (old_buf
->base_buffer
)
1186 old_buf
->base_buffer
->undo_list
= old_buf
->undo_list
;
1188 /* If the old current buffer has markers to record PT, BEGV and ZV
1189 when it is not current, update them now. */
1190 if (! NILP (old_buf
->pt_marker
))
1193 XSETBUFFER (obuf
, old_buf
);
1194 Fset_marker (old_buf
->pt_marker
, BUF_PT (old_buf
), obuf
);
1196 if (! NILP (old_buf
->begv_marker
))
1199 XSETBUFFER (obuf
, old_buf
);
1200 Fset_marker (old_buf
->begv_marker
, BUF_BEGV (old_buf
), obuf
);
1202 if (! NILP (old_buf
->zv_marker
))
1205 XSETBUFFER (obuf
, old_buf
);
1206 Fset_marker (old_buf
->zv_marker
, BUF_ZV (old_buf
), obuf
);
1210 /* Get the undo list from the base buffer, so that it appears
1211 that an indirect buffer shares the undo list of its base. */
1213 b
->undo_list
= b
->base_buffer
->undo_list
;
1215 /* If the new current buffer has markers to record PT, BEGV and ZV
1216 when it is not current, fetch them now. */
1217 if (! NILP (b
->pt_marker
))
1218 BUF_PT (b
) = marker_position (b
->pt_marker
);
1219 if (! NILP (b
->begv_marker
))
1220 BUF_BEGV (b
) = marker_position (b
->begv_marker
);
1221 if (! NILP (b
->zv_marker
))
1222 BUF_ZV (b
) = marker_position (b
->zv_marker
);
1224 /* Look down buffer's list of local Lisp variables
1225 to find and update any that forward into C variables. */
1227 for (tail
= b
->local_var_alist
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1229 valcontents
= XSYMBOL (XCONS (XCONS (tail
)->car
)->car
)->value
;
1230 if ((BUFFER_LOCAL_VALUEP (valcontents
)
1231 || SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1232 && (tem
= XBUFFER_LOCAL_VALUE (valcontents
)->car
,
1233 (BOOLFWDP (tem
) || INTFWDP (tem
) || OBJFWDP (tem
))))
1234 /* Just reference the variable
1235 to cause it to become set for this buffer. */
1236 Fsymbol_value (XCONS (XCONS (tail
)->car
)->car
);
1239 /* Do the same with any others that were local to the previous buffer */
1242 for (tail
= old_buf
->local_var_alist
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1244 valcontents
= XSYMBOL (XCONS (XCONS (tail
)->car
)->car
)->value
;
1245 if ((BUFFER_LOCAL_VALUEP (valcontents
)
1246 || SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1247 && (tem
= XBUFFER_LOCAL_VALUE (valcontents
)->car
,
1248 (BOOLFWDP (tem
) || INTFWDP (tem
) || OBJFWDP (tem
))))
1249 /* Just reference the variable
1250 to cause it to become set for this buffer. */
1251 Fsymbol_value (XCONS (XCONS (tail
)->car
)->car
);
1255 /* Switch to buffer B temporarily for redisplay purposes.
1256 This avoids certain things thatdon't need to be done within redisplay. */
1262 register struct buffer
*old_buf
;
1264 if (current_buffer
== b
)
1267 old_buf
= current_buffer
;
1272 /* If the old current buffer has markers to record PT, BEGV and ZV
1273 when it is not current, update them now. */
1274 if (! NILP (old_buf
->pt_marker
))
1277 XSETBUFFER (obuf
, old_buf
);
1278 Fset_marker (old_buf
->pt_marker
, BUF_PT (old_buf
), obuf
);
1280 if (! NILP (old_buf
->begv_marker
))
1283 XSETBUFFER (obuf
, old_buf
);
1284 Fset_marker (old_buf
->begv_marker
, BUF_BEGV (old_buf
), obuf
);
1286 if (! NILP (old_buf
->zv_marker
))
1289 XSETBUFFER (obuf
, old_buf
);
1290 Fset_marker (old_buf
->zv_marker
, BUF_ZV (old_buf
), obuf
);
1294 /* If the new current buffer has markers to record PT, BEGV and ZV
1295 when it is not current, fetch them now. */
1296 if (! NILP (b
->pt_marker
))
1297 BUF_PT (b
) = marker_position (b
->pt_marker
);
1298 if (! NILP (b
->begv_marker
))
1299 BUF_BEGV (b
) = marker_position (b
->begv_marker
);
1300 if (! NILP (b
->zv_marker
))
1301 BUF_ZV (b
) = marker_position (b
->zv_marker
);
1304 DEFUN ("set-buffer", Fset_buffer
, Sset_buffer
, 1, 1, 0,
1305 "Make the buffer BUFFER current for editing operations.\n\
1306 BUFFER may be a buffer or the name of an existing buffer.\n\
1307 See also `save-excursion' when you want to make a buffer current temporarily.\n\
1308 This function does not display the buffer, so its effect ends\n\
1309 when the current command terminates.\n\
1310 Use `switch-to-buffer' or `pop-to-buffer' to switch buffers permanently.")
1312 register Lisp_Object bufname
;
1314 register Lisp_Object buffer
;
1315 buffer
= Fget_buffer (bufname
);
1318 if (NILP (XBUFFER (buffer
)->name
))
1319 error ("Selecting deleted buffer");
1320 set_buffer_internal (XBUFFER (buffer
));
1324 DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only
,
1325 Sbarf_if_buffer_read_only
, 0, 0, 0,
1326 "Signal a `buffer-read-only' error if the current buffer is read-only.")
1329 if (!NILP (current_buffer
->read_only
)
1330 && NILP (Vinhibit_read_only
))
1331 Fsignal (Qbuffer_read_only
, (Fcons (Fcurrent_buffer (), Qnil
)));
1335 DEFUN ("bury-buffer", Fbury_buffer
, Sbury_buffer
, 0, 1, "",
1336 "Put BUFFER at the end of the list of all buffers.\n\
1337 There it is the least likely candidate for `other-buffer' to return;\n\
1338 thus, the least likely buffer for \\[switch-to-buffer] to select by default.\n\
1339 If BUFFER is nil or omitted, bury the current buffer.\n\
1340 Also, if BUFFER is nil or omitted, remove the current buffer from the\n\
1341 selected window if it is displayed there.")
1343 register Lisp_Object buf
;
1345 /* Figure out what buffer we're going to bury. */
1348 XSETBUFFER (buf
, current_buffer
);
1350 /* If we're burying the current buffer, unshow it. */
1351 Fswitch_to_buffer (Fother_buffer (buf
, Qnil
), Qnil
);
1357 buf1
= Fget_buffer (buf
);
1363 /* Move buf to the end of the buffer list. */
1365 register Lisp_Object aelt
, link
;
1367 aelt
= Frassq (buf
, Vbuffer_alist
);
1368 link
= Fmemq (aelt
, Vbuffer_alist
);
1369 Vbuffer_alist
= Fdelq (aelt
, Vbuffer_alist
);
1370 XCONS (link
)->cdr
= Qnil
;
1371 Vbuffer_alist
= nconc2 (Vbuffer_alist
, link
);
1377 DEFUN ("erase-buffer", Ferase_buffer
, Serase_buffer
, 0, 0, "*",
1378 "Delete the entire contents of the current buffer.\n\
1379 Any narrowing restriction in effect (see `narrow-to-region') is removed,\n\
1380 so the buffer is truly empty after this.")
1385 current_buffer
->last_window_start
= 1;
1386 /* Prevent warnings, or suspension of auto saving, that would happen
1387 if future size is less than past size. Use of erase-buffer
1388 implies that the future text is not really related to the past text. */
1389 XSETFASTINT (current_buffer
->save_length
, 0);
1393 validate_region (b
, e
)
1394 register Lisp_Object
*b
, *e
;
1396 CHECK_NUMBER_COERCE_MARKER (*b
, 0);
1397 CHECK_NUMBER_COERCE_MARKER (*e
, 1);
1399 if (XINT (*b
) > XINT (*e
))
1402 tem
= *b
; *b
= *e
; *e
= tem
;
1405 if (!(BEGV
<= XINT (*b
) && XINT (*b
) <= XINT (*e
)
1406 && XINT (*e
) <= ZV
))
1407 args_out_of_range (*b
, *e
);
1411 list_buffers_1 (files
)
1414 register Lisp_Object tail
, tem
, buf
;
1415 Lisp_Object col1
, col2
, col3
, minspace
;
1416 register struct buffer
*old
= current_buffer
, *b
;
1417 Lisp_Object desired_point
;
1418 Lisp_Object other_file_symbol
;
1420 desired_point
= Qnil
;
1421 other_file_symbol
= intern ("list-buffers-directory");
1423 XSETFASTINT (col1
, 17);
1424 XSETFASTINT (col2
, 28);
1425 XSETFASTINT (col3
, 40);
1426 XSETFASTINT (minspace
, 1);
1428 Fset_buffer (Vstandard_output
);
1429 Fbuffer_disable_undo (Vstandard_output
);
1430 current_buffer
->read_only
= Qnil
;
1433 MR Buffer Size Mode File\n\
1434 -- ------ ---- ---- ----\n", -1);
1436 for (tail
= Vbuffer_alist
; !NILP (tail
); tail
= Fcdr (tail
))
1438 buf
= Fcdr (Fcar (tail
));
1440 /* Don't mention the minibuffers. */
1441 if (XSTRING (b
->name
)->data
[0] == ' ')
1443 /* Optionally don't mention buffers that lack files. */
1444 if (!NILP (files
) && NILP (b
->filename
))
1446 /* Identify the current buffer. */
1448 XSETFASTINT (desired_point
, PT
);
1449 write_string (b
== old
? "." : " ", -1);
1450 /* Identify modified buffers */
1451 write_string (BUF_MODIFF (b
) > BUF_SAVE_MODIFF (b
) ? "*" : " ", -1);
1452 /* The current buffer is special-cased to be marked read-only.
1453 It is actually made read-only by the call to
1454 Buffer-menu-mode, below. */
1455 write_string ((b
!= current_buffer
&& NILP (b
->read_only
))
1457 Fprinc (b
->name
, Qnil
);
1458 tem
= Findent_to (col1
, make_number (2));
1464 sprintf (sizebuf
, "%8d", BUF_Z (b
) - BUF_BEG (b
));
1465 /* Here's how many extra columns the buffer name used. */
1466 i
= XFASTINT (tem
) - XFASTINT (col1
);
1467 /* Skip that many spaces in the size, if it has that many,
1468 to keep the size values right-aligned if possible. */
1477 write_string (p
, -1);
1479 Findent_to (col2
, minspace
);
1480 Fprinc (b
->mode_name
, Qnil
);
1481 Findent_to (col3
, minspace
);
1483 if (!NILP (b
->filename
))
1484 Fprinc (b
->filename
, Qnil
);
1487 /* No visited file; check local value of list-buffers-directory. */
1489 set_buffer_internal (b
);
1490 tem
= Fboundp (other_file_symbol
);
1493 tem
= Fsymbol_value (other_file_symbol
);
1494 Fset_buffer (Vstandard_output
);
1499 Fset_buffer (Vstandard_output
);
1501 write_string ("\n", -1);
1504 tail
= intern ("Buffer-menu-mode");
1505 if ((tem
= Ffboundp (tail
), !NILP (tem
)))
1507 set_buffer_internal (old
);
1508 return desired_point
;
1511 DEFUN ("list-buffers", Flist_buffers
, Slist_buffers
, 0, 1, "P",
1512 "Display a list of names of existing buffers.\n\
1513 The list is displayed in a buffer named `*Buffer List*'.\n\
1514 Note that buffers with names starting with spaces are omitted.\n\
1515 Non-null optional arg FILES-ONLY means mention only file buffers.\n\
1517 The M column contains a * for buffers that are modified.\n\
1518 The R column contains a % for buffers that are read-only.")
1522 Lisp_Object desired_point
;
1525 = internal_with_output_to_temp_buffer ("*Buffer List*",
1526 list_buffers_1
, files
);
1528 if (NUMBERP (desired_point
))
1530 int count
= specpdl_ptr
- specpdl
;
1531 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
1532 Fset_buffer (build_string ("*Buffer List*"));
1533 SET_PT (XINT (desired_point
));
1534 return unbind_to (count
, Qnil
);
1539 DEFUN ("kill-all-local-variables", Fkill_all_local_variables
, Skill_all_local_variables
,
1541 "Switch to Fundamental mode by killing current buffer's local variables.\n\
1542 Most local variable bindings are eliminated so that the default values\n\
1543 become effective once more. Also, the syntax table is set from\n\
1544 `standard-syntax-table', the local keymap is set to nil,\n\
1545 and the abbrev table from `fundamental-mode-abbrev-table'.\n\
1546 This function also forces redisplay of the mode line.\n\
1548 Every function to select a new major mode starts by\n\
1549 calling this function.\n\n\
1550 As a special exception, local variables whose names have\n\
1551 a non-nil `permanent-local' property are not eliminated by this function.\n\
1553 The first thing this function does is run\n\
1554 the normal hook `change-major-mode-hook'.")
1557 register Lisp_Object alist
, sym
, tem
;
1560 if (!NILP (Vrun_hooks
))
1561 call1 (Vrun_hooks
, intern ("change-major-mode-hook"));
1562 oalist
= current_buffer
->local_var_alist
;
1564 /* Make sure no local variables remain set up with this buffer
1565 for their current values. */
1567 for (alist
= oalist
; !NILP (alist
); alist
= XCONS (alist
)->cdr
)
1569 sym
= XCONS (XCONS (alist
)->car
)->car
;
1571 /* Need not do anything if some other buffer's binding is now encached. */
1572 tem
= XCONS (XBUFFER_LOCAL_VALUE (XSYMBOL (sym
)->value
)->cdr
)->car
;
1573 if (XBUFFER (tem
) == current_buffer
)
1575 /* Symbol is set up for this buffer's old local value.
1576 Set it up for the current buffer with the default value. */
1578 tem
= XCONS (XBUFFER_LOCAL_VALUE (XSYMBOL (sym
)->value
)->cdr
)->cdr
;
1579 /* Store the symbol's current value into the alist entry
1580 it is currently set up for. This is so that, if the
1581 local is marked permanent, and we make it local again below,
1582 we don't lose the value. */
1583 XCONS (XCONS (tem
)->car
)->cdr
1584 = do_symval_forwarding (XBUFFER_LOCAL_VALUE (XSYMBOL (sym
)->value
)->car
);
1585 /* Switch to the symbol's default-value alist entry. */
1586 XCONS (tem
)->car
= tem
;
1587 /* Mark it as current for the current buffer. */
1588 XCONS (XBUFFER_LOCAL_VALUE (XSYMBOL (sym
)->value
)->cdr
)->car
1589 = Fcurrent_buffer ();
1590 /* Store the current value into any forwarding in the symbol. */
1591 store_symval_forwarding (sym
, XBUFFER_LOCAL_VALUE (XSYMBOL (sym
)->value
)->car
,
1596 /* Actually eliminate all local bindings of this buffer. */
1598 reset_buffer_local_variables (current_buffer
);
1600 /* Redisplay mode lines; we are changing major mode. */
1602 update_mode_lines
++;
1604 /* Any which are supposed to be permanent,
1605 make local again, with the same values they had. */
1607 for (alist
= oalist
; !NILP (alist
); alist
= XCONS (alist
)->cdr
)
1609 sym
= XCONS (XCONS (alist
)->car
)->car
;
1610 tem
= Fget (sym
, Qpermanent_local
);
1613 Fmake_local_variable (sym
);
1614 Fset (sym
, XCONS (XCONS (alist
)->car
)->cdr
);
1618 /* Force mode-line redisplay. Useful here because all major mode
1619 commands call this function. */
1620 update_mode_lines
++;
1625 /* Find all the overlays in the current buffer that contain position POS.
1626 Return the number found, and store them in a vector in *VEC_PTR.
1627 Store in *LEN_PTR the size allocated for the vector.
1628 Store in *NEXT_PTR the next position after POS where an overlay starts,
1629 or ZV if there are no more overlays.
1630 Store in *PREV_PTR the previous position after POS where an overlay ends,
1631 or BEGV if there are no previous overlays.
1632 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
1634 *VEC_PTR and *LEN_PTR should contain a valid vector and size
1635 when this function is called.
1637 If EXTEND is non-zero, we make the vector bigger if necessary.
1638 If EXTEND is zero, we never extend the vector,
1639 and we store only as many overlays as will fit.
1640 But we still return the total number of overlays. */
1643 overlays_at (pos
, extend
, vec_ptr
, len_ptr
, next_ptr
, prev_ptr
)
1646 Lisp_Object
**vec_ptr
;
1651 Lisp_Object tail
, overlay
, start
, end
, result
;
1654 Lisp_Object
*vec
= *vec_ptr
;
1657 int inhibit_storing
= 0;
1659 for (tail
= current_buffer
->overlays_before
;
1661 tail
= XCONS (tail
)->cdr
)
1663 int startpos
, endpos
;
1665 overlay
= XCONS (tail
)->car
;
1667 start
= OVERLAY_START (overlay
);
1668 end
= OVERLAY_END (overlay
);
1669 endpos
= OVERLAY_POSITION (end
);
1678 startpos
= OVERLAY_POSITION (start
);
1679 if (startpos
<= pos
)
1683 /* The supplied vector is full.
1684 Either make it bigger, or don't store any more in it. */
1687 *len_ptr
= len
*= 2;
1688 vec
= (Lisp_Object
*) xrealloc (vec
, len
* sizeof (Lisp_Object
));
1692 inhibit_storing
= 1;
1695 if (!inhibit_storing
)
1697 /* Keep counting overlays even if we can't return them all. */
1700 else if (startpos
< next
)
1704 for (tail
= current_buffer
->overlays_after
;
1706 tail
= XCONS (tail
)->cdr
)
1708 int startpos
, endpos
;
1710 overlay
= XCONS (tail
)->car
;
1712 start
= OVERLAY_START (overlay
);
1713 end
= OVERLAY_END (overlay
);
1714 startpos
= OVERLAY_POSITION (start
);
1717 if (startpos
< next
)
1721 endpos
= OVERLAY_POSITION (end
);
1728 *len_ptr
= len
*= 2;
1729 vec
= (Lisp_Object
*) xrealloc (vec
, len
* sizeof (Lisp_Object
));
1733 inhibit_storing
= 1;
1736 if (!inhibit_storing
)
1740 else if (endpos
< pos
&& endpos
> prev
)
1753 Lisp_Object overlay
;
1759 compare_overlays (s1
, s2
)
1760 struct sortvec
*s1
, *s2
;
1762 if (s1
->priority
!= s2
->priority
)
1763 return s1
->priority
- s2
->priority
;
1764 if (s1
->beg
!= s2
->beg
)
1765 return s1
->beg
- s2
->beg
;
1766 if (s1
->end
!= s2
->end
)
1767 return s2
->end
- s1
->end
;
1771 /* Sort an array of overlays by priority. The array is modified in place.
1772 The return value is the new size; this may be smaller than the original
1773 size if some of the overlays were invalid or were window-specific. */
1775 sort_overlays (overlay_vec
, noverlays
, w
)
1776 Lisp_Object
*overlay_vec
;
1781 struct sortvec
*sortvec
;
1782 sortvec
= (struct sortvec
*) alloca (noverlays
* sizeof (struct sortvec
));
1784 /* Put the valid and relevant overlays into sortvec. */
1786 for (i
= 0, j
= 0; i
< noverlays
; i
++)
1789 Lisp_Object overlay
;
1791 overlay
= overlay_vec
[i
];
1792 if (OVERLAY_VALID (overlay
)
1793 && OVERLAY_POSITION (OVERLAY_START (overlay
)) > 0
1794 && OVERLAY_POSITION (OVERLAY_END (overlay
)) > 0)
1796 /* If we're interested in a specific window, then ignore
1797 overlays that are limited to some other window. */
1802 window
= Foverlay_get (overlay
, Qwindow
);
1803 if (WINDOWP (window
) && XWINDOW (window
) != w
)
1807 /* This overlay is good and counts: put it into sortvec. */
1808 sortvec
[j
].overlay
= overlay
;
1809 sortvec
[j
].beg
= OVERLAY_POSITION (OVERLAY_START (overlay
));
1810 sortvec
[j
].end
= OVERLAY_POSITION (OVERLAY_END (overlay
));
1811 tem
= Foverlay_get (overlay
, Qpriority
);
1813 sortvec
[j
].priority
= XINT (tem
);
1815 sortvec
[j
].priority
= 0;
1821 /* Sort the overlays into the proper order: increasing priority. */
1824 qsort (sortvec
, noverlays
, sizeof (struct sortvec
), compare_overlays
);
1826 for (i
= 0; i
< noverlays
; i
++)
1827 overlay_vec
[i
] = sortvec
[i
].overlay
;
1831 /* Shift overlays in BUF's overlay lists, to center the lists at POS. */
1834 recenter_overlay_lists (buf
, pos
)
1838 Lisp_Object overlay
, tail
, next
, prev
, beg
, end
;
1840 /* See if anything in overlays_before should move to overlays_after. */
1842 /* We don't strictly need prev in this loop; it should always be nil.
1843 But we use it for symmetry and in case that should cease to be true
1844 with some future change. */
1846 for (tail
= buf
->overlays_before
;
1848 prev
= tail
, tail
= next
)
1850 next
= XCONS (tail
)->cdr
;
1851 overlay
= XCONS (tail
)->car
;
1853 /* If the overlay is not valid, get rid of it. */
1854 if (!OVERLAY_VALID (overlay
))
1859 /* Splice the cons cell TAIL out of overlays_before. */
1861 XCONS (prev
)->cdr
= next
;
1863 buf
->overlays_before
= next
;
1869 beg
= OVERLAY_START (overlay
);
1870 end
= OVERLAY_END (overlay
);
1872 if (OVERLAY_POSITION (end
) > pos
)
1874 /* OVERLAY needs to be moved. */
1875 int where
= OVERLAY_POSITION (beg
);
1876 Lisp_Object other
, other_prev
;
1878 /* Splice the cons cell TAIL out of overlays_before. */
1880 XCONS (prev
)->cdr
= next
;
1882 buf
->overlays_before
= next
;
1884 /* Search thru overlays_after for where to put it. */
1886 for (other
= buf
->overlays_after
;
1888 other_prev
= other
, other
= XCONS (other
)->cdr
)
1890 Lisp_Object otherbeg
, otheroverlay
, follower
;
1893 otheroverlay
= XCONS (other
)->car
;
1894 if (! OVERLAY_VALID (otheroverlay
))
1897 otherbeg
= OVERLAY_START (otheroverlay
);
1898 if (OVERLAY_POSITION (otherbeg
) >= where
)
1902 /* Add TAIL to overlays_after before OTHER. */
1903 XCONS (tail
)->cdr
= other
;
1904 if (!NILP (other_prev
))
1905 XCONS (other_prev
)->cdr
= tail
;
1907 buf
->overlays_after
= tail
;
1911 /* We've reached the things that should stay in overlays_before.
1912 All the rest of overlays_before must end even earlier,
1917 /* See if anything in overlays_after should be in overlays_before. */
1919 for (tail
= buf
->overlays_after
;
1921 prev
= tail
, tail
= next
)
1923 next
= XCONS (tail
)->cdr
;
1924 overlay
= XCONS (tail
)->car
;
1926 /* If the overlay is not valid, get rid of it. */
1927 if (!OVERLAY_VALID (overlay
))
1932 /* Splice the cons cell TAIL out of overlays_after. */
1934 XCONS (prev
)->cdr
= next
;
1936 buf
->overlays_after
= next
;
1942 beg
= OVERLAY_START (overlay
);
1943 end
= OVERLAY_END (overlay
);
1945 /* Stop looking, when we know that nothing further
1946 can possibly end before POS. */
1947 if (OVERLAY_POSITION (beg
) > pos
)
1950 if (OVERLAY_POSITION (end
) <= pos
)
1952 /* OVERLAY needs to be moved. */
1953 int where
= OVERLAY_POSITION (end
);
1954 Lisp_Object other
, other_prev
;
1956 /* Splice the cons cell TAIL out of overlays_after. */
1958 XCONS (prev
)->cdr
= next
;
1960 buf
->overlays_after
= next
;
1962 /* Search thru overlays_before for where to put it. */
1964 for (other
= buf
->overlays_before
;
1966 other_prev
= other
, other
= XCONS (other
)->cdr
)
1968 Lisp_Object otherend
, otheroverlay
;
1971 otheroverlay
= XCONS (other
)->car
;
1972 if (! OVERLAY_VALID (otheroverlay
))
1975 otherend
= OVERLAY_END (otheroverlay
);
1976 if (OVERLAY_POSITION (otherend
) <= where
)
1980 /* Add TAIL to overlays_before before OTHER. */
1981 XCONS (tail
)->cdr
= other
;
1982 if (!NILP (other_prev
))
1983 XCONS (other_prev
)->cdr
= tail
;
1985 buf
->overlays_before
= tail
;
1990 XSETFASTINT (buf
->overlay_center
, pos
);
1993 /* Fix up overlays that were garbled as a result of permuting markers
1994 in the range START through END. Any overlay with at least one
1995 endpoint in this range will need to be unlinked from the overlay
1996 list and reinserted in its proper place.
1997 Such an overlay might even have negative size at this point.
1998 If so, we'll reverse the endpoints. Can you think of anything
1999 better to do in this situation? */
2001 fix_overlays_in_range (start
, end
)
2002 register int start
, end
;
2004 Lisp_Object tem
, overlay
;
2005 Lisp_Object before_list
, after_list
;
2006 Lisp_Object
*ptail
, *pbefore
= &before_list
, *pafter
= &after_list
;
2007 int startpos
, endpos
;
2009 /* This algorithm shifts links around instead of consing and GCing.
2010 The loop invariant is that before_list (resp. after_list) is a
2011 well-formed list except that its last element, the one that
2012 *pbefore (resp. *pafter) points to, is still uninitialized.
2013 So it's not a bug that before_list isn't initialized, although
2014 it may look strange. */
2015 for (ptail
= ¤t_buffer
->overlays_before
; CONSP (*ptail
);)
2017 overlay
= XCONS (*ptail
)->car
;
2018 endpos
= OVERLAY_POSITION (OVERLAY_END (overlay
));
2021 startpos
= OVERLAY_POSITION (OVERLAY_START (overlay
));
2023 || (startpos
>= start
&& startpos
< end
))
2025 /* If the overlay is backwards, fix that now. */
2026 if (startpos
> endpos
)
2029 Fset_marker (OVERLAY_START (overlay
), endpos
, Qnil
);
2030 Fset_marker (OVERLAY_END (overlay
), startpos
, Qnil
);
2031 tem
= startpos
; startpos
= endpos
; endpos
= tem
;
2033 /* Add it to the end of the wrong list. Later on,
2034 recenter_overlay_lists will move it to the right place. */
2035 if (endpos
< XINT (current_buffer
->overlay_center
))
2038 pafter
= &XCONS (*ptail
)->cdr
;
2043 pbefore
= &XCONS (*ptail
)->cdr
;
2045 *ptail
= XCONS (*ptail
)->cdr
;
2048 ptail
= &XCONS (*ptail
)->cdr
;
2050 for (ptail
= ¤t_buffer
->overlays_after
; CONSP (*ptail
);)
2052 overlay
= XCONS (*ptail
)->car
;
2053 startpos
= OVERLAY_POSITION (OVERLAY_START (overlay
));
2054 if (startpos
>= end
)
2056 endpos
= OVERLAY_POSITION (OVERLAY_END (overlay
));
2057 if (startpos
>= start
2058 || (endpos
>= start
&& endpos
< end
))
2060 if (startpos
> endpos
)
2063 Fset_marker (OVERLAY_START (overlay
), endpos
, Qnil
);
2064 Fset_marker (OVERLAY_END (overlay
), startpos
, Qnil
);
2065 tem
= startpos
; startpos
= endpos
; endpos
= tem
;
2067 if (endpos
< XINT (current_buffer
->overlay_center
))
2070 pafter
= &XCONS (*ptail
)->cdr
;
2075 pbefore
= &XCONS (*ptail
)->cdr
;
2077 *ptail
= XCONS (*ptail
)->cdr
;
2080 ptail
= &XCONS (*ptail
)->cdr
;
2083 /* Splice the constructed (wrong) lists into the buffer's lists,
2084 and let the recenter function make it sane again. */
2085 *pbefore
= current_buffer
->overlays_before
;
2086 current_buffer
->overlays_before
= before_list
;
2087 recenter_overlay_lists (current_buffer
,
2088 XINT (current_buffer
->overlay_center
));
2090 *pafter
= current_buffer
->overlays_after
;
2091 current_buffer
->overlays_after
= after_list
;
2092 recenter_overlay_lists (current_buffer
,
2093 XINT (current_buffer
->overlay_center
));
2096 DEFUN ("overlayp", Foverlayp
, Soverlayp
, 1, 1, 0,
2097 "Return t if OBJECT is an overlay.")
2101 return (OVERLAYP (object
) ? Qt
: Qnil
);
2104 DEFUN ("make-overlay", Fmake_overlay
, Smake_overlay
, 2, 3, 0,
2105 "Create a new overlay with range BEG to END in BUFFER.\n\
2106 If omitted, BUFFER defaults to the current buffer.\n\
2107 BEG and END may be integers or markers.")
2109 Lisp_Object beg
, end
, buffer
;
2111 Lisp_Object overlay
;
2115 XSETBUFFER (buffer
, current_buffer
);
2117 CHECK_BUFFER (buffer
, 2);
2119 && ! EQ (Fmarker_buffer (beg
), buffer
))
2120 error ("Marker points into wrong buffer");
2122 && ! EQ (Fmarker_buffer (end
), buffer
))
2123 error ("Marker points into wrong buffer");
2125 CHECK_NUMBER_COERCE_MARKER (beg
, 1);
2126 CHECK_NUMBER_COERCE_MARKER (end
, 1);
2128 if (XINT (beg
) > XINT (end
))
2131 temp
= beg
; beg
= end
; end
= temp
;
2134 b
= XBUFFER (buffer
);
2136 beg
= Fset_marker (Fmake_marker (), beg
, buffer
);
2137 end
= Fset_marker (Fmake_marker (), end
, buffer
);
2139 overlay
= allocate_misc ();
2140 XMISC (overlay
)->type
= Lisp_Misc_Overlay
;
2141 XOVERLAY (overlay
)->start
= beg
;
2142 XOVERLAY (overlay
)->end
= end
;
2143 XOVERLAY (overlay
)->plist
= Qnil
;
2145 /* Put the new overlay on the wrong list. */
2146 end
= OVERLAY_END (overlay
);
2147 if (OVERLAY_POSITION (end
) < XINT (b
->overlay_center
))
2148 b
->overlays_after
= Fcons (overlay
, b
->overlays_after
);
2150 b
->overlays_before
= Fcons (overlay
, b
->overlays_before
);
2152 /* This puts it in the right list, and in the right order. */
2153 recenter_overlay_lists (b
, XINT (b
->overlay_center
));
2155 /* We don't need to redisplay the region covered by the overlay, because
2156 the overlay has no properties at the moment. */
2161 DEFUN ("move-overlay", Fmove_overlay
, Smove_overlay
, 3, 4, 0,
2162 "Set the endpoints of OVERLAY to BEG and END in BUFFER.\n\
2163 If BUFFER is omitted, leave OVERLAY in the same buffer it inhabits now.\n\
2164 If BUFFER is omitted, and OVERLAY is in no buffer, put it in the current\n\
2166 (overlay
, beg
, end
, buffer
)
2167 Lisp_Object overlay
, beg
, end
, buffer
;
2169 struct buffer
*b
, *ob
;
2170 Lisp_Object obuffer
;
2171 int count
= specpdl_ptr
- specpdl
;
2173 CHECK_OVERLAY (overlay
, 0);
2175 buffer
= Fmarker_buffer (OVERLAY_START (overlay
));
2177 XSETBUFFER (buffer
, current_buffer
);
2178 CHECK_BUFFER (buffer
, 3);
2181 && ! EQ (Fmarker_buffer (beg
), buffer
))
2182 error ("Marker points into wrong buffer");
2184 && ! EQ (Fmarker_buffer (end
), buffer
))
2185 error ("Marker points into wrong buffer");
2187 CHECK_NUMBER_COERCE_MARKER (beg
, 1);
2188 CHECK_NUMBER_COERCE_MARKER (end
, 1);
2190 if (XINT (beg
) == XINT (end
) && ! NILP (Foverlay_get (overlay
, Qevaporate
)))
2191 return Fdelete_overlay (overlay
);
2193 if (XINT (beg
) > XINT (end
))
2196 temp
= beg
; beg
= end
; end
= temp
;
2199 specbind (Qinhibit_quit
, Qt
);
2201 obuffer
= Fmarker_buffer (OVERLAY_START (overlay
));
2202 b
= XBUFFER (buffer
);
2203 ob
= XBUFFER (obuffer
);
2205 /* If the overlay has changed buffers, do a thorough redisplay. */
2206 if (!EQ (buffer
, obuffer
))
2208 /* Redisplay where the overlay was. */
2209 if (!NILP (obuffer
))
2214 o_beg
= OVERLAY_START (overlay
);
2215 o_end
= OVERLAY_END (overlay
);
2216 o_beg
= OVERLAY_POSITION (o_beg
);
2217 o_end
= OVERLAY_POSITION (o_end
);
2219 redisplay_region (ob
, XINT (o_beg
), XINT (o_end
));
2222 /* Redisplay where the overlay is going to be. */
2223 redisplay_region (b
, XINT (beg
), XINT (end
));
2225 /* Don't limit redisplay to the selected window. */
2226 windows_or_buffers_changed
= 1;
2229 /* Redisplay the area the overlay has just left, or just enclosed. */
2233 int change_beg
, change_end
;
2235 o_beg
= OVERLAY_START (overlay
);
2236 o_end
= OVERLAY_END (overlay
);
2237 o_beg
= OVERLAY_POSITION (o_beg
);
2238 o_end
= OVERLAY_POSITION (o_end
);
2240 if (XINT (o_beg
) == XINT (beg
))
2241 redisplay_region (b
, XINT (o_end
), XINT (end
));
2242 else if (XINT (o_end
) == XINT (end
))
2243 redisplay_region (b
, XINT (o_beg
), XINT (beg
));
2246 if (XINT (beg
) < XINT (o_beg
)) o_beg
= beg
;
2247 if (XINT (end
) > XINT (o_end
)) o_end
= end
;
2248 redisplay_region (b
, XINT (o_beg
), XINT (o_end
));
2252 if (!NILP (obuffer
))
2254 ob
->overlays_before
= Fdelq (overlay
, ob
->overlays_before
);
2255 ob
->overlays_after
= Fdelq (overlay
, ob
->overlays_after
);
2258 Fset_marker (OVERLAY_START (overlay
), beg
, buffer
);
2259 Fset_marker (OVERLAY_END (overlay
), end
, buffer
);
2261 /* Put the overlay on the wrong list. */
2262 end
= OVERLAY_END (overlay
);
2263 if (OVERLAY_POSITION (end
) < XINT (b
->overlay_center
))
2264 b
->overlays_after
= Fcons (overlay
, b
->overlays_after
);
2266 b
->overlays_before
= Fcons (overlay
, b
->overlays_before
);
2268 /* This puts it in the right list, and in the right order. */
2269 recenter_overlay_lists (b
, XINT (b
->overlay_center
));
2271 return unbind_to (count
, overlay
);
2274 DEFUN ("delete-overlay", Fdelete_overlay
, Sdelete_overlay
, 1, 1, 0,
2275 "Delete the overlay OVERLAY from its buffer.")
2277 Lisp_Object overlay
;
2281 int count
= specpdl_ptr
- specpdl
;
2283 CHECK_OVERLAY (overlay
, 0);
2285 buffer
= Fmarker_buffer (OVERLAY_START (overlay
));
2289 b
= XBUFFER (buffer
);
2291 specbind (Qinhibit_quit
, Qt
);
2293 b
->overlays_before
= Fdelq (overlay
, b
->overlays_before
);
2294 b
->overlays_after
= Fdelq (overlay
, b
->overlays_after
);
2296 redisplay_region (b
,
2297 marker_position (OVERLAY_START (overlay
)),
2298 marker_position (OVERLAY_END (overlay
)));
2300 Fset_marker (OVERLAY_START (overlay
), Qnil
, Qnil
);
2301 Fset_marker (OVERLAY_END (overlay
), Qnil
, Qnil
);
2303 return unbind_to (count
, Qnil
);
2306 /* Overlay dissection functions. */
2308 DEFUN ("overlay-start", Foverlay_start
, Soverlay_start
, 1, 1, 0,
2309 "Return the position at which OVERLAY starts.")
2311 Lisp_Object overlay
;
2313 CHECK_OVERLAY (overlay
, 0);
2315 return (Fmarker_position (OVERLAY_START (overlay
)));
2318 DEFUN ("overlay-end", Foverlay_end
, Soverlay_end
, 1, 1, 0,
2319 "Return the position at which OVERLAY ends.")
2321 Lisp_Object overlay
;
2323 CHECK_OVERLAY (overlay
, 0);
2325 return (Fmarker_position (OVERLAY_END (overlay
)));
2328 DEFUN ("overlay-buffer", Foverlay_buffer
, Soverlay_buffer
, 1, 1, 0,
2329 "Return the buffer OVERLAY belongs to.")
2331 Lisp_Object overlay
;
2333 CHECK_OVERLAY (overlay
, 0);
2335 return Fmarker_buffer (OVERLAY_START (overlay
));
2338 DEFUN ("overlay-properties", Foverlay_properties
, Soverlay_properties
, 1, 1, 0,
2339 "Return a list of the properties on OVERLAY.\n\
2340 This is a copy of OVERLAY's plist; modifying its conses has no effect on\n\
2343 Lisp_Object overlay
;
2345 CHECK_OVERLAY (overlay
, 0);
2347 return Fcopy_sequence (XOVERLAY (overlay
)->plist
);
2351 DEFUN ("overlays-at", Foverlays_at
, Soverlays_at
, 1, 1, 0,
2352 "Return a list of the overlays that contain position POS.")
2357 Lisp_Object
*overlay_vec
;
2361 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
2364 overlay_vec
= (Lisp_Object
*) xmalloc (len
* sizeof (Lisp_Object
));
2366 /* Put all the overlays we want in a vector in overlay_vec.
2367 Store the length in len. */
2368 noverlays
= overlays_at (XINT (pos
), 1, &overlay_vec
, &len
, NULL
, NULL
);
2370 /* Make a list of them all. */
2371 result
= Flist (noverlays
, overlay_vec
);
2373 xfree (overlay_vec
);
2377 DEFUN ("next-overlay-change", Fnext_overlay_change
, Snext_overlay_change
,
2379 "Return the next position after POS where an overlay starts or ends.\n\
2380 If there are no more overlay boundaries after POS, return (point-max).")
2386 Lisp_Object
*overlay_vec
;
2390 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
2393 overlay_vec
= (Lisp_Object
*) xmalloc (len
* sizeof (Lisp_Object
));
2395 /* Put all the overlays we want in a vector in overlay_vec.
2396 Store the length in len.
2397 endpos gets the position where the next overlay starts. */
2398 noverlays
= overlays_at (XINT (pos
), 1, &overlay_vec
, &len
, &endpos
, NULL
);
2400 /* If any of these overlays ends before endpos,
2401 use its ending point instead. */
2402 for (i
= 0; i
< noverlays
; i
++)
2407 oend
= OVERLAY_END (overlay_vec
[i
]);
2408 oendpos
= OVERLAY_POSITION (oend
);
2409 if (oendpos
< endpos
)
2413 xfree (overlay_vec
);
2414 return make_number (endpos
);
2417 DEFUN ("previous-overlay-change", Fprevious_overlay_change
,
2418 Sprevious_overlay_change
, 1, 1, 0,
2419 "Return the previous position before POS where an overlay starts or ends.\n\
2420 If there are no more overlay boundaries after POS, return (point-min).")
2426 Lisp_Object
*overlay_vec
;
2430 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
2433 overlay_vec
= (Lisp_Object
*) xmalloc (len
* sizeof (Lisp_Object
));
2435 /* Put all the overlays we want in a vector in overlay_vec.
2436 Store the length in len.
2437 prevpos gets the position of an overlay end. */
2438 noverlays
= overlays_at (XINT (pos
), 1, &overlay_vec
, &len
, NULL
, &prevpos
);
2440 /* If any of these overlays starts before endpos,
2441 maybe use its starting point instead. */
2442 for (i
= 0; i
< noverlays
; i
++)
2447 ostart
= OVERLAY_START (overlay_vec
[i
]);
2448 ostartpos
= OVERLAY_POSITION (ostart
);
2449 if (ostartpos
> prevpos
&& ostartpos
< XINT (pos
))
2450 prevpos
= ostartpos
;
2453 xfree (overlay_vec
);
2454 return make_number (prevpos
);
2457 /* These functions are for debugging overlays. */
2459 DEFUN ("overlay-lists", Foverlay_lists
, Soverlay_lists
, 0, 0, 0,
2460 "Return a pair of lists giving all the overlays of the current buffer.\n\
2461 The car has all the overlays before the overlay center;\n\
2462 the cdr has all the overlays after the overlay center.\n\
2463 Recentering overlays moves overlays between these lists.\n\
2464 The lists you get are copies, so that changing them has no effect.\n\
2465 However, the overlays you get are the real objects that the buffer uses.")
2468 Lisp_Object before
, after
;
2469 before
= current_buffer
->overlays_before
;
2471 before
= Fcopy_sequence (before
);
2472 after
= current_buffer
->overlays_after
;
2474 after
= Fcopy_sequence (after
);
2476 return Fcons (before
, after
);
2479 DEFUN ("overlay-recenter", Foverlay_recenter
, Soverlay_recenter
, 1, 1, 0,
2480 "Recenter the overlays of the current buffer around position POS.")
2484 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
2486 recenter_overlay_lists (current_buffer
, XINT (pos
));
2490 DEFUN ("overlay-get", Foverlay_get
, Soverlay_get
, 2, 2, 0,
2491 "Get the property of overlay OVERLAY with property name NAME.")
2493 Lisp_Object overlay
, prop
;
2495 Lisp_Object plist
, fallback
;
2497 CHECK_OVERLAY (overlay
, 0);
2501 for (plist
= XOVERLAY (overlay
)->plist
;
2502 CONSP (plist
) && CONSP (XCONS (plist
)->cdr
);
2503 plist
= XCONS (XCONS (plist
)->cdr
)->cdr
)
2505 if (EQ (XCONS (plist
)->car
, prop
))
2506 return XCONS (XCONS (plist
)->cdr
)->car
;
2507 else if (EQ (XCONS (plist
)->car
, Qcategory
))
2510 tem
= Fcar (Fcdr (plist
));
2512 fallback
= Fget (tem
, prop
);
2519 DEFUN ("overlay-put", Foverlay_put
, Soverlay_put
, 3, 3, 0,
2520 "Set one property of overlay OVERLAY: give property PROP value VALUE.")
2521 (overlay
, prop
, value
)
2522 Lisp_Object overlay
, prop
, value
;
2524 Lisp_Object tail
, buffer
;
2527 CHECK_OVERLAY (overlay
, 0);
2529 buffer
= Fmarker_buffer (OVERLAY_START (overlay
));
2531 for (tail
= XOVERLAY (overlay
)->plist
;
2532 CONSP (tail
) && CONSP (XCONS (tail
)->cdr
);
2533 tail
= XCONS (XCONS (tail
)->cdr
)->cdr
)
2534 if (EQ (XCONS (tail
)->car
, prop
))
2536 changed
= !EQ (XCONS (XCONS (tail
)->cdr
)->car
, value
);
2537 XCONS (XCONS (tail
)->cdr
)->car
= value
;
2540 /* It wasn't in the list, so add it to the front. */
2541 changed
= !NILP (value
);
2542 XOVERLAY (overlay
)->plist
2543 = Fcons (prop
, Fcons (value
, XOVERLAY (overlay
)->plist
));
2545 if (! NILP (buffer
))
2548 redisplay_region (XBUFFER (buffer
),
2549 marker_position (OVERLAY_START (overlay
)),
2550 marker_position (OVERLAY_END (overlay
)));
2551 if (EQ (prop
, Qevaporate
) && ! NILP (value
)
2552 && (OVERLAY_POSITION (OVERLAY_START (overlay
))
2553 == OVERLAY_POSITION (OVERLAY_END (overlay
))))
2554 Fdelete_overlay (overlay
);
2559 /* Run the modification-hooks of overlays that include
2560 any part of the text in START to END.
2561 Run the insert-before-hooks of overlay starting at END,
2562 and the insert-after-hooks of overlay ending at START.
2564 This is called both before and after the modification.
2565 AFTER is nonzero when we call after the modification.
2567 ARG1, ARG2, ARG3 are arguments to pass to the hook functions. */
2570 report_overlay_modification (start
, end
, after
, arg1
, arg2
, arg3
)
2571 Lisp_Object start
, end
;
2573 Lisp_Object arg1
, arg2
, arg3
;
2575 Lisp_Object prop
, overlay
, tail
;
2576 int insertion
= EQ (start
, end
);
2578 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2582 GCPRO5 (overlay
, tail
, arg1
, arg2
, arg3
);
2585 for (tail
= current_buffer
->overlays_before
;
2587 tail
= XCONS (tail
)->cdr
)
2589 int startpos
, endpos
;
2590 Lisp_Object ostart
, oend
;
2592 overlay
= XCONS (tail
)->car
;
2594 ostart
= OVERLAY_START (overlay
);
2595 oend
= OVERLAY_END (overlay
);
2596 endpos
= OVERLAY_POSITION (oend
);
2597 if (XFASTINT (start
) > endpos
)
2599 startpos
= OVERLAY_POSITION (ostart
);
2600 if (XFASTINT (end
) == startpos
&& insertion
)
2602 prop
= Foverlay_get (overlay
, Qinsert_in_front_hooks
);
2605 /* Copy TAIL in case the hook recenters the overlay lists. */
2607 tail
= Fcopy_sequence (tail
);
2609 call_overlay_mod_hooks (prop
, overlay
, after
, arg1
, arg2
, arg3
);
2612 if (XFASTINT (start
) == endpos
&& insertion
)
2614 prop
= Foverlay_get (overlay
, Qinsert_behind_hooks
);
2618 tail
= Fcopy_sequence (tail
);
2620 call_overlay_mod_hooks (prop
, overlay
, after
, arg1
, arg2
, arg3
);
2623 /* Test for intersecting intervals. This does the right thing
2624 for both insertion and deletion. */
2625 if (XFASTINT (end
) > startpos
&& XFASTINT (start
) < endpos
)
2627 prop
= Foverlay_get (overlay
, Qmodification_hooks
);
2631 tail
= Fcopy_sequence (tail
);
2633 call_overlay_mod_hooks (prop
, overlay
, after
, arg1
, arg2
, arg3
);
2639 for (tail
= current_buffer
->overlays_after
;
2641 tail
= XCONS (tail
)->cdr
)
2643 int startpos
, endpos
;
2644 Lisp_Object ostart
, oend
;
2646 overlay
= XCONS (tail
)->car
;
2648 ostart
= OVERLAY_START (overlay
);
2649 oend
= OVERLAY_END (overlay
);
2650 startpos
= OVERLAY_POSITION (ostart
);
2651 endpos
= OVERLAY_POSITION (oend
);
2652 if (XFASTINT (end
) < startpos
)
2654 if (XFASTINT (end
) == startpos
&& insertion
)
2656 prop
= Foverlay_get (overlay
, Qinsert_in_front_hooks
);
2660 tail
= Fcopy_sequence (tail
);
2662 call_overlay_mod_hooks (prop
, overlay
, after
, arg1
, arg2
, arg3
);
2665 if (XFASTINT (start
) == endpos
&& insertion
)
2667 prop
= Foverlay_get (overlay
, Qinsert_behind_hooks
);
2671 tail
= Fcopy_sequence (tail
);
2673 call_overlay_mod_hooks (prop
, overlay
, after
, arg1
, arg2
, arg3
);
2676 /* Test for intersecting intervals. This does the right thing
2677 for both insertion and deletion. */
2678 if (XFASTINT (end
) > startpos
&& XFASTINT (start
) < endpos
)
2680 prop
= Foverlay_get (overlay
, Qmodification_hooks
);
2684 tail
= Fcopy_sequence (tail
);
2686 call_overlay_mod_hooks (prop
, overlay
, after
, arg1
, arg2
, arg3
);
2695 call_overlay_mod_hooks (list
, overlay
, after
, arg1
, arg2
, arg3
)
2696 Lisp_Object list
, overlay
;
2698 Lisp_Object arg1
, arg2
, arg3
;
2700 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2701 GCPRO4 (list
, arg1
, arg2
, arg3
);
2702 while (!NILP (list
))
2705 call4 (Fcar (list
), overlay
, after
? Qt
: Qnil
, arg1
, arg2
);
2707 call5 (Fcar (list
), overlay
, after
? Qt
: Qnil
, arg1
, arg2
, arg3
);
2713 /* Delete any zero-sized overlays at position POS, if the `evaporate'
2716 evaporate_overlays (pos
)
2719 Lisp_Object tail
, overlay
, hit_list
;
2722 if (pos
<= XFASTINT (current_buffer
->overlay_center
))
2723 for (tail
= current_buffer
->overlays_before
; CONSP (tail
);
2724 tail
= XCONS (tail
)->cdr
)
2727 overlay
= XCONS (tail
)->car
;
2728 endpos
= OVERLAY_POSITION (OVERLAY_END (overlay
));
2731 if (endpos
== pos
&& OVERLAY_POSITION (OVERLAY_START (overlay
)) == pos
2732 && Foverlay_get (overlay
, Qevaporate
))
2733 hit_list
= Fcons (overlay
, hit_list
);
2736 for (tail
= current_buffer
->overlays_after
; CONSP (tail
);
2737 tail
= XCONS (tail
)->cdr
)
2740 overlay
= XCONS (tail
)->car
;
2741 startpos
= OVERLAY_POSITION (OVERLAY_START (overlay
));
2744 if (startpos
== pos
&& OVERLAY_POSITION (OVERLAY_END (overlay
)) == pos
2745 && Foverlay_get (overlay
, Qevaporate
))
2746 hit_list
= Fcons (overlay
, hit_list
);
2748 for (; CONSP (hit_list
); hit_list
= XCONS (hit_list
)->cdr
)
2749 Fdelete_overlay (XCONS (hit_list
)->car
);
2752 /* Somebody has tried to store a value with an unacceptable type
2753 into the buffer-local slot with offset OFFSET. */
2755 buffer_slot_type_mismatch (offset
)
2760 sym
= *(Lisp_Object
*)(offset
+ (char *)&buffer_local_symbols
);
2761 switch (XINT (*(Lisp_Object
*)(offset
+ (char *)&buffer_local_types
)))
2763 case Lisp_Int
: type_name
= "integers"; break;
2764 case Lisp_String
: type_name
= "strings"; break;
2765 case Lisp_Symbol
: type_name
= "symbols"; break;
2770 error ("only %s should be stored in the buffer-local variable %s",
2771 type_name
, XSYMBOL (sym
)->name
->data
);
2776 register Lisp_Object tem
;
2778 /* Make sure all markable slots in buffer_defaults
2779 are initialized reasonably, so mark_buffer won't choke. */
2780 reset_buffer (&buffer_defaults
);
2781 reset_buffer_local_variables (&buffer_defaults
);
2782 reset_buffer (&buffer_local_symbols
);
2783 reset_buffer_local_variables (&buffer_local_symbols
);
2784 /* Prevent GC from getting confused. */
2785 buffer_defaults
.text
= &buffer_defaults
.own_text
;
2786 buffer_local_symbols
.text
= &buffer_local_symbols
.own_text
;
2787 #ifdef USE_TEXT_PROPERTIES
2788 BUF_INTERVALS (&buffer_defaults
) = 0;
2789 BUF_INTERVALS (&buffer_local_symbols
) = 0;
2791 XSETBUFFER (Vbuffer_defaults
, &buffer_defaults
);
2792 XSETBUFFER (Vbuffer_local_symbols
, &buffer_local_symbols
);
2794 /* Set up the default values of various buffer slots. */
2795 /* Must do these before making the first buffer! */
2797 /* real setup is done in loaddefs.el */
2798 buffer_defaults
.mode_line_format
= build_string ("%-");
2799 buffer_defaults
.abbrev_mode
= Qnil
;
2800 buffer_defaults
.overwrite_mode
= Qnil
;
2801 buffer_defaults
.case_fold_search
= Qt
;
2802 buffer_defaults
.auto_fill_function
= Qnil
;
2803 buffer_defaults
.selective_display
= Qnil
;
2805 buffer_defaults
.selective_display_ellipses
= Qt
;
2807 buffer_defaults
.abbrev_table
= Qnil
;
2808 buffer_defaults
.display_table
= Qnil
;
2809 buffer_defaults
.undo_list
= Qnil
;
2810 buffer_defaults
.mark_active
= Qnil
;
2811 buffer_defaults
.overlays_before
= Qnil
;
2812 buffer_defaults
.overlays_after
= Qnil
;
2813 XSETFASTINT (buffer_defaults
.overlay_center
, 1);
2815 XSETFASTINT (buffer_defaults
.tab_width
, 8);
2816 buffer_defaults
.truncate_lines
= Qnil
;
2817 buffer_defaults
.ctl_arrow
= Qt
;
2820 buffer_defaults
.buffer_file_type
= Qnil
; /* TEXT */
2822 XSETFASTINT (buffer_defaults
.fill_column
, 70);
2823 XSETFASTINT (buffer_defaults
.left_margin
, 0);
2824 buffer_defaults
.cache_long_line_scans
= Qnil
;
2826 /* Assign the local-flags to the slots that have default values.
2827 The local flag is a bit that is used in the buffer
2828 to say that it has its own local value for the slot.
2829 The local flag bits are in the local_var_flags slot of the buffer. */
2831 /* Nothing can work if this isn't true */
2832 if (sizeof (EMACS_INT
) != sizeof (Lisp_Object
)) abort ();
2834 /* 0 means not a lisp var, -1 means always local, else mask */
2835 bzero (&buffer_local_flags
, sizeof buffer_local_flags
);
2836 XSETINT (buffer_local_flags
.filename
, -1);
2837 XSETINT (buffer_local_flags
.directory
, -1);
2838 XSETINT (buffer_local_flags
.backed_up
, -1);
2839 XSETINT (buffer_local_flags
.save_length
, -1);
2840 XSETINT (buffer_local_flags
.auto_save_file_name
, -1);
2841 XSETINT (buffer_local_flags
.read_only
, -1);
2842 XSETINT (buffer_local_flags
.major_mode
, -1);
2843 XSETINT (buffer_local_flags
.mode_name
, -1);
2844 XSETINT (buffer_local_flags
.undo_list
, -1);
2845 XSETINT (buffer_local_flags
.mark_active
, -1);
2847 XSETFASTINT (buffer_local_flags
.mode_line_format
, 1);
2848 XSETFASTINT (buffer_local_flags
.abbrev_mode
, 2);
2849 XSETFASTINT (buffer_local_flags
.overwrite_mode
, 4);
2850 XSETFASTINT (buffer_local_flags
.case_fold_search
, 8);
2851 XSETFASTINT (buffer_local_flags
.auto_fill_function
, 0x10);
2852 XSETFASTINT (buffer_local_flags
.selective_display
, 0x20);
2854 XSETFASTINT (buffer_local_flags
.selective_display_ellipses
, 0x40);
2856 XSETFASTINT (buffer_local_flags
.tab_width
, 0x80);
2857 XSETFASTINT (buffer_local_flags
.truncate_lines
, 0x100);
2858 XSETFASTINT (buffer_local_flags
.ctl_arrow
, 0x200);
2859 XSETFASTINT (buffer_local_flags
.fill_column
, 0x400);
2860 XSETFASTINT (buffer_local_flags
.left_margin
, 0x800);
2861 XSETFASTINT (buffer_local_flags
.abbrev_table
, 0x1000);
2862 XSETFASTINT (buffer_local_flags
.display_table
, 0x2000);
2863 XSETFASTINT (buffer_local_flags
.syntax_table
, 0x8000);
2864 XSETFASTINT (buffer_local_flags
.cache_long_line_scans
, 0x10000);
2866 XSETFASTINT (buffer_local_flags
.buffer_file_type
, 0x4000);
2869 Vbuffer_alist
= Qnil
;
2873 QSFundamental
= build_string ("Fundamental");
2875 Qfundamental_mode
= intern ("fundamental-mode");
2876 buffer_defaults
.major_mode
= Qfundamental_mode
;
2878 Qmode_class
= intern ("mode-class");
2880 Qprotected_field
= intern ("protected-field");
2882 Qpermanent_local
= intern ("permanent-local");
2884 Qkill_buffer_hook
= intern ("kill-buffer-hook");
2886 Vprin1_to_string_buffer
= Fget_buffer_create (build_string (" prin1"));
2887 /* super-magic invisible buffer */
2888 Vbuffer_alist
= Qnil
;
2890 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
2895 char buf
[MAXPATHLEN
+1];
2897 struct stat dotstat
, pwdstat
;
2901 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
2903 /* If PWD is accurate, use it instead of calling getwd. This is faster
2904 when PWD is right, and may avoid a fatal error. */
2905 if ((pwd
= getenv ("PWD")) != 0 && IS_DIRECTORY_SEP (*pwd
)
2906 && stat (pwd
, &pwdstat
) == 0
2907 && stat (".", &dotstat
) == 0
2908 && dotstat
.st_ino
== pwdstat
.st_ino
2909 && dotstat
.st_dev
== pwdstat
.st_dev
2910 && strlen (pwd
) < MAXPATHLEN
)
2912 else if (getwd (buf
) == 0)
2913 fatal ("`getwd' failed: %s\n", buf
);
2916 /* Maybe this should really use some standard subroutine
2917 whose definition is filename syntax dependent. */
2919 if (!(IS_DIRECTORY_SEP (buf
[rc
- 1])))
2921 buf
[rc
] = DIRECTORY_SEP
;
2924 #endif /* not VMS */
2925 current_buffer
->directory
= build_string (buf
);
2927 temp
= get_minibuffer (0);
2928 XBUFFER (temp
)->directory
= current_buffer
->directory
;
2931 /* initialize the buffer routines */
2934 extern Lisp_Object Qdisabled
;
2936 staticpro (&Vbuffer_defaults
);
2937 staticpro (&Vbuffer_local_symbols
);
2938 staticpro (&Qfundamental_mode
);
2939 staticpro (&Qmode_class
);
2940 staticpro (&QSFundamental
);
2941 staticpro (&Vbuffer_alist
);
2942 staticpro (&Qprotected_field
);
2943 staticpro (&Qpermanent_local
);
2944 staticpro (&Qkill_buffer_hook
);
2945 staticpro (&Qoverlayp
);
2946 Qevaporate
= intern ("evaporate");
2947 staticpro (&Qevaporate
);
2948 staticpro (&Qmodification_hooks
);
2949 Qmodification_hooks
= intern ("modification-hooks");
2950 staticpro (&Qinsert_in_front_hooks
);
2951 Qinsert_in_front_hooks
= intern ("insert-in-front-hooks");
2952 staticpro (&Qinsert_behind_hooks
);
2953 Qinsert_behind_hooks
= intern ("insert-behind-hooks");
2954 staticpro (&Qget_file_buffer
);
2955 Qget_file_buffer
= intern ("get-file-buffer");
2956 Qpriority
= intern ("priority");
2957 staticpro (&Qpriority
);
2958 Qwindow
= intern ("window");
2959 staticpro (&Qwindow
);
2961 Qoverlayp
= intern ("overlayp");
2963 Fput (Qprotected_field
, Qerror_conditions
,
2964 Fcons (Qprotected_field
, Fcons (Qerror
, Qnil
)));
2965 Fput (Qprotected_field
, Qerror_message
,
2966 build_string ("Attempt to modify a protected field"));
2968 /* All these use DEFVAR_LISP_NOPRO because the slots in
2969 buffer_defaults will all be marked via Vbuffer_defaults. */
2971 DEFVAR_LISP_NOPRO ("default-mode-line-format",
2972 &buffer_defaults
.mode_line_format
,
2973 "Default value of `mode-line-format' for buffers that don't override it.\n\
2974 This is the same as (default-value 'mode-line-format).");
2976 DEFVAR_LISP_NOPRO ("default-abbrev-mode",
2977 &buffer_defaults
.abbrev_mode
,
2978 "Default value of `abbrev-mode' for buffers that do not override it.\n\
2979 This is the same as (default-value 'abbrev-mode).");
2981 DEFVAR_LISP_NOPRO ("default-ctl-arrow",
2982 &buffer_defaults
.ctl_arrow
,
2983 "Default value of `ctl-arrow' for buffers that do not override it.\n\
2984 This is the same as (default-value 'ctl-arrow).");
2986 DEFVAR_LISP_NOPRO ("default-truncate-lines",
2987 &buffer_defaults
.truncate_lines
,
2988 "Default value of `truncate-lines' for buffers that do not override it.\n\
2989 This is the same as (default-value 'truncate-lines).");
2991 DEFVAR_LISP_NOPRO ("default-fill-column",
2992 &buffer_defaults
.fill_column
,
2993 "Default value of `fill-column' for buffers that do not override it.\n\
2994 This is the same as (default-value 'fill-column).");
2996 DEFVAR_LISP_NOPRO ("default-left-margin",
2997 &buffer_defaults
.left_margin
,
2998 "Default value of `left-margin' for buffers that do not override it.\n\
2999 This is the same as (default-value 'left-margin).");
3001 DEFVAR_LISP_NOPRO ("default-tab-width",
3002 &buffer_defaults
.tab_width
,
3003 "Default value of `tab-width' for buffers that do not override it.\n\
3004 This is the same as (default-value 'tab-width).");
3006 DEFVAR_LISP_NOPRO ("default-case-fold-search",
3007 &buffer_defaults
.case_fold_search
,
3008 "Default value of `case-fold-search' for buffers that don't override it.\n\
3009 This is the same as (default-value 'case-fold-search).");
3012 DEFVAR_LISP_NOPRO ("default-buffer-file-type",
3013 &buffer_defaults
.buffer_file_type
,
3014 "Default file type for buffers that do not override it.\n\
3015 This is the same as (default-value 'buffer-file-type).\n\
3016 The file type is nil for text, t for binary.");
3019 DEFVAR_PER_BUFFER ("mode-line-format", ¤t_buffer
->mode_line_format
,
3022 /* This doc string is too long for cpp; cpp dies if it isn't in a comment.
3023 But make-docfile finds it!
3024 DEFVAR_PER_BUFFER ("mode-line-format", ¤t_buffer->mode_line_format,
3026 "Template for displaying mode line for current buffer.\n\
3027 Each buffer has its own value of this variable.\n\
3028 Value may be a string, a symbol or a list or cons cell.\n\
3029 For a symbol, its value is used (but it is ignored if t or nil).\n\
3030 A string appearing directly as the value of a symbol is processed verbatim\n\
3031 in that the %-constructs below are not recognized.\n\
3032 For a list whose car is a symbol, the symbol's value is taken,\n\
3033 and if that is non-nil, the cadr of the list is processed recursively.\n\
3034 Otherwise, the caddr of the list (if there is one) is processed.\n\
3035 For a list whose car is a string or list, each element is processed\n\
3036 recursively and the results are effectively concatenated.\n\
3037 For a list whose car is an integer, the cdr of the list is processed\n\
3038 and padded (if the number is positive) or truncated (if negative)\n\
3039 to the width specified by that number.\n\
3040 A string is printed verbatim in the mode line except for %-constructs:\n\
3041 (%-constructs are allowed when the string is the entire mode-line-format\n\
3042 or when it is found in a cons-cell or a list)\n\
3043 %b -- print buffer name. %f -- print visited file name.\n\
3044 %* -- print %, * or hyphen. %+ -- print *, % or hyphen.\n\
3045 % means buffer is read-only and * means it is modified.\n\
3046 For a modified read-only buffer, %* gives % and %+ gives *.\n\
3047 %s -- print process status. %l -- print the current line number.\n\
3048 %p -- print percent of buffer above top of window, or Top, Bot or All.\n\
3049 %P -- print percent of buffer above bottom of window, perhaps plus Top,\n\
3050 or print Bottom or All.\n\
3051 %n -- print Narrow if appropriate.\n\
3052 %t -- print T if files is text, B if binary.\n\
3053 %[ -- print one [ for each recursive editing level. %] similar.\n\
3054 %% -- print %. %- -- print infinitely many dashes.\n\
3055 Decimal digits after the % specify field width to which to pad.");
3058 DEFVAR_LISP_NOPRO ("default-major-mode", &buffer_defaults
.major_mode
,
3059 "*Major mode for new buffers. Defaults to `fundamental-mode'.\n\
3060 nil here means use current buffer's major mode.");
3062 DEFVAR_PER_BUFFER ("major-mode", ¤t_buffer
->major_mode
,
3063 make_number (Lisp_Symbol
),
3064 "Symbol for current buffer's major mode.");
3066 DEFVAR_PER_BUFFER ("mode-name", ¤t_buffer
->mode_name
,
3067 make_number (Lisp_String
),
3068 "Pretty name of current buffer's major mode (a string).");
3070 DEFVAR_PER_BUFFER ("abbrev-mode", ¤t_buffer
->abbrev_mode
, Qnil
,
3071 "Non-nil turns on automatic expansion of abbrevs as they are inserted.\n\
3072 Automatically becomes buffer-local when set in any fashion.");
3074 DEFVAR_PER_BUFFER ("case-fold-search", ¤t_buffer
->case_fold_search
,
3076 "*Non-nil if searches should ignore case.\n\
3077 Automatically becomes buffer-local when set in any fashion.");
3079 DEFVAR_PER_BUFFER ("fill-column", ¤t_buffer
->fill_column
,
3080 make_number (Lisp_Int
),
3081 "*Column beyond which automatic line-wrapping should happen.\n\
3082 Automatically becomes buffer-local when set in any fashion.");
3084 DEFVAR_PER_BUFFER ("left-margin", ¤t_buffer
->left_margin
,
3085 make_number (Lisp_Int
),
3086 "*Column for the default indent-line-function to indent to.\n\
3087 Linefeed indents to this column in Fundamental mode.\n\
3088 Automatically becomes buffer-local when set in any fashion.");
3090 DEFVAR_PER_BUFFER ("tab-width", ¤t_buffer
->tab_width
,
3091 make_number (Lisp_Int
),
3092 "*Distance between tab stops (for display of tab characters), in columns.\n\
3093 Automatically becomes buffer-local when set in any fashion.");
3095 DEFVAR_PER_BUFFER ("ctl-arrow", ¤t_buffer
->ctl_arrow
, Qnil
,
3096 "*Non-nil means display control chars with uparrow.\n\
3097 Nil means use backslash and octal digits.\n\
3098 Automatically becomes buffer-local when set in any fashion.\n\
3099 This variable does not apply to characters whose display is specified\n\
3100 in the current display table (if there is one).");
3102 DEFVAR_PER_BUFFER ("truncate-lines", ¤t_buffer
->truncate_lines
, Qnil
,
3103 "*Non-nil means do not display continuation lines;\n\
3104 give each line of text one screen line.\n\
3105 Automatically becomes buffer-local when set in any fashion.\n\
3107 Note that this is overridden by the variable\n\
3108 `truncate-partial-width-windows' if that variable is non-nil\n\
3109 and this buffer is not full-frame width.");
3112 DEFVAR_PER_BUFFER ("buffer-file-type", ¤t_buffer
->buffer_file_type
,
3114 "Non-nil if the visited file is a binary file.\n\
3115 This variable is meaningful on MS-DOG and Windows NT.\n\
3116 On those systems, it is automatically local in every buffer.\n\
3117 On other systems, this variable is normally always nil.")
3120 DEFVAR_PER_BUFFER ("default-directory", ¤t_buffer
->directory
,
3121 make_number (Lisp_String
),
3122 "Name of default directory of current buffer. Should end with slash.\n\
3123 Each buffer has its own value of this variable.");
3125 DEFVAR_PER_BUFFER ("auto-fill-function", ¤t_buffer
->auto_fill_function
,
3127 "Function called (if non-nil) to perform auto-fill.\n\
3128 It is called after self-inserting a space at a column beyond `fill-column'.\n\
3129 Each buffer has its own value of this variable.\n\
3130 NOTE: This variable is not an ordinary hook;\n\
3131 It may not be a list of functions.");
3133 DEFVAR_PER_BUFFER ("buffer-file-name", ¤t_buffer
->filename
,
3134 make_number (Lisp_String
),
3135 "Name of file visited in current buffer, or nil if not visiting a file.\n\
3136 Each buffer has its own value of this variable.");
3138 DEFVAR_PER_BUFFER ("buffer-auto-save-file-name",
3139 ¤t_buffer
->auto_save_file_name
,
3140 make_number (Lisp_String
),
3141 "Name of file for auto-saving current buffer,\n\
3142 or nil if buffer should not be auto-saved.\n\
3143 Each buffer has its own value of this variable.");
3145 DEFVAR_PER_BUFFER ("buffer-read-only", ¤t_buffer
->read_only
, Qnil
,
3146 "Non-nil if this buffer is read-only.\n\
3147 Each buffer has its own value of this variable.");
3149 DEFVAR_PER_BUFFER ("buffer-backed-up", ¤t_buffer
->backed_up
, Qnil
,
3150 "Non-nil if this buffer's file has been backed up.\n\
3151 Backing up is done before the first time the file is saved.\n\
3152 Each buffer has its own value of this variable.");
3154 DEFVAR_PER_BUFFER ("buffer-saved-size", ¤t_buffer
->save_length
,
3155 make_number (Lisp_Int
),
3156 "Length of current buffer when last read in, saved or auto-saved.\n\
3158 Each buffer has its own value of this variable.");
3160 DEFVAR_PER_BUFFER ("selective-display", ¤t_buffer
->selective_display
,
3162 "Non-nil enables selective display:\n\
3163 Integer N as value means display only lines\n\
3164 that start with less than n columns of space.\n\
3165 A value of t means, after a ^M, all the rest of the line is invisible.\n\
3166 Then ^M's in the file are written into files as newlines.\n\n\
3167 Automatically becomes buffer-local when set in any fashion.");
3170 DEFVAR_PER_BUFFER ("selective-display-ellipses",
3171 ¤t_buffer
->selective_display_ellipses
,
3173 "t means display ... on previous line when a line is invisible.\n\
3174 Automatically becomes buffer-local when set in any fashion.");
3177 DEFVAR_PER_BUFFER ("overwrite-mode", ¤t_buffer
->overwrite_mode
, Qnil
,
3178 "Non-nil if self-insertion should replace existing text.\n\
3179 If non-nil and not `overwrite-mode-binary', self-insertion still\n\
3180 inserts at the end of a line, and inserts when point is before a tab,\n\
3181 until the tab is filled in.\n\
3182 If `overwrite-mode-binary', self-insertion replaces newlines and tabs too.\n\
3183 Automatically becomes buffer-local when set in any fashion.");
3185 #if 0 /* The doc string is too long for some compilers,
3186 but make-docfile can find it in this comment. */
3187 DEFVAR_PER_BUFFER ("buffer-display-table", ¤t_buffer
->display_table
,
3189 "Display table that controls display of the contents of current buffer.\n\
3190 Automatically becomes buffer-local when set in any fashion.\n\
3191 The display table is a vector created with `make-display-table'.\n\
3192 The first 256 elements control how to display each possible text character.\n\
3193 Each value should be a vector of characters or nil;\n\
3194 nil means display the character in the default fashion.\n\
3195 The remaining six elements control the display of\n\
3196 the end of a truncated screen line (element 256, a single character);\n\
3197 the end of a continued line (element 257, a single character);\n\
3198 the escape character used to display character codes in octal\n\
3199 (element 258, a single character);\n\
3200 the character used as an arrow for control characters (element 259,\n\
3201 a single character);\n\
3202 the decoration indicating the presence of invisible lines (element 260,\n\
3203 a vector of characters);\n\
3204 the character used to draw the border between side-by-side windows\n\
3205 (element 261, a single character).\n\
3206 If this variable is nil, the value of `standard-display-table' is used.\n\
3207 Each window can have its own, overriding display table.");
3209 DEFVAR_PER_BUFFER ("buffer-display-table", ¤t_buffer
->display_table
,
3212 /*DEFVAR_LISP ("debug-check-symbol", &Vcheck_symbol,
3215 DEFVAR_LISP ("before-change-function", &Vbefore_change_function
,
3216 "Function to call before each text change.\n\
3217 Two arguments are passed to the function: the positions of\n\
3218 the beginning and end of the range of old text to be changed.\n\
3219 \(For an insertion, the beginning and end are at the same place.)\n\
3220 No information is given about the length of the text after the change.\n\
3222 Buffer changes made while executing the `before-change-function'\n\
3223 don't call any before-change or after-change functions.\n\
3224 That's because these variables are temporarily set to nil.\n\
3225 As a result, a hook function cannot straightforwardly alter the value of\n\
3226 these variables. See the Emacs Lisp manual for a way of\n\
3227 accomplishing an equivalent result by using other variables.");
3228 Vbefore_change_function
= Qnil
;
3230 DEFVAR_LISP ("after-change-function", &Vafter_change_function
,
3231 "Function to call after each text change.\n\
3232 Three arguments are passed to the function: the positions of\n\
3233 the beginning and end of the range of changed text,\n\
3234 and the length of the pre-change text replaced by that range.\n\
3235 \(For an insertion, the pre-change length is zero;\n\
3236 for a deletion, that length is the number of characters deleted,\n\
3237 and the post-change beginning and end are at the same place.)\n\
3239 Buffer changes made while executing the `after-change-function'\n\
3240 don't call any before-change or after-change functions.\n\
3241 That's because these variables are temporarily set to nil.\n\
3242 As a result, a hook function cannot straightforwardly alter the value of\n\
3243 these variables. See the Emacs Lisp manual for a way of\n\
3244 accomplishing an equivalent result by using other variables.");
3245 Vafter_change_function
= Qnil
;
3247 DEFVAR_LISP ("before-change-functions", &Vbefore_change_functions
,
3248 "List of functions to call before each text change.\n\
3249 Two arguments are passed to each function: the positions of\n\
3250 the beginning and end of the range of old text to be changed.\n\
3251 \(For an insertion, the beginning and end are at the same place.)\n\
3252 No information is given about the length of the text after the change.\n\
3254 Buffer changes made while executing the `before-change-functions'\n\
3255 don't call any before-change or after-change functions.\n\
3256 That's because these variables are temporarily set to nil.\n\
3257 As a result, a hook function cannot straightforwardly alter the value of\n\
3258 these variables. See the Emacs Lisp manual for a way of\n\
3259 accomplishing an equivalent result by using other variables.");
3260 Vbefore_change_functions
= Qnil
;
3262 DEFVAR_LISP ("after-change-functions", &Vafter_change_functions
,
3263 "List of function to call after each text change.\n\
3264 Three arguments are passed to each function: the positions of\n\
3265 the beginning and end of the range of changed text,\n\
3266 and the length of the pre-change text replaced by that range.\n\
3267 \(For an insertion, the pre-change length is zero;\n\
3268 for a deletion, that length is the number of characters deleted,\n\
3269 and the post-change beginning and end are at the same place.)\n\
3271 Buffer changes made while executing the `after-change-functions'\n\
3272 don't call any before-change or after-change functions.\n\
3273 That's because these variables are temporarily set to nil.\n\
3274 As a result, a hook function cannot straightforwardly alter the value of\n\
3275 these variables. See the Emacs Lisp manual for a way of\n\
3276 accomplishing an equivalent result by using other variables.");
3278 Vafter_change_functions
= Qnil
;
3280 DEFVAR_LISP ("first-change-hook", &Vfirst_change_hook
,
3281 "A list of functions to call before changing a buffer which is unmodified.\n\
3282 The functions are run using the `run-hooks' function.");
3283 Vfirst_change_hook
= Qnil
;
3284 Qfirst_change_hook
= intern ("first-change-hook");
3285 staticpro (&Qfirst_change_hook
);
3287 #if 0 /* The doc string is too long for some compilers,
3288 but make-docfile can find it in this comment. */
3289 DEFVAR_PER_BUFFER ("buffer-undo-list", ¤t_buffer
->undo_list
, Qnil
,
3290 "List of undo entries in current buffer.\n\
3291 Recent changes come first; older changes follow newer.\n\
3293 An entry (START . END) represents an insertion which begins at\n\
3294 position START and ends at position END.\n\
3296 An entry (TEXT . POSITION) represents the deletion of the string TEXT\n\
3297 from (abs POSITION). If POSITION is positive, point was at the front\n\
3298 of the text being deleted; if negative, point was at the end.\n\
3300 An entry (t HIGHWORD LOWWORD) indicates that the buffer had been\n\
3301 previously unmodified. HIGHWORD and LOWWORD are the high and low\n\
3302 16-bit words of the buffer's modification count at the time. If the\n\
3303 modification count of the most recent save is different, this entry is\n\
3306 An entry (nil PROP VAL BEG . END) indicates that a text property\n\
3307 was modified between BEG and END. PROP is the property name,\n\
3308 and VAL is the old value.\n\
3310 An entry of the form POSITION indicates that point was at the buffer\n\
3311 location given by the integer. Undoing an entry of this form places\n\
3312 point at POSITION.\n\
3314 nil marks undo boundaries. The undo command treats the changes\n\
3315 between two undo boundaries as a single step to be undone.\n\
3317 If the value of the variable is t, undo information is not recorded.");
3319 DEFVAR_PER_BUFFER ("buffer-undo-list", ¤t_buffer
->undo_list
, Qnil
,
3322 DEFVAR_PER_BUFFER ("mark-active", ¤t_buffer
->mark_active
, Qnil
,
3323 "Non-nil means the mark and region are currently active in this buffer.\n\
3324 Automatically local in all buffers.");
3326 DEFVAR_PER_BUFFER ("cache-long-line-scans", ¤t_buffer
->cache_long_line_scans
, Qnil
,
3327 "Non-nil means that Emacs should use caches to handle long lines more quickly.\n\
3328 This variable is buffer-local, in all buffers.\n\
3330 Normally, the line-motion functions work by scanning the buffer for\n\
3331 newlines. Columnar operations (like move-to-column and\n\
3332 compute-motion) also work by scanning the buffer, summing character\n\
3333 widths as they go. This works well for ordinary text, but if the\n\
3334 buffer's lines are very long (say, more than 500 characters), these\n\
3335 motion functions will take longer to execute. Emacs may also take\n\
3336 longer to update the display.\n\
3338 If cache-long-line-scans is non-nil, these motion functions cache the\n\
3339 results of their scans, and consult the cache to avoid rescanning\n\
3340 regions of the buffer until the text is modified. The caches are most\n\
3341 beneficial when they prevent the most searching---that is, when the\n\
3342 buffer contains long lines and large regions of characters with the\n\
3343 same, fixed screen width.\n\
3345 When cache-long-line-scans is non-nil, processing short lines will\n\
3346 become slightly slower (because of the overhead of consulting the\n\
3347 cache), and the caches will use memory roughly proportional to the\n\
3348 number of newlines and characters whose screen width varies.\n\
3350 The caches require no explicit maintenance; their accuracy is\n\
3351 maintained internally by the Emacs primitives. Enabling or disabling\n\
3352 the cache should not affect the behavior of any of the motion\n\
3353 functions; it should only affect their performance.");
3355 DEFVAR_LISP ("transient-mark-mode", &Vtransient_mark_mode
,
3356 "*Non-nil means deactivate the mark when the buffer contents change.");
3357 Vtransient_mark_mode
= Qnil
;
3359 DEFVAR_LISP ("inhibit-read-only", &Vinhibit_read_only
,
3360 "*Non-nil means disregard read-only status of buffers or characters.\n\
3361 If the value is t, disregard `buffer-read-only' and all `read-only'\n\
3362 text properties. If the value is a list, disregard `buffer-read-only'\n\
3363 and disregard a `read-only' text property if the property value\n\
3364 is a member of the list.");
3365 Vinhibit_read_only
= Qnil
;
3367 DEFVAR_LISP ("kill-buffer-query-functions", &Vkill_buffer_query_functions
,
3368 "List of functions called with no args to query before killing a buffer.");
3369 Vkill_buffer_query_functions
= Qnil
;
3371 defsubr (&Sbuffer_list
);
3372 defsubr (&Sget_buffer
);
3373 defsubr (&Sget_file_buffer
);
3374 defsubr (&Sget_buffer_create
);
3375 defsubr (&Smake_indirect_buffer
);
3376 defsubr (&Sgenerate_new_buffer_name
);
3377 defsubr (&Sbuffer_name
);
3378 /*defsubr (&Sbuffer_number);*/
3379 defsubr (&Sbuffer_file_name
);
3380 defsubr (&Sbuffer_base_buffer
);
3381 defsubr (&Sbuffer_local_variables
);
3382 defsubr (&Sbuffer_modified_p
);
3383 defsubr (&Sset_buffer_modified_p
);
3384 defsubr (&Sbuffer_modified_tick
);
3385 defsubr (&Srename_buffer
);
3386 defsubr (&Sother_buffer
);
3387 defsubr (&Sbuffer_disable_undo
);
3388 defsubr (&Sbuffer_enable_undo
);
3389 defsubr (&Skill_buffer
);
3390 defsubr (&Serase_buffer
);
3391 defsubr (&Sset_buffer_major_mode
);
3392 defsubr (&Sswitch_to_buffer
);
3393 defsubr (&Spop_to_buffer
);
3394 defsubr (&Scurrent_buffer
);
3395 defsubr (&Sset_buffer
);
3396 defsubr (&Sbarf_if_buffer_read_only
);
3397 defsubr (&Sbury_buffer
);
3398 defsubr (&Slist_buffers
);
3399 defsubr (&Skill_all_local_variables
);
3401 defsubr (&Soverlayp
);
3402 defsubr (&Smake_overlay
);
3403 defsubr (&Sdelete_overlay
);
3404 defsubr (&Smove_overlay
);
3405 defsubr (&Soverlay_start
);
3406 defsubr (&Soverlay_end
);
3407 defsubr (&Soverlay_buffer
);
3408 defsubr (&Soverlay_properties
);
3409 defsubr (&Soverlays_at
);
3410 defsubr (&Snext_overlay_change
);
3411 defsubr (&Sprevious_overlay_change
);
3412 defsubr (&Soverlay_recenter
);
3413 defsubr (&Soverlay_lists
);
3414 defsubr (&Soverlay_get
);
3415 defsubr (&Soverlay_put
);
3420 initial_define_key (control_x_map
, 'b', "switch-to-buffer");
3421 initial_define_key (control_x_map
, 'k', "kill-buffer");
3422 initial_define_key (control_x_map
, Ctl ('B'), "list-buffers");
3424 /* This must not be in syms_of_buffer, because Qdisabled is not
3425 initialized when that function gets called. */
3426 Fput (intern ("erase-buffer"), Qdisabled
, Qt
);