(VALBITS, GCTYPEBITS): Deleted; default is better.
[bpt/emacs.git] / src / buffer.c
1 /* Buffer manipulation primitives for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994
3 Free Software Foundation, Inc.
4
5 This file is part of GNU Emacs.
6
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
11
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.
16
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. */
20
21
22 #include <sys/types.h>
23 #include <sys/stat.h>
24 #include <sys/param.h>
25
26 #ifndef MAXPATHLEN
27 /* in 4.1, param.h fails to define this. */
28 #define MAXPATHLEN 1024
29 #endif /* not MAXPATHLEN */
30
31 #include <config.h>
32 #include "lisp.h"
33 #include "intervals.h"
34 #include "window.h"
35 #include "commands.h"
36 #include "buffer.h"
37 #include "region-cache.h"
38 #include "indent.h"
39 #include "blockinput.h"
40
41 struct buffer *current_buffer; /* the current buffer */
42
43 /* First buffer in chain of all buffers (in reverse order of creation).
44 Threaded through ->next. */
45
46 struct buffer *all_buffers;
47
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. */
54
55 struct buffer buffer_defaults;
56
57 /* A Lisp_Object pointer to the above, used for staticpro */
58
59 static Lisp_Object Vbuffer_defaults;
60
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.
65
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.
69
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.
73
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.
76
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.
80
81 If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is
82 zero, that is a bug */
83
84 struct buffer buffer_local_flags;
85
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. */
88
89 struct buffer buffer_local_symbols;
90 /* A Lisp_Object pointer to the above, used for staticpro */
91 static Lisp_Object Vbuffer_local_symbols;
92
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;
100
101 Lisp_Object Fset_buffer ();
102 void set_buffer_internal ();
103 static void call_overlay_mod_hooks ();
104
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;
109
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;
115
116 Lisp_Object Vtransient_mark_mode;
117
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;
122
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;
126
127 /* List of functions to call before changing an unmodified buffer. */
128 Lisp_Object Vfirst_change_hook;
129 Lisp_Object Qfirst_change_hook;
130
131 Lisp_Object Qfundamental_mode, Qmode_class, Qpermanent_local;
132
133 Lisp_Object Qprotected_field;
134
135 Lisp_Object QSFundamental; /* A string "Fundamental" */
136
137 Lisp_Object Qkill_buffer_hook;
138
139 Lisp_Object Qget_file_buffer;
140
141 Lisp_Object Qoverlayp;
142
143 Lisp_Object Qpriority, Qwindow, Qevaporate;
144
145 Lisp_Object Qmodification_hooks;
146 Lisp_Object Qinsert_in_front_hooks;
147 Lisp_Object Qinsert_behind_hooks;
148
149 /* For debugging; temporary. See set_buffer_internal. */
150 /* Lisp_Object Qlisp_mode, Vcheck_symbol; */
151
152 nsberror (spec)
153 Lisp_Object spec;
154 {
155 if (STRINGP (spec))
156 error ("No buffer named %s", XSTRING (spec)->data);
157 error ("Invalid buffer argument");
158 }
159 \f
160 DEFUN ("buffer-list", Fbuffer_list, Sbuffer_list, 0, 0, 0,
161 "Return a list of all existing live buffers.")
162 ()
163 {
164 return Fmapcar (Qcdr, Vbuffer_alist);
165 }
166
167 /* Like Fassoc, but use Fstring_equal to compare
168 (which ignores text properties),
169 and don't ever QUIT. */
170
171 static Lisp_Object
172 assoc_ignore_text_properties (key, list)
173 register Lisp_Object key;
174 Lisp_Object list;
175 {
176 register Lisp_Object tail;
177 for (tail = list; !NILP (tail); tail = Fcdr (tail))
178 {
179 register Lisp_Object elt, tem;
180 elt = Fcar (tail);
181 tem = Fstring_equal (Fcar (elt), key);
182 if (!NILP (tem))
183 return elt;
184 }
185 return Qnil;
186 }
187
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.")
192 (name)
193 register Lisp_Object name;
194 {
195 if (BUFFERP (name))
196 return name;
197 CHECK_STRING (name, 0);
198
199 return Fcdr (assoc_ignore_text_properties (name, Vbuffer_alist));
200 }
201
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'.")
207 (filename)
208 register Lisp_Object filename;
209 {
210 register Lisp_Object tail, buf, tem;
211 Lisp_Object handler;
212
213 CHECK_STRING (filename, 0);
214 filename = Fexpand_file_name (filename, Qnil);
215
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);
219 if (!NILP (handler))
220 return call2 (handler, Qget_file_buffer, filename);
221
222 for (tail = Vbuffer_alist; CONSP (tail); tail = XCONS (tail)->cdr)
223 {
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);
228 if (!NILP (tem))
229 return buf;
230 }
231 return Qnil;
232 }
233
234 /* Incremented for each buffer created, to assign the buffer number. */
235 int buffer_count;
236
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.")
243 (name)
244 register Lisp_Object name;
245 {
246 register Lisp_Object buf;
247 register struct buffer *b;
248
249 buf = Fget_buffer (name);
250 if (!NILP (buf))
251 return buf;
252
253 if (XSTRING (name)->size == 0)
254 error ("Empty string for buffer name is not allowed");
255
256 b = (struct buffer *) xmalloc (sizeof (struct buffer));
257
258 b->size = sizeof (struct buffer) / sizeof (EMACS_INT);
259
260 /* An ordinary buffer uses its own struct buffer_text. */
261 b->text = &b->own_text;
262 b->base_buffer = 0;
263
264 BUF_GAP_SIZE (b) = 20;
265 BLOCK_INPUT;
266 BUFFER_ALLOC (BUF_BEG_ADDR (b), BUF_GAP_SIZE (b));
267 UNBLOCK_INPUT;
268 if (! BUF_BEG_ADDR (b))
269 memory_full ();
270
271 BUF_PT (b) = 1;
272 BUF_GPT (b) = 1;
273 BUF_BEGV (b) = 1;
274 BUF_ZV (b) = 1;
275 BUF_Z (b) = 1;
276 BUF_MODIFF (b) = 1;
277 BUF_SAVE_MODIFF (b) = 1;
278 BUF_INTERVALS (b) = 0;
279
280 b->newline_cache = 0;
281 b->width_run_cache = 0;
282 b->width_table = Qnil;
283
284 /* Put this on the chain of all buffers including killed ones. */
285 b->next = all_buffers;
286 all_buffers = b;
287
288 /* An ordinary buffer normally doesn't need markers
289 to handle BEGV and ZV. */
290 b->pt_marker = Qnil;
291 b->begv_marker = Qnil;
292 b->zv_marker = Qnil;
293
294 name = Fcopy_sequence (name);
295 INITIALIZE_INTERVAL (XSTRING (name), NULL_INTERVAL);
296 b->name = name;
297
298 if (XSTRING (name)->data[0] != ' ')
299 b->undo_list = Qnil;
300 else
301 b->undo_list = Qt;
302
303 reset_buffer (b);
304 reset_buffer_local_variables (b);
305
306 /* Put this in the alist of all live buffers. */
307 XSETBUFFER (buf, b);
308 Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));
309
310 b->mark = Fmake_marker ();
311 BUF_MARKERS (b) = Qnil;
312 b->name = name;
313 return buf;
314 }
315
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).")
321 (name, base_buffer)
322 register Lisp_Object name, base_buffer;
323 {
324 register Lisp_Object buf;
325 register struct buffer *b;
326
327 buf = Fget_buffer (name);
328 if (!NILP (buf))
329 error ("Buffer name `%s' is in use", XSTRING (name)->data);
330
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);
335
336 if (XSTRING (name)->size == 0)
337 error ("Empty string for buffer name is not allowed");
338
339 b = (struct buffer *) xmalloc (sizeof (struct buffer));
340
341 b->size = sizeof (struct buffer) / sizeof (EMACS_INT);
342
343 if (XBUFFER (base_buffer)->base_buffer)
344 b->base_buffer = XBUFFER (base_buffer)->base_buffer;
345 else
346 b->base_buffer = XBUFFER (base_buffer);
347
348 /* Use the base buffer's text object. */
349 b->text = b->base_buffer->text;
350
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);
354
355 b->newline_cache = 0;
356 b->width_run_cache = 0;
357 b->width_table = Qnil;
358
359 /* Put this on the chain of all buffers including killed ones. */
360 b->next = all_buffers;
361 all_buffers = b;
362
363 name = Fcopy_sequence (name);
364 INITIALIZE_INTERVAL (XSTRING (name), NULL_INTERVAL);
365 b->name = name;
366
367 reset_buffer (b);
368 reset_buffer_local_variables (b);
369
370 /* Put this in the alist of all live buffers. */
371 XSETBUFFER (buf, b);
372 Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));
373
374 b->mark = Fmake_marker ();
375 b->name = name;
376
377 /* Make sure the base buffer has markers for its narrowing. */
378 if (NILP (b->base_buffer->pt_marker))
379 {
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);
383 }
384 if (NILP (b->base_buffer->begv_marker))
385 {
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);
389 }
390 if (NILP (b->base_buffer->zv_marker))
391 {
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);
395 }
396
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 ();
401
402 return buf;
403 }
404
405 /* Reinitialize everything about a buffer except its name and contents
406 and local variables. */
407
408 void
409 reset_buffer (b)
410 register struct buffer *b;
411 {
412 b->filename = Qnil;
413 b->directory = (current_buffer) ? current_buffer->directory : Qnil;
414 b->modtime = 0;
415 XSETFASTINT (b->save_length, 0);
416 b->last_window_start = 1;
417 b->backed_up = Qnil;
418 b->auto_save_modified = 0;
419 b->auto_save_failure_time = -1;
420 b->auto_save_file_name = Qnil;
421 b->read_only = Qnil;
422 b->overlays_before = Qnil;
423 b->overlays_after = Qnil;
424 XSETFASTINT (b->overlay_center, 1);
425 b->mark_active = Qnil;
426 }
427
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. */
432
433 reset_buffer_local_variables (b)
434 register struct buffer *b;
435 {
436 register int offset;
437
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;
443 b->keymap = Qnil;
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;
452 #if 0
453 b->sort_table = XSTRING (Vascii_sort_table);
454 b->folding_sort_table = XSTRING (Vascii_folding_sort_table);
455 #endif /* 0 */
456
457 /* Reset all per-buffer variables to their defaults. */
458 b->local_var_alist = Qnil;
459 b->local_var_flags = 0;
460
461 /* For each slot that has a default value,
462 copy that into the slot. */
463
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 */
467 {
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);
472 }
473 }
474
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. */
478
479 DEFUN ("generate-new-buffer-name", Fgenerate_new_buffer_name, Sgenerate_new_buffer_name,
480 1, 2, 0,
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.")
488 (name, ignore)
489 register Lisp_Object name, ignore;
490 {
491 register Lisp_Object gentemp, tem;
492 int count;
493 char number[10];
494
495 CHECK_STRING (name, 0);
496
497 tem = Fget_buffer (name);
498 if (NILP (tem))
499 return name;
500
501 count = 1;
502 while (1)
503 {
504 sprintf (number, "<%d>", ++count);
505 gentemp = concat2 (name, build_string (number));
506 tem = Fstring_equal (gentemp, ignore);
507 if (!NILP (tem))
508 return gentemp;
509 tem = Fget_buffer (gentemp);
510 if (NILP (tem))
511 return gentemp;
512 }
513 }
514
515 \f
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.")
519 (buffer)
520 register Lisp_Object buffer;
521 {
522 if (NILP (buffer))
523 return current_buffer->name;
524 CHECK_BUFFER (buffer, 0);
525 return XBUFFER (buffer)->name;
526 }
527
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.")
531 (buffer)
532 register Lisp_Object buffer;
533 {
534 if (NILP (buffer))
535 return current_buffer->filename;
536 CHECK_BUFFER (buffer, 0);
537 return XBUFFER (buffer)->filename;
538 }
539
540 DEFUN ("buffer-base-buffer", Fbuffer_base_buffer, Sbuffer_base_buffer,
541 0, 1, 0,
542 "Return the base buffer of indirect buffer BUFFER.\n\
543 If BUFFER is not indirect, return nil.")
544 (buffer)
545 register Lisp_Object buffer;
546 {
547 struct buffer *base;
548 Lisp_Object base_buffer;
549
550 if (NILP (buffer))
551 base = current_buffer->base_buffer;
552 else
553 {
554 CHECK_BUFFER (buffer, 0);
555 base = XBUFFER (buffer)->base_buffer;
556 }
557
558 if (! base)
559 return Qnil;
560 XSETBUFFER (base_buffer, base);
561 return base_buffer;
562 }
563
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.")
571 (buffer)
572 register Lisp_Object buffer;
573 {
574 register struct buffer *buf;
575 register Lisp_Object result;
576
577 if (NILP (buffer))
578 buf = current_buffer;
579 else
580 {
581 CHECK_BUFFER (buffer, 0);
582 buf = XBUFFER (buffer);
583 }
584
585 result = Qnil;
586
587 {
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)
595 {
596 Lisp_Object val, elt;
597
598 elt = XCONS (tail)->car;
599
600 if (buf == current_buffer)
601 val = find_symbol_value (XCONS (elt)->car);
602 else
603 val = XCONS (elt)->cdr;
604
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. */
609 else
610 result = Fcons (Fcons (XCONS (elt)->car, val), result);
611 }
612 }
613
614 /* Add on all the variables stored in special slots. */
615 {
616 register int offset, mask;
617
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 */
621 {
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)),
629 result);
630 }
631 }
632
633 return result;
634 }
635
636 \f
637 DEFUN ("buffer-modified-p", Fbuffer_modified_p, Sbuffer_modified_p,
638 0, 1, 0,
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.")
641 (buffer)
642 register Lisp_Object buffer;
643 {
644 register struct buffer *buf;
645 if (NILP (buffer))
646 buf = current_buffer;
647 else
648 {
649 CHECK_BUFFER (buffer, 0);
650 buf = XBUFFER (buffer);
651 }
652
653 return BUF_SAVE_MODIFF (buf) < BUF_MODIFF (buf) ? Qt : Qnil;
654 }
655
656 DEFUN ("set-buffer-modified-p", Fset_buffer_modified_p, Sset_buffer_modified_p,
657 1, 1, 0,
658 "Mark current buffer as modified or unmodified according to FLAG.\n\
659 A non-nil FLAG means mark the buffer modified.")
660 (flag)
661 register Lisp_Object flag;
662 {
663 register int already;
664 register Lisp_Object fn;
665
666 #ifdef CLASH_DETECTION
667 /* If buffer becoming modified, lock the file.
668 If buffer becoming unmodified, unlock the file. */
669
670 fn = current_buffer->filename;
671 if (!NILP (fn))
672 {
673 already = SAVE_MODIFF < MODIFF;
674 if (!already && !NILP (flag))
675 lock_file (fn);
676 else if (already && NILP (flag))
677 unlock_file (fn);
678 }
679 #endif /* CLASH_DETECTION */
680
681 SAVE_MODIFF = NILP (flag) ? MODIFF : 0;
682 update_mode_lines++;
683 return flag;
684 }
685
686 DEFUN ("buffer-modified-tick", Fbuffer_modified_tick, Sbuffer_modified_tick,
687 0, 1, 0,
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.")
692 (buffer)
693 register Lisp_Object buffer;
694 {
695 register struct buffer *buf;
696 if (NILP (buffer))
697 buf = current_buffer;
698 else
699 {
700 CHECK_BUFFER (buffer, 0);
701 buf = XBUFFER (buffer);
702 }
703
704 return make_number (BUF_MODIFF (buf));
705 }
706 \f
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).")
717 (newname, unique)
718 register Lisp_Object newname, unique;
719 {
720 register Lisp_Object tem, buf;
721
722 CHECK_STRING (newname, 0);
723
724 if (XSTRING (newname)->size == 0)
725 error ("Empty string is invalid as a buffer name");
726
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;
734 if (!NILP (tem))
735 {
736 if (!NILP (unique))
737 newname = Fgenerate_new_buffer_name (newname, current_buffer->name);
738 else
739 error ("Buffer name `%s' is in use", XSTRING (newname)->data);
740 }
741
742 current_buffer->name = newname;
743
744 /* Catch redisplay's attention. Unless we do this, the mode lines for
745 any windows displaying current_buffer will stay unchanged. */
746 update_mode_lines++;
747
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;
755 }
756
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.")
763 (buffer, visible_ok)
764 register Lisp_Object buffer, visible_ok;
765 {
766 register Lisp_Object tail, buf, notsogood, tem;
767 notsogood = Qnil;
768
769 for (tail = Vbuffer_alist; !NILP (tail); tail = Fcdr (tail))
770 {
771 buf = Fcdr (Fcar (tail));
772 if (EQ (buf, buffer))
773 continue;
774 if (XSTRING (XBUFFER (buf)->name)->data[0] == ' ')
775 continue;
776 #ifdef MULTI_FRAME
777 /* If the selected frame has a buffer_predicate,
778 disregard buffers that don't fit the predicate. */
779 tem = frame_buffer_predicate ();
780 if (!NILP (tem))
781 {
782 tem = call1 (tem, buf);
783 if (NILP (tem))
784 continue;
785 }
786 #endif
787
788 if (NILP (visible_ok))
789 tem = Fget_buffer_window (buf, Qt);
790 else
791 tem = Qnil;
792 if (NILP (tem))
793 return buf;
794 if (NILP (notsogood))
795 notsogood = buf;
796 }
797 if (!NILP (notsogood))
798 return notsogood;
799 return Fget_buffer_create (build_string ("*scratch*"));
800 }
801 \f
802 DEFUN ("buffer-disable-undo", Fbuffer_disable_undo, Sbuffer_disable_undo, 0, 1,
803 0,
804 "Make BUFFER stop keeping undo information.\n\
805 No argument or nil as argument means do this for the current buffer.")
806 (buffer)
807 register Lisp_Object buffer;
808 {
809 Lisp_Object real_buffer;
810
811 if (NILP (buffer))
812 XSETBUFFER (real_buffer, current_buffer);
813 else
814 {
815 real_buffer = Fget_buffer (buffer);
816 if (NILP (real_buffer))
817 nsberror (buffer);
818 }
819
820 XBUFFER (real_buffer)->undo_list = Qt;
821
822 return Qnil;
823 }
824
825 DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, Sbuffer_enable_undo,
826 0, 1, "",
827 "Start keeping undo information for buffer BUFFER.\n\
828 No argument or nil as argument means do this for the current buffer.")
829 (buffer)
830 register Lisp_Object buffer;
831 {
832 Lisp_Object real_buffer;
833
834 if (NILP (buffer))
835 XSETBUFFER (real_buffer, current_buffer);
836 else
837 {
838 real_buffer = Fget_buffer (buffer);
839 if (NILP (real_buffer))
840 nsberror (buffer);
841 }
842
843 if (EQ (XBUFFER (real_buffer)->undo_list, Qt))
844 XBUFFER (real_buffer)->undo_list = Qnil;
845
846 return Qnil;
847 }
848
849 /*
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\
853 See `kill-buffer'."
854 */
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'.")
866 (bufname)
867 Lisp_Object bufname;
868 {
869 Lisp_Object buf;
870 register struct buffer *b;
871 register Lisp_Object tem;
872 register struct Lisp_Marker *m;
873 struct gcpro gcpro1, gcpro2;
874
875 if (NILP (bufname))
876 buf = Fcurrent_buffer ();
877 else
878 buf = Fget_buffer (bufname);
879 if (NILP (buf))
880 nsberror (bufname);
881
882 b = XBUFFER (buf);
883
884 /* Query if the buffer is still modified. */
885 if (INTERACTIVE && !NILP (b->filename)
886 && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b))
887 {
888 GCPRO2 (buf, bufname);
889 tem = do_yes_or_no_p (format1 ("Buffer %s modified; kill anyway? ",
890 XSTRING (b->name)->data));
891 UNGCPRO;
892 if (NILP (tem))
893 return Qnil;
894 }
895
896 /* Run hooks with the buffer to be killed the current buffer. */
897 {
898 register Lisp_Object val;
899 int count = specpdl_ptr - specpdl;
900 Lisp_Object list;
901
902 record_unwind_protect (save_excursion_restore, save_excursion_save ());
903 set_buffer_internal (b);
904
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))
908 {
909 tem = call0 (Fcar (list));
910 if (NILP (tem))
911 return unbind_to (count, Qnil);
912 }
913
914 /* Then run the hooks. */
915 if (!NILP (Vrun_hooks))
916 call1 (Vrun_hooks, Qkill_buffer_hook);
917 unbind_to (count, Qnil);
918 }
919
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. */
923
924 /* Don't kill the minibuffer now current. */
925 if (EQ (buf, XWINDOW (minibuf_window)->buffer))
926 return Qnil;
927
928 if (NILP (b->name))
929 return Qnil;
930
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)
935 {
936 struct buffer *other;
937
938 GCPRO1 (buf);
939
940 for (other = all_buffers; other; other = other->next)
941 if (other->base_buffer == b)
942 {
943 Lisp_Object buf;
944 XSETBUFFER (buf, other);
945 Fkill_buffer (buf);
946 }
947
948 UNGCPRO;
949 }
950
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)
955 {
956 tem = Fother_buffer (buf, Qnil);
957 Fset_buffer (tem);
958 if (b == current_buffer)
959 return Qnil;
960 }
961
962 /* Now there is no question: we can kill the buffer. */
963
964 #ifdef CLASH_DETECTION
965 /* Unlock this buffer's file, if it is locked. */
966 unlock_buffer (b);
967 #endif /* CLASH_DETECTION */
968
969 kill_buffer_processes (buf);
970
971 tem = Vinhibit_quit;
972 Vinhibit_quit = Qt;
973 Vbuffer_alist = Fdelq (Frassq (buf, Vbuffer_alist), Vbuffer_alist);
974 Freplace_buffer_in_windows (buf);
975 Vinhibit_quit = tem;
976
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)
980 {
981 Lisp_Object tem;
982 tem = Fsymbol_value (intern ("delete-auto-save-files"));
983 if (! NILP (tem))
984 internal_delete_file (b->auto_save_file_name);
985 }
986
987 if (! b->base_buffer)
988 {
989 /* Unchain all markers of this buffer
990 and leave them pointing nowhere. */
991 for (tem = BUF_MARKERS (b); !EQ (tem, Qnil); )
992 {
993 m = XMARKER (tem);
994 m->buffer = 0;
995 tem = m->chain;
996 m->chain = Qnil;
997 }
998 BUF_MARKERS (b) = Qnil;
999
1000 #ifdef USE_TEXT_PROPERTIES
1001 BUF_INTERVALS (b) = NULL_INTERVAL;
1002 #endif
1003
1004 /* Perhaps we should explicitly free the interval tree here... */
1005 }
1006
1007 b->name = Qnil;
1008
1009 BLOCK_INPUT;
1010 if (! b->base_buffer)
1011 BUFFER_FREE (BUF_BEG_ADDR (b));
1012
1013 if (b->newline_cache)
1014 {
1015 free_region_cache (b->newline_cache);
1016 b->newline_cache = 0;
1017 }
1018 if (b->width_run_cache)
1019 {
1020 free_region_cache (b->width_run_cache);
1021 b->width_run_cache = 0;
1022 }
1023 b->width_table = Qnil;
1024 UNBLOCK_INPUT;
1025 b->undo_list = Qnil;
1026
1027 return Qt;
1028 }
1029 \f
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. */
1034
1035 record_buffer (buf)
1036 Lisp_Object buf;
1037 {
1038 register Lisp_Object link, prev;
1039
1040 prev = Qnil;
1041 for (link = Vbuffer_alist; CONSP (link); link = XCONS (link)->cdr)
1042 {
1043 if (EQ (XCONS (XCONS (link)->car)->cdr, buf))
1044 break;
1045 prev = link;
1046 }
1047
1048 /* Effectively do Vbuffer_alist = Fdelq (link, Vbuffer_alist);
1049 we cannot use Fdelq itself here because it allows quitting. */
1050
1051 if (NILP (prev))
1052 Vbuffer_alist = XCONS (Vbuffer_alist)->cdr;
1053 else
1054 XCONS (prev)->cdr = XCONS (XCONS (prev)->cdr)->cdr;
1055
1056 XCONS(link)->cdr = Vbuffer_alist;
1057 Vbuffer_alist = link;
1058 }
1059
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.")
1064 (buf)
1065 Lisp_Object buf;
1066 {
1067 int count;
1068 Lisp_Object function;
1069
1070 function = buffer_defaults.major_mode;
1071 if (NILP (function) && NILP (Fget (current_buffer->major_mode, Qmode_class)))
1072 function = current_buffer->major_mode;
1073
1074 if (NILP (function) || EQ (function, Qfundamental_mode))
1075 return Qnil;
1076
1077 count = specpdl_ptr - specpdl;
1078
1079 /* To select a nonfundamental mode,
1080 select the buffer temporarily and then call the mode function. */
1081
1082 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1083
1084 Fset_buffer (buf);
1085 call0 (function);
1086
1087 return unbind_to (count, Qnil);
1088 }
1089
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\
1095 \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.")
1099 (bufname, norecord)
1100 Lisp_Object bufname, norecord;
1101 {
1102 register Lisp_Object buf;
1103 Lisp_Object tem;
1104
1105 if (EQ (minibuf_window, selected_window))
1106 error ("Cannot switch buffers in minibuffer window");
1107 tem = Fwindow_dedicated_p (selected_window);
1108 if (!NILP (tem))
1109 error ("Cannot switch buffers in a dedicated window");
1110
1111 if (NILP (bufname))
1112 buf = Fother_buffer (Fcurrent_buffer (), Qnil);
1113 else
1114 {
1115 buf = Fget_buffer (bufname);
1116 if (NILP (buf))
1117 {
1118 buf = Fget_buffer_create (bufname);
1119 Fset_buffer_major_mode (buf);
1120 }
1121 }
1122 Fset_buffer (buf);
1123 if (NILP (norecord))
1124 record_buffer (buf);
1125
1126 Fset_window_buffer (EQ (selected_window, minibuf_window)
1127 ? Fnext_window (minibuf_window, Qnil, Qnil)
1128 : selected_window,
1129 buf);
1130
1131 return buf;
1132 }
1133
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.")
1140 (bufname, other)
1141 Lisp_Object bufname, other;
1142 {
1143 register Lisp_Object buf;
1144 if (NILP (bufname))
1145 buf = Fother_buffer (Fcurrent_buffer (), Qnil);
1146 else
1147 buf = Fget_buffer_create (bufname);
1148 Fset_buffer (buf);
1149 record_buffer (buf);
1150 Fselect_window (Fdisplay_buffer (buf, other));
1151 return buf;
1152 }
1153
1154 DEFUN ("current-buffer", Fcurrent_buffer, Scurrent_buffer, 0, 0, 0,
1155 "Return the current buffer as a Lisp object.")
1156 ()
1157 {
1158 register Lisp_Object buf;
1159 XSETBUFFER (buf, current_buffer);
1160 return buf;
1161 }
1162 \f
1163 /* Set the current buffer to b */
1164
1165 void
1166 set_buffer_internal (b)
1167 register struct buffer *b;
1168 {
1169 register struct buffer *old_buf;
1170 register Lisp_Object tail, valcontents;
1171 Lisp_Object tem;
1172
1173 if (current_buffer == b)
1174 return;
1175
1176 windows_or_buffers_changed = 1;
1177 old_buf = current_buffer;
1178 current_buffer = b;
1179 last_known_column_point = -1; /* invalidate indentation cache */
1180
1181 if (old_buf)
1182 {
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;
1187
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))
1191 {
1192 Lisp_Object obuf;
1193 XSETBUFFER (obuf, old_buf);
1194 Fset_marker (old_buf->pt_marker, BUF_PT (old_buf), obuf);
1195 }
1196 if (! NILP (old_buf->begv_marker))
1197 {
1198 Lisp_Object obuf;
1199 XSETBUFFER (obuf, old_buf);
1200 Fset_marker (old_buf->begv_marker, BUF_BEGV (old_buf), obuf);
1201 }
1202 if (! NILP (old_buf->zv_marker))
1203 {
1204 Lisp_Object obuf;
1205 XSETBUFFER (obuf, old_buf);
1206 Fset_marker (old_buf->zv_marker, BUF_ZV (old_buf), obuf);
1207 }
1208 }
1209
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. */
1212 if (b->base_buffer)
1213 b->undo_list = b->base_buffer->undo_list;
1214
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);
1223
1224 /* Look down buffer's list of local Lisp variables
1225 to find and update any that forward into C variables. */
1226
1227 for (tail = b->local_var_alist; !NILP (tail); tail = XCONS (tail)->cdr)
1228 {
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);
1237 }
1238
1239 /* Do the same with any others that were local to the previous buffer */
1240
1241 if (old_buf)
1242 for (tail = old_buf->local_var_alist; !NILP (tail); tail = XCONS (tail)->cdr)
1243 {
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);
1252 }
1253 }
1254
1255 /* Switch to buffer B temporarily for redisplay purposes.
1256 This avoids certain things thatdon't need to be done within redisplay. */
1257
1258 void
1259 set_buffer_temp (b)
1260 struct buffer *b;
1261 {
1262 register struct buffer *old_buf;
1263
1264 if (current_buffer == b)
1265 return;
1266
1267 old_buf = current_buffer;
1268 current_buffer = b;
1269
1270 if (old_buf)
1271 {
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))
1275 {
1276 Lisp_Object obuf;
1277 XSETBUFFER (obuf, old_buf);
1278 Fset_marker (old_buf->pt_marker, BUF_PT (old_buf), obuf);
1279 }
1280 if (! NILP (old_buf->begv_marker))
1281 {
1282 Lisp_Object obuf;
1283 XSETBUFFER (obuf, old_buf);
1284 Fset_marker (old_buf->begv_marker, BUF_BEGV (old_buf), obuf);
1285 }
1286 if (! NILP (old_buf->zv_marker))
1287 {
1288 Lisp_Object obuf;
1289 XSETBUFFER (obuf, old_buf);
1290 Fset_marker (old_buf->zv_marker, BUF_ZV (old_buf), obuf);
1291 }
1292 }
1293
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);
1302 }
1303
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.")
1311 (bufname)
1312 register Lisp_Object bufname;
1313 {
1314 register Lisp_Object buffer;
1315 buffer = Fget_buffer (bufname);
1316 if (NILP (buffer))
1317 nsberror (bufname);
1318 if (NILP (XBUFFER (buffer)->name))
1319 error ("Selecting deleted buffer");
1320 set_buffer_internal (XBUFFER (buffer));
1321 return buffer;
1322 }
1323 \f
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.")
1327 ()
1328 {
1329 if (!NILP (current_buffer->read_only)
1330 && NILP (Vinhibit_read_only))
1331 Fsignal (Qbuffer_read_only, (Fcons (Fcurrent_buffer (), Qnil)));
1332 return Qnil;
1333 }
1334
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.")
1342 (buf)
1343 register Lisp_Object buf;
1344 {
1345 /* Figure out what buffer we're going to bury. */
1346 if (NILP (buf))
1347 {
1348 XSETBUFFER (buf, current_buffer);
1349
1350 /* If we're burying the current buffer, unshow it. */
1351 Fswitch_to_buffer (Fother_buffer (buf, Qnil), Qnil);
1352 }
1353 else
1354 {
1355 Lisp_Object buf1;
1356
1357 buf1 = Fget_buffer (buf);
1358 if (NILP (buf1))
1359 nsberror (buf);
1360 buf = buf1;
1361 }
1362
1363 /* Move buf to the end of the buffer list. */
1364 {
1365 register Lisp_Object aelt, link;
1366
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);
1372 }
1373
1374 return Qnil;
1375 }
1376 \f
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.")
1381 ()
1382 {
1383 Fwiden ();
1384 del_range (BEG, Z);
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);
1390 return Qnil;
1391 }
1392
1393 validate_region (b, e)
1394 register Lisp_Object *b, *e;
1395 {
1396 CHECK_NUMBER_COERCE_MARKER (*b, 0);
1397 CHECK_NUMBER_COERCE_MARKER (*e, 1);
1398
1399 if (XINT (*b) > XINT (*e))
1400 {
1401 Lisp_Object tem;
1402 tem = *b; *b = *e; *e = tem;
1403 }
1404
1405 if (!(BEGV <= XINT (*b) && XINT (*b) <= XINT (*e)
1406 && XINT (*e) <= ZV))
1407 args_out_of_range (*b, *e);
1408 }
1409 \f
1410 static Lisp_Object
1411 list_buffers_1 (files)
1412 Lisp_Object files;
1413 {
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;
1419
1420 desired_point = Qnil;
1421 other_file_symbol = intern ("list-buffers-directory");
1422
1423 XSETFASTINT (col1, 17);
1424 XSETFASTINT (col2, 28);
1425 XSETFASTINT (col3, 40);
1426 XSETFASTINT (minspace, 1);
1427
1428 Fset_buffer (Vstandard_output);
1429 Fbuffer_disable_undo (Vstandard_output);
1430 current_buffer->read_only = Qnil;
1431
1432 write_string ("\
1433 MR Buffer Size Mode File\n\
1434 -- ------ ---- ---- ----\n", -1);
1435
1436 for (tail = Vbuffer_alist; !NILP (tail); tail = Fcdr (tail))
1437 {
1438 buf = Fcdr (Fcar (tail));
1439 b = XBUFFER (buf);
1440 /* Don't mention the minibuffers. */
1441 if (XSTRING (b->name)->data[0] == ' ')
1442 continue;
1443 /* Optionally don't mention buffers that lack files. */
1444 if (!NILP (files) && NILP (b->filename))
1445 continue;
1446 /* Identify the current buffer. */
1447 if (b == old)
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))
1456 ? " " : "% ", -1);
1457 Fprinc (b->name, Qnil);
1458 tem = Findent_to (col1, make_number (2));
1459 {
1460 char sizebuf[9];
1461 int i;
1462 char *p;
1463
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. */
1469 p = sizebuf;
1470 while (i > 0)
1471 {
1472 if (*p == ' ')
1473 p++;
1474 i--;
1475 }
1476
1477 write_string (p, -1);
1478 }
1479 Findent_to (col2, minspace);
1480 Fprinc (b->mode_name, Qnil);
1481 Findent_to (col3, minspace);
1482
1483 if (!NILP (b->filename))
1484 Fprinc (b->filename, Qnil);
1485 else
1486 {
1487 /* No visited file; check local value of list-buffers-directory. */
1488 Lisp_Object tem;
1489 set_buffer_internal (b);
1490 tem = Fboundp (other_file_symbol);
1491 if (!NILP (tem))
1492 {
1493 tem = Fsymbol_value (other_file_symbol);
1494 Fset_buffer (Vstandard_output);
1495 if (STRINGP (tem))
1496 Fprinc (tem, Qnil);
1497 }
1498 else
1499 Fset_buffer (Vstandard_output);
1500 }
1501 write_string ("\n", -1);
1502 }
1503
1504 tail = intern ("Buffer-menu-mode");
1505 if ((tem = Ffboundp (tail), !NILP (tem)))
1506 call0 (tail);
1507 set_buffer_internal (old);
1508 return desired_point;
1509 }
1510
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\
1516 \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.")
1519 (files)
1520 Lisp_Object files;
1521 {
1522 Lisp_Object desired_point;
1523
1524 desired_point
1525 = internal_with_output_to_temp_buffer ("*Buffer List*",
1526 list_buffers_1, files);
1527
1528 if (NUMBERP (desired_point))
1529 {
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);
1535 }
1536 return Qnil;
1537 }
1538
1539 DEFUN ("kill-all-local-variables", Fkill_all_local_variables, Skill_all_local_variables,
1540 0, 0, 0,
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\
1547 \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\
1552 \n\
1553 The first thing this function does is run\n\
1554 the normal hook `change-major-mode-hook'.")
1555 ()
1556 {
1557 register Lisp_Object alist, sym, tem;
1558 Lisp_Object oalist;
1559
1560 if (!NILP (Vrun_hooks))
1561 call1 (Vrun_hooks, intern ("change-major-mode-hook"));
1562 oalist = current_buffer->local_var_alist;
1563
1564 /* Make sure no local variables remain set up with this buffer
1565 for their current values. */
1566
1567 for (alist = oalist; !NILP (alist); alist = XCONS (alist)->cdr)
1568 {
1569 sym = XCONS (XCONS (alist)->car)->car;
1570
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)
1574 {
1575 /* Symbol is set up for this buffer's old local value.
1576 Set it up for the current buffer with the default value. */
1577
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,
1592 XCONS (tem)->cdr);
1593 }
1594 }
1595
1596 /* Actually eliminate all local bindings of this buffer. */
1597
1598 reset_buffer_local_variables (current_buffer);
1599
1600 /* Redisplay mode lines; we are changing major mode. */
1601
1602 update_mode_lines++;
1603
1604 /* Any which are supposed to be permanent,
1605 make local again, with the same values they had. */
1606
1607 for (alist = oalist; !NILP (alist); alist = XCONS (alist)->cdr)
1608 {
1609 sym = XCONS (XCONS (alist)->car)->car;
1610 tem = Fget (sym, Qpermanent_local);
1611 if (! NILP (tem))
1612 {
1613 Fmake_local_variable (sym);
1614 Fset (sym, XCONS (XCONS (alist)->car)->cdr);
1615 }
1616 }
1617
1618 /* Force mode-line redisplay. Useful here because all major mode
1619 commands call this function. */
1620 update_mode_lines++;
1621
1622 return Qnil;
1623 }
1624 \f
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.
1633
1634 *VEC_PTR and *LEN_PTR should contain a valid vector and size
1635 when this function is called.
1636
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. */
1641
1642 int
1643 overlays_at (pos, extend, vec_ptr, len_ptr, next_ptr, prev_ptr)
1644 int pos;
1645 int extend;
1646 Lisp_Object **vec_ptr;
1647 int *len_ptr;
1648 int *next_ptr;
1649 int *prev_ptr;
1650 {
1651 Lisp_Object tail, overlay, start, end, result;
1652 int idx = 0;
1653 int len = *len_ptr;
1654 Lisp_Object *vec = *vec_ptr;
1655 int next = ZV;
1656 int prev = BEGV;
1657 int inhibit_storing = 0;
1658
1659 for (tail = current_buffer->overlays_before;
1660 GC_CONSP (tail);
1661 tail = XCONS (tail)->cdr)
1662 {
1663 int startpos, endpos;
1664
1665 overlay = XCONS (tail)->car;
1666
1667 start = OVERLAY_START (overlay);
1668 end = OVERLAY_END (overlay);
1669 endpos = OVERLAY_POSITION (end);
1670 if (endpos < pos)
1671 {
1672 if (prev < endpos)
1673 prev = endpos;
1674 break;
1675 }
1676 if (endpos == pos)
1677 continue;
1678 startpos = OVERLAY_POSITION (start);
1679 if (startpos <= pos)
1680 {
1681 if (idx == len)
1682 {
1683 /* The supplied vector is full.
1684 Either make it bigger, or don't store any more in it. */
1685 if (extend)
1686 {
1687 *len_ptr = len *= 2;
1688 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
1689 *vec_ptr = vec;
1690 }
1691 else
1692 inhibit_storing = 1;
1693 }
1694
1695 if (!inhibit_storing)
1696 vec[idx] = overlay;
1697 /* Keep counting overlays even if we can't return them all. */
1698 idx++;
1699 }
1700 else if (startpos < next)
1701 next = startpos;
1702 }
1703
1704 for (tail = current_buffer->overlays_after;
1705 GC_CONSP (tail);
1706 tail = XCONS (tail)->cdr)
1707 {
1708 int startpos, endpos;
1709
1710 overlay = XCONS (tail)->car;
1711
1712 start = OVERLAY_START (overlay);
1713 end = OVERLAY_END (overlay);
1714 startpos = OVERLAY_POSITION (start);
1715 if (pos < startpos)
1716 {
1717 if (startpos < next)
1718 next = startpos;
1719 break;
1720 }
1721 endpos = OVERLAY_POSITION (end);
1722 if (pos < endpos)
1723 {
1724 if (idx == len)
1725 {
1726 if (extend)
1727 {
1728 *len_ptr = len *= 2;
1729 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
1730 *vec_ptr = vec;
1731 }
1732 else
1733 inhibit_storing = 1;
1734 }
1735
1736 if (!inhibit_storing)
1737 vec[idx] = overlay;
1738 idx++;
1739 }
1740 else if (endpos < pos && endpos > prev)
1741 prev = endpos;
1742 }
1743
1744 if (next_ptr)
1745 *next_ptr = next;
1746 if (prev_ptr)
1747 *prev_ptr = prev;
1748 return idx;
1749 }
1750 \f
1751 struct sortvec
1752 {
1753 Lisp_Object overlay;
1754 int beg, end;
1755 int priority;
1756 };
1757
1758 static int
1759 compare_overlays (s1, s2)
1760 struct sortvec *s1, *s2;
1761 {
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;
1768 return 0;
1769 }
1770
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. */
1774 int
1775 sort_overlays (overlay_vec, noverlays, w)
1776 Lisp_Object *overlay_vec;
1777 int noverlays;
1778 struct window *w;
1779 {
1780 int i, j;
1781 struct sortvec *sortvec;
1782 sortvec = (struct sortvec *) alloca (noverlays * sizeof (struct sortvec));
1783
1784 /* Put the valid and relevant overlays into sortvec. */
1785
1786 for (i = 0, j = 0; i < noverlays; i++)
1787 {
1788 Lisp_Object tem;
1789 Lisp_Object overlay;
1790
1791 overlay = overlay_vec[i];
1792 if (OVERLAY_VALID (overlay)
1793 && OVERLAY_POSITION (OVERLAY_START (overlay)) > 0
1794 && OVERLAY_POSITION (OVERLAY_END (overlay)) > 0)
1795 {
1796 /* If we're interested in a specific window, then ignore
1797 overlays that are limited to some other window. */
1798 if (w)
1799 {
1800 Lisp_Object window;
1801
1802 window = Foverlay_get (overlay, Qwindow);
1803 if (WINDOWP (window) && XWINDOW (window) != w)
1804 continue;
1805 }
1806
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);
1812 if (INTEGERP (tem))
1813 sortvec[j].priority = XINT (tem);
1814 else
1815 sortvec[j].priority = 0;
1816 j++;
1817 }
1818 }
1819 noverlays = j;
1820
1821 /* Sort the overlays into the proper order: increasing priority. */
1822
1823 if (noverlays > 1)
1824 qsort (sortvec, noverlays, sizeof (struct sortvec), compare_overlays);
1825
1826 for (i = 0; i < noverlays; i++)
1827 overlay_vec[i] = sortvec[i].overlay;
1828 return (noverlays);
1829 }
1830 \f
1831 /* Shift overlays in BUF's overlay lists, to center the lists at POS. */
1832
1833 void
1834 recenter_overlay_lists (buf, pos)
1835 struct buffer *buf;
1836 int pos;
1837 {
1838 Lisp_Object overlay, tail, next, prev, beg, end;
1839
1840 /* See if anything in overlays_before should move to overlays_after. */
1841
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. */
1845 prev = Qnil;
1846 for (tail = buf->overlays_before;
1847 CONSP (tail);
1848 prev = tail, tail = next)
1849 {
1850 next = XCONS (tail)->cdr;
1851 overlay = XCONS (tail)->car;
1852
1853 /* If the overlay is not valid, get rid of it. */
1854 if (!OVERLAY_VALID (overlay))
1855 #if 1
1856 abort ();
1857 #else
1858 {
1859 /* Splice the cons cell TAIL out of overlays_before. */
1860 if (!NILP (prev))
1861 XCONS (prev)->cdr = next;
1862 else
1863 buf->overlays_before = next;
1864 tail = prev;
1865 continue;
1866 }
1867 #endif
1868
1869 beg = OVERLAY_START (overlay);
1870 end = OVERLAY_END (overlay);
1871
1872 if (OVERLAY_POSITION (end) > pos)
1873 {
1874 /* OVERLAY needs to be moved. */
1875 int where = OVERLAY_POSITION (beg);
1876 Lisp_Object other, other_prev;
1877
1878 /* Splice the cons cell TAIL out of overlays_before. */
1879 if (!NILP (prev))
1880 XCONS (prev)->cdr = next;
1881 else
1882 buf->overlays_before = next;
1883
1884 /* Search thru overlays_after for where to put it. */
1885 other_prev = Qnil;
1886 for (other = buf->overlays_after;
1887 CONSP (other);
1888 other_prev = other, other = XCONS (other)->cdr)
1889 {
1890 Lisp_Object otherbeg, otheroverlay, follower;
1891 int win;
1892
1893 otheroverlay = XCONS (other)->car;
1894 if (! OVERLAY_VALID (otheroverlay))
1895 abort ();
1896
1897 otherbeg = OVERLAY_START (otheroverlay);
1898 if (OVERLAY_POSITION (otherbeg) >= where)
1899 break;
1900 }
1901
1902 /* Add TAIL to overlays_after before OTHER. */
1903 XCONS (tail)->cdr = other;
1904 if (!NILP (other_prev))
1905 XCONS (other_prev)->cdr = tail;
1906 else
1907 buf->overlays_after = tail;
1908 tail = prev;
1909 }
1910 else
1911 /* We've reached the things that should stay in overlays_before.
1912 All the rest of overlays_before must end even earlier,
1913 so stop now. */
1914 break;
1915 }
1916
1917 /* See if anything in overlays_after should be in overlays_before. */
1918 prev = Qnil;
1919 for (tail = buf->overlays_after;
1920 CONSP (tail);
1921 prev = tail, tail = next)
1922 {
1923 next = XCONS (tail)->cdr;
1924 overlay = XCONS (tail)->car;
1925
1926 /* If the overlay is not valid, get rid of it. */
1927 if (!OVERLAY_VALID (overlay))
1928 #if 1
1929 abort ();
1930 #else
1931 {
1932 /* Splice the cons cell TAIL out of overlays_after. */
1933 if (!NILP (prev))
1934 XCONS (prev)->cdr = next;
1935 else
1936 buf->overlays_after = next;
1937 tail = prev;
1938 continue;
1939 }
1940 #endif
1941
1942 beg = OVERLAY_START (overlay);
1943 end = OVERLAY_END (overlay);
1944
1945 /* Stop looking, when we know that nothing further
1946 can possibly end before POS. */
1947 if (OVERLAY_POSITION (beg) > pos)
1948 break;
1949
1950 if (OVERLAY_POSITION (end) <= pos)
1951 {
1952 /* OVERLAY needs to be moved. */
1953 int where = OVERLAY_POSITION (end);
1954 Lisp_Object other, other_prev;
1955
1956 /* Splice the cons cell TAIL out of overlays_after. */
1957 if (!NILP (prev))
1958 XCONS (prev)->cdr = next;
1959 else
1960 buf->overlays_after = next;
1961
1962 /* Search thru overlays_before for where to put it. */
1963 other_prev = Qnil;
1964 for (other = buf->overlays_before;
1965 CONSP (other);
1966 other_prev = other, other = XCONS (other)->cdr)
1967 {
1968 Lisp_Object otherend, otheroverlay;
1969 int win;
1970
1971 otheroverlay = XCONS (other)->car;
1972 if (! OVERLAY_VALID (otheroverlay))
1973 abort ();
1974
1975 otherend = OVERLAY_END (otheroverlay);
1976 if (OVERLAY_POSITION (otherend) <= where)
1977 break;
1978 }
1979
1980 /* Add TAIL to overlays_before before OTHER. */
1981 XCONS (tail)->cdr = other;
1982 if (!NILP (other_prev))
1983 XCONS (other_prev)->cdr = tail;
1984 else
1985 buf->overlays_before = tail;
1986 tail = prev;
1987 }
1988 }
1989
1990 XSETFASTINT (buf->overlay_center, pos);
1991 }
1992
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? */
2000 void
2001 fix_overlays_in_range (start, end)
2002 register int start, end;
2003 {
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;
2008
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 = &current_buffer->overlays_before; CONSP (*ptail);)
2016 {
2017 overlay = XCONS (*ptail)->car;
2018 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2019 if (endpos < start)
2020 break;
2021 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2022 if (endpos < end
2023 || (startpos >= start && startpos < end))
2024 {
2025 /* If the overlay is backwards, fix that now. */
2026 if (startpos > endpos)
2027 {
2028 int tem;
2029 Fset_marker (OVERLAY_START (overlay), endpos, Qnil);
2030 Fset_marker (OVERLAY_END (overlay), startpos, Qnil);
2031 tem = startpos; startpos = endpos; endpos = tem;
2032 }
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))
2036 {
2037 *pafter = *ptail;
2038 pafter = &XCONS (*ptail)->cdr;
2039 }
2040 else
2041 {
2042 *pbefore = *ptail;
2043 pbefore = &XCONS (*ptail)->cdr;
2044 }
2045 *ptail = XCONS (*ptail)->cdr;
2046 }
2047 else
2048 ptail = &XCONS (*ptail)->cdr;
2049 }
2050 for (ptail = &current_buffer->overlays_after; CONSP (*ptail);)
2051 {
2052 overlay = XCONS (*ptail)->car;
2053 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2054 if (startpos >= end)
2055 break;
2056 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2057 if (startpos >= start
2058 || (endpos >= start && endpos < end))
2059 {
2060 if (startpos > endpos)
2061 {
2062 int tem;
2063 Fset_marker (OVERLAY_START (overlay), endpos, Qnil);
2064 Fset_marker (OVERLAY_END (overlay), startpos, Qnil);
2065 tem = startpos; startpos = endpos; endpos = tem;
2066 }
2067 if (endpos < XINT (current_buffer->overlay_center))
2068 {
2069 *pafter = *ptail;
2070 pafter = &XCONS (*ptail)->cdr;
2071 }
2072 else
2073 {
2074 *pbefore = *ptail;
2075 pbefore = &XCONS (*ptail)->cdr;
2076 }
2077 *ptail = XCONS (*ptail)->cdr;
2078 }
2079 else
2080 ptail = &XCONS (*ptail)->cdr;
2081 }
2082
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));
2089
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));
2094 }
2095 \f
2096 DEFUN ("overlayp", Foverlayp, Soverlayp, 1, 1, 0,
2097 "Return t if OBJECT is an overlay.")
2098 (object)
2099 Lisp_Object object;
2100 {
2101 return (OVERLAYP (object) ? Qt : Qnil);
2102 }
2103
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.")
2108 (beg, end, buffer)
2109 Lisp_Object beg, end, buffer;
2110 {
2111 Lisp_Object overlay;
2112 struct buffer *b;
2113
2114 if (NILP (buffer))
2115 XSETBUFFER (buffer, current_buffer);
2116 else
2117 CHECK_BUFFER (buffer, 2);
2118 if (MARKERP (beg)
2119 && ! EQ (Fmarker_buffer (beg), buffer))
2120 error ("Marker points into wrong buffer");
2121 if (MARKERP (end)
2122 && ! EQ (Fmarker_buffer (end), buffer))
2123 error ("Marker points into wrong buffer");
2124
2125 CHECK_NUMBER_COERCE_MARKER (beg, 1);
2126 CHECK_NUMBER_COERCE_MARKER (end, 1);
2127
2128 if (XINT (beg) > XINT (end))
2129 {
2130 Lisp_Object temp;
2131 temp = beg; beg = end; end = temp;
2132 }
2133
2134 b = XBUFFER (buffer);
2135
2136 beg = Fset_marker (Fmake_marker (), beg, buffer);
2137 end = Fset_marker (Fmake_marker (), end, buffer);
2138
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;
2144
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);
2149 else
2150 b->overlays_before = Fcons (overlay, b->overlays_before);
2151
2152 /* This puts it in the right list, and in the right order. */
2153 recenter_overlay_lists (b, XINT (b->overlay_center));
2154
2155 /* We don't need to redisplay the region covered by the overlay, because
2156 the overlay has no properties at the moment. */
2157
2158 return overlay;
2159 }
2160
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\
2165 buffer.")
2166 (overlay, beg, end, buffer)
2167 Lisp_Object overlay, beg, end, buffer;
2168 {
2169 struct buffer *b, *ob;
2170 Lisp_Object obuffer;
2171 int count = specpdl_ptr - specpdl;
2172
2173 CHECK_OVERLAY (overlay, 0);
2174 if (NILP (buffer))
2175 buffer = Fmarker_buffer (OVERLAY_START (overlay));
2176 if (NILP (buffer))
2177 XSETBUFFER (buffer, current_buffer);
2178 CHECK_BUFFER (buffer, 3);
2179
2180 if (MARKERP (beg)
2181 && ! EQ (Fmarker_buffer (beg), buffer))
2182 error ("Marker points into wrong buffer");
2183 if (MARKERP (end)
2184 && ! EQ (Fmarker_buffer (end), buffer))
2185 error ("Marker points into wrong buffer");
2186
2187 CHECK_NUMBER_COERCE_MARKER (beg, 1);
2188 CHECK_NUMBER_COERCE_MARKER (end, 1);
2189
2190 if (XINT (beg) == XINT (end) && ! NILP (Foverlay_get (overlay, Qevaporate)))
2191 return Fdelete_overlay (overlay);
2192
2193 if (XINT (beg) > XINT (end))
2194 {
2195 Lisp_Object temp;
2196 temp = beg; beg = end; end = temp;
2197 }
2198
2199 specbind (Qinhibit_quit, Qt);
2200
2201 obuffer = Fmarker_buffer (OVERLAY_START (overlay));
2202 b = XBUFFER (buffer);
2203 ob = XBUFFER (obuffer);
2204
2205 /* If the overlay has changed buffers, do a thorough redisplay. */
2206 if (!EQ (buffer, obuffer))
2207 {
2208 /* Redisplay where the overlay was. */
2209 if (!NILP (obuffer))
2210 {
2211 Lisp_Object o_beg;
2212 Lisp_Object o_end;
2213
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);
2218
2219 redisplay_region (ob, XINT (o_beg), XINT (o_end));
2220 }
2221
2222 /* Redisplay where the overlay is going to be. */
2223 redisplay_region (b, XINT (beg), XINT (end));
2224
2225 /* Don't limit redisplay to the selected window. */
2226 windows_or_buffers_changed = 1;
2227 }
2228 else
2229 /* Redisplay the area the overlay has just left, or just enclosed. */
2230 {
2231 Lisp_Object o_beg;
2232 Lisp_Object o_end;
2233 int change_beg, change_end;
2234
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);
2239
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));
2244 else
2245 {
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));
2249 }
2250 }
2251
2252 if (!NILP (obuffer))
2253 {
2254 ob->overlays_before = Fdelq (overlay, ob->overlays_before);
2255 ob->overlays_after = Fdelq (overlay, ob->overlays_after);
2256 }
2257
2258 Fset_marker (OVERLAY_START (overlay), beg, buffer);
2259 Fset_marker (OVERLAY_END (overlay), end, buffer);
2260
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);
2265 else
2266 b->overlays_before = Fcons (overlay, b->overlays_before);
2267
2268 /* This puts it in the right list, and in the right order. */
2269 recenter_overlay_lists (b, XINT (b->overlay_center));
2270
2271 return unbind_to (count, overlay);
2272 }
2273
2274 DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0,
2275 "Delete the overlay OVERLAY from its buffer.")
2276 (overlay)
2277 Lisp_Object overlay;
2278 {
2279 Lisp_Object buffer;
2280 struct buffer *b;
2281 int count = specpdl_ptr - specpdl;
2282
2283 CHECK_OVERLAY (overlay, 0);
2284
2285 buffer = Fmarker_buffer (OVERLAY_START (overlay));
2286 if (NILP (buffer))
2287 return Qnil;
2288
2289 b = XBUFFER (buffer);
2290
2291 specbind (Qinhibit_quit, Qt);
2292
2293 b->overlays_before = Fdelq (overlay, b->overlays_before);
2294 b->overlays_after = Fdelq (overlay, b->overlays_after);
2295
2296 redisplay_region (b,
2297 marker_position (OVERLAY_START (overlay)),
2298 marker_position (OVERLAY_END (overlay)));
2299
2300 Fset_marker (OVERLAY_START (overlay), Qnil, Qnil);
2301 Fset_marker (OVERLAY_END (overlay), Qnil, Qnil);
2302
2303 return unbind_to (count, Qnil);
2304 }
2305 \f
2306 /* Overlay dissection functions. */
2307
2308 DEFUN ("overlay-start", Foverlay_start, Soverlay_start, 1, 1, 0,
2309 "Return the position at which OVERLAY starts.")
2310 (overlay)
2311 Lisp_Object overlay;
2312 {
2313 CHECK_OVERLAY (overlay, 0);
2314
2315 return (Fmarker_position (OVERLAY_START (overlay)));
2316 }
2317
2318 DEFUN ("overlay-end", Foverlay_end, Soverlay_end, 1, 1, 0,
2319 "Return the position at which OVERLAY ends.")
2320 (overlay)
2321 Lisp_Object overlay;
2322 {
2323 CHECK_OVERLAY (overlay, 0);
2324
2325 return (Fmarker_position (OVERLAY_END (overlay)));
2326 }
2327
2328 DEFUN ("overlay-buffer", Foverlay_buffer, Soverlay_buffer, 1, 1, 0,
2329 "Return the buffer OVERLAY belongs to.")
2330 (overlay)
2331 Lisp_Object overlay;
2332 {
2333 CHECK_OVERLAY (overlay, 0);
2334
2335 return Fmarker_buffer (OVERLAY_START (overlay));
2336 }
2337
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\
2341 OVERLAY.")
2342 (overlay)
2343 Lisp_Object overlay;
2344 {
2345 CHECK_OVERLAY (overlay, 0);
2346
2347 return Fcopy_sequence (XOVERLAY (overlay)->plist);
2348 }
2349
2350 \f
2351 DEFUN ("overlays-at", Foverlays_at, Soverlays_at, 1, 1, 0,
2352 "Return a list of the overlays that contain position POS.")
2353 (pos)
2354 Lisp_Object pos;
2355 {
2356 int noverlays;
2357 Lisp_Object *overlay_vec;
2358 int len;
2359 Lisp_Object result;
2360
2361 CHECK_NUMBER_COERCE_MARKER (pos, 0);
2362
2363 len = 10;
2364 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
2365
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);
2369
2370 /* Make a list of them all. */
2371 result = Flist (noverlays, overlay_vec);
2372
2373 xfree (overlay_vec);
2374 return result;
2375 }
2376
2377 DEFUN ("next-overlay-change", Fnext_overlay_change, Snext_overlay_change,
2378 1, 1, 0,
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).")
2381 (pos)
2382 Lisp_Object pos;
2383 {
2384 int noverlays;
2385 int endpos;
2386 Lisp_Object *overlay_vec;
2387 int len;
2388 int i;
2389
2390 CHECK_NUMBER_COERCE_MARKER (pos, 0);
2391
2392 len = 10;
2393 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
2394
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);
2399
2400 /* If any of these overlays ends before endpos,
2401 use its ending point instead. */
2402 for (i = 0; i < noverlays; i++)
2403 {
2404 Lisp_Object oend;
2405 int oendpos;
2406
2407 oend = OVERLAY_END (overlay_vec[i]);
2408 oendpos = OVERLAY_POSITION (oend);
2409 if (oendpos < endpos)
2410 endpos = oendpos;
2411 }
2412
2413 xfree (overlay_vec);
2414 return make_number (endpos);
2415 }
2416
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).")
2421 (pos)
2422 Lisp_Object pos;
2423 {
2424 int noverlays;
2425 int prevpos;
2426 Lisp_Object *overlay_vec;
2427 int len;
2428 int i;
2429
2430 CHECK_NUMBER_COERCE_MARKER (pos, 0);
2431
2432 len = 10;
2433 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
2434
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);
2439
2440 /* If any of these overlays starts before endpos,
2441 maybe use its starting point instead. */
2442 for (i = 0; i < noverlays; i++)
2443 {
2444 Lisp_Object ostart;
2445 int ostartpos;
2446
2447 ostart = OVERLAY_START (overlay_vec[i]);
2448 ostartpos = OVERLAY_POSITION (ostart);
2449 if (ostartpos > prevpos && ostartpos < XINT (pos))
2450 prevpos = ostartpos;
2451 }
2452
2453 xfree (overlay_vec);
2454 return make_number (prevpos);
2455 }
2456 \f
2457 /* These functions are for debugging overlays. */
2458
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.")
2466 ()
2467 {
2468 Lisp_Object before, after;
2469 before = current_buffer->overlays_before;
2470 if (CONSP (before))
2471 before = Fcopy_sequence (before);
2472 after = current_buffer->overlays_after;
2473 if (CONSP (after))
2474 after = Fcopy_sequence (after);
2475
2476 return Fcons (before, after);
2477 }
2478
2479 DEFUN ("overlay-recenter", Foverlay_recenter, Soverlay_recenter, 1, 1, 0,
2480 "Recenter the overlays of the current buffer around position POS.")
2481 (pos)
2482 Lisp_Object pos;
2483 {
2484 CHECK_NUMBER_COERCE_MARKER (pos, 0);
2485
2486 recenter_overlay_lists (current_buffer, XINT (pos));
2487 return Qnil;
2488 }
2489 \f
2490 DEFUN ("overlay-get", Foverlay_get, Soverlay_get, 2, 2, 0,
2491 "Get the property of overlay OVERLAY with property name NAME.")
2492 (overlay, prop)
2493 Lisp_Object overlay, prop;
2494 {
2495 Lisp_Object plist, fallback;
2496
2497 CHECK_OVERLAY (overlay, 0);
2498
2499 fallback = Qnil;
2500
2501 for (plist = XOVERLAY (overlay)->plist;
2502 CONSP (plist) && CONSP (XCONS (plist)->cdr);
2503 plist = XCONS (XCONS (plist)->cdr)->cdr)
2504 {
2505 if (EQ (XCONS (plist)->car, prop))
2506 return XCONS (XCONS (plist)->cdr)->car;
2507 else if (EQ (XCONS (plist)->car, Qcategory))
2508 {
2509 Lisp_Object tem;
2510 tem = Fcar (Fcdr (plist));
2511 if (SYMBOLP (tem))
2512 fallback = Fget (tem, prop);
2513 }
2514 }
2515
2516 return fallback;
2517 }
2518
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;
2523 {
2524 Lisp_Object tail, buffer;
2525 int changed;
2526
2527 CHECK_OVERLAY (overlay, 0);
2528
2529 buffer = Fmarker_buffer (OVERLAY_START (overlay));
2530
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))
2535 {
2536 changed = !EQ (XCONS (XCONS (tail)->cdr)->car, value);
2537 XCONS (XCONS (tail)->cdr)->car = value;
2538 goto found;
2539 }
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));
2544 found:
2545 if (! NILP (buffer))
2546 {
2547 if (changed)
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);
2555 }
2556 return value;
2557 }
2558 \f
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.
2563
2564 This is called both before and after the modification.
2565 AFTER is nonzero when we call after the modification.
2566
2567 ARG1, ARG2, ARG3 are arguments to pass to the hook functions. */
2568
2569 void
2570 report_overlay_modification (start, end, after, arg1, arg2, arg3)
2571 Lisp_Object start, end;
2572 int after;
2573 Lisp_Object arg1, arg2, arg3;
2574 {
2575 Lisp_Object prop, overlay, tail;
2576 int insertion = EQ (start, end);
2577 int tail_copied;
2578 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2579
2580 overlay = Qnil;
2581 tail = Qnil;
2582 GCPRO5 (overlay, tail, arg1, arg2, arg3);
2583
2584 tail_copied = 0;
2585 for (tail = current_buffer->overlays_before;
2586 CONSP (tail);
2587 tail = XCONS (tail)->cdr)
2588 {
2589 int startpos, endpos;
2590 Lisp_Object ostart, oend;
2591
2592 overlay = XCONS (tail)->car;
2593
2594 ostart = OVERLAY_START (overlay);
2595 oend = OVERLAY_END (overlay);
2596 endpos = OVERLAY_POSITION (oend);
2597 if (XFASTINT (start) > endpos)
2598 break;
2599 startpos = OVERLAY_POSITION (ostart);
2600 if (XFASTINT (end) == startpos && insertion)
2601 {
2602 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
2603 if (!NILP (prop))
2604 {
2605 /* Copy TAIL in case the hook recenters the overlay lists. */
2606 if (!tail_copied)
2607 tail = Fcopy_sequence (tail);
2608 tail_copied = 1;
2609 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
2610 }
2611 }
2612 if (XFASTINT (start) == endpos && insertion)
2613 {
2614 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
2615 if (!NILP (prop))
2616 {
2617 if (!tail_copied)
2618 tail = Fcopy_sequence (tail);
2619 tail_copied = 1;
2620 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
2621 }
2622 }
2623 /* Test for intersecting intervals. This does the right thing
2624 for both insertion and deletion. */
2625 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
2626 {
2627 prop = Foverlay_get (overlay, Qmodification_hooks);
2628 if (!NILP (prop))
2629 {
2630 if (!tail_copied)
2631 tail = Fcopy_sequence (tail);
2632 tail_copied = 1;
2633 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
2634 }
2635 }
2636 }
2637
2638 tail_copied = 0;
2639 for (tail = current_buffer->overlays_after;
2640 CONSP (tail);
2641 tail = XCONS (tail)->cdr)
2642 {
2643 int startpos, endpos;
2644 Lisp_Object ostart, oend;
2645
2646 overlay = XCONS (tail)->car;
2647
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)
2653 break;
2654 if (XFASTINT (end) == startpos && insertion)
2655 {
2656 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
2657 if (!NILP (prop))
2658 {
2659 if (!tail_copied)
2660 tail = Fcopy_sequence (tail);
2661 tail_copied = 1;
2662 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
2663 }
2664 }
2665 if (XFASTINT (start) == endpos && insertion)
2666 {
2667 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
2668 if (!NILP (prop))
2669 {
2670 if (!tail_copied)
2671 tail = Fcopy_sequence (tail);
2672 tail_copied = 1;
2673 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
2674 }
2675 }
2676 /* Test for intersecting intervals. This does the right thing
2677 for both insertion and deletion. */
2678 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
2679 {
2680 prop = Foverlay_get (overlay, Qmodification_hooks);
2681 if (!NILP (prop))
2682 {
2683 if (!tail_copied)
2684 tail = Fcopy_sequence (tail);
2685 tail_copied = 1;
2686 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
2687 }
2688 }
2689 }
2690
2691 UNGCPRO;
2692 }
2693
2694 static void
2695 call_overlay_mod_hooks (list, overlay, after, arg1, arg2, arg3)
2696 Lisp_Object list, overlay;
2697 int after;
2698 Lisp_Object arg1, arg2, arg3;
2699 {
2700 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2701 GCPRO4 (list, arg1, arg2, arg3);
2702 while (!NILP (list))
2703 {
2704 if (NILP (arg3))
2705 call4 (Fcar (list), overlay, after ? Qt : Qnil, arg1, arg2);
2706 else
2707 call5 (Fcar (list), overlay, after ? Qt : Qnil, arg1, arg2, arg3);
2708 list = Fcdr (list);
2709 }
2710 UNGCPRO;
2711 }
2712
2713 /* Delete any zero-sized overlays at position POS, if the `evaporate'
2714 property is set. */
2715 void
2716 evaporate_overlays (pos)
2717 int pos;
2718 {
2719 Lisp_Object tail, overlay, hit_list;
2720
2721 hit_list = Qnil;
2722 if (pos <= XFASTINT (current_buffer->overlay_center))
2723 for (tail = current_buffer->overlays_before; CONSP (tail);
2724 tail = XCONS (tail)->cdr)
2725 {
2726 int endpos;
2727 overlay = XCONS (tail)->car;
2728 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2729 if (endpos < pos)
2730 break;
2731 if (endpos == pos && OVERLAY_POSITION (OVERLAY_START (overlay)) == pos
2732 && Foverlay_get (overlay, Qevaporate))
2733 hit_list = Fcons (overlay, hit_list);
2734 }
2735 else
2736 for (tail = current_buffer->overlays_after; CONSP (tail);
2737 tail = XCONS (tail)->cdr)
2738 {
2739 int startpos;
2740 overlay = XCONS (tail)->car;
2741 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2742 if (startpos > pos)
2743 break;
2744 if (startpos == pos && OVERLAY_POSITION (OVERLAY_END (overlay)) == pos
2745 && Foverlay_get (overlay, Qevaporate))
2746 hit_list = Fcons (overlay, hit_list);
2747 }
2748 for (; CONSP (hit_list); hit_list = XCONS (hit_list)->cdr)
2749 Fdelete_overlay (XCONS (hit_list)->car);
2750 }
2751 \f
2752 /* Somebody has tried to store a value with an unacceptable type
2753 into the buffer-local slot with offset OFFSET. */
2754 void
2755 buffer_slot_type_mismatch (offset)
2756 int offset;
2757 {
2758 Lisp_Object sym;
2759 char *type_name;
2760 sym = *(Lisp_Object *)(offset + (char *)&buffer_local_symbols);
2761 switch (XINT (*(Lisp_Object *)(offset + (char *)&buffer_local_types)))
2762 {
2763 case Lisp_Int: type_name = "integers"; break;
2764 case Lisp_String: type_name = "strings"; break;
2765 case Lisp_Symbol: type_name = "symbols"; break;
2766 default:
2767 abort ();
2768 }
2769
2770 error ("only %s should be stored in the buffer-local variable %s",
2771 type_name, XSYMBOL (sym)->name->data);
2772 }
2773 \f
2774 init_buffer_once ()
2775 {
2776 register Lisp_Object tem;
2777
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;
2790 #endif
2791 XSETBUFFER (Vbuffer_defaults, &buffer_defaults);
2792 XSETBUFFER (Vbuffer_local_symbols, &buffer_local_symbols);
2793
2794 /* Set up the default values of various buffer slots. */
2795 /* Must do these before making the first buffer! */
2796
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;
2804 #ifndef old
2805 buffer_defaults.selective_display_ellipses = Qt;
2806 #endif
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);
2814
2815 XSETFASTINT (buffer_defaults.tab_width, 8);
2816 buffer_defaults.truncate_lines = Qnil;
2817 buffer_defaults.ctl_arrow = Qt;
2818
2819 #ifdef DOS_NT
2820 buffer_defaults.buffer_file_type = Qnil; /* TEXT */
2821 #endif
2822 XSETFASTINT (buffer_defaults.fill_column, 70);
2823 XSETFASTINT (buffer_defaults.left_margin, 0);
2824 buffer_defaults.cache_long_line_scans = Qnil;
2825
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. */
2830
2831 /* Nothing can work if this isn't true */
2832 if (sizeof (EMACS_INT) != sizeof (Lisp_Object)) abort ();
2833
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);
2846
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);
2853 #ifndef old
2854 XSETFASTINT (buffer_local_flags.selective_display_ellipses, 0x40);
2855 #endif
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);
2865 #ifdef DOS_NT
2866 XSETFASTINT (buffer_local_flags.buffer_file_type, 0x4000);
2867 #endif
2868
2869 Vbuffer_alist = Qnil;
2870 current_buffer = 0;
2871 all_buffers = 0;
2872
2873 QSFundamental = build_string ("Fundamental");
2874
2875 Qfundamental_mode = intern ("fundamental-mode");
2876 buffer_defaults.major_mode = Qfundamental_mode;
2877
2878 Qmode_class = intern ("mode-class");
2879
2880 Qprotected_field = intern ("protected-field");
2881
2882 Qpermanent_local = intern ("permanent-local");
2883
2884 Qkill_buffer_hook = intern ("kill-buffer-hook");
2885
2886 Vprin1_to_string_buffer = Fget_buffer_create (build_string (" prin1"));
2887 /* super-magic invisible buffer */
2888 Vbuffer_alist = Qnil;
2889
2890 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
2891 }
2892
2893 init_buffer ()
2894 {
2895 char buf[MAXPATHLEN+1];
2896 char *pwd;
2897 struct stat dotstat, pwdstat;
2898 Lisp_Object temp;
2899 int rc;
2900
2901 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
2902
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)
2911 strcpy (buf, pwd);
2912 else if (getwd (buf) == 0)
2913 fatal ("`getwd' failed: %s\n", buf);
2914
2915 #ifndef VMS
2916 /* Maybe this should really use some standard subroutine
2917 whose definition is filename syntax dependent. */
2918 rc = strlen (buf);
2919 if (!(IS_DIRECTORY_SEP (buf[rc - 1])))
2920 {
2921 buf[rc] = DIRECTORY_SEP;
2922 buf[rc + 1] = '\0';
2923 }
2924 #endif /* not VMS */
2925 current_buffer->directory = build_string (buf);
2926
2927 temp = get_minibuffer (0);
2928 XBUFFER (temp)->directory = current_buffer->directory;
2929 }
2930
2931 /* initialize the buffer routines */
2932 syms_of_buffer ()
2933 {
2934 extern Lisp_Object Qdisabled;
2935
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);
2960
2961 Qoverlayp = intern ("overlayp");
2962
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"));
2967
2968 /* All these use DEFVAR_LISP_NOPRO because the slots in
2969 buffer_defaults will all be marked via Vbuffer_defaults. */
2970
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).");
2975
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).");
2980
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).");
2985
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).");
2990
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).");
2995
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).");
3000
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).");
3005
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).");
3010
3011 #ifdef DOS_NT
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.");
3017 #endif
3018
3019 DEFVAR_PER_BUFFER ("mode-line-format", &current_buffer->mode_line_format,
3020 Qnil, 0);
3021
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", &current_buffer->mode_line_format,
3025 Qnil,
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.");
3056 */
3057
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.");
3061
3062 DEFVAR_PER_BUFFER ("major-mode", &current_buffer->major_mode,
3063 make_number (Lisp_Symbol),
3064 "Symbol for current buffer's major mode.");
3065
3066 DEFVAR_PER_BUFFER ("mode-name", &current_buffer->mode_name,
3067 make_number (Lisp_String),
3068 "Pretty name of current buffer's major mode (a string).");
3069
3070 DEFVAR_PER_BUFFER ("abbrev-mode", &current_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.");
3073
3074 DEFVAR_PER_BUFFER ("case-fold-search", &current_buffer->case_fold_search,
3075 Qnil,
3076 "*Non-nil if searches should ignore case.\n\
3077 Automatically becomes buffer-local when set in any fashion.");
3078
3079 DEFVAR_PER_BUFFER ("fill-column", &current_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.");
3083
3084 DEFVAR_PER_BUFFER ("left-margin", &current_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.");
3089
3090 DEFVAR_PER_BUFFER ("tab-width", &current_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.");
3094
3095 DEFVAR_PER_BUFFER ("ctl-arrow", &current_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).");
3101
3102 DEFVAR_PER_BUFFER ("truncate-lines", &current_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\
3106 \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.");
3110
3111 #ifdef DOS_NT
3112 DEFVAR_PER_BUFFER ("buffer-file-type", &current_buffer->buffer_file_type,
3113 Qnil,
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.")
3118 #endif
3119
3120 DEFVAR_PER_BUFFER ("default-directory", &current_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.");
3124
3125 DEFVAR_PER_BUFFER ("auto-fill-function", &current_buffer->auto_fill_function,
3126 Qnil,
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.");
3132
3133 DEFVAR_PER_BUFFER ("buffer-file-name", &current_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.");
3137
3138 DEFVAR_PER_BUFFER ("buffer-auto-save-file-name",
3139 &current_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.");
3144
3145 DEFVAR_PER_BUFFER ("buffer-read-only", &current_buffer->read_only, Qnil,
3146 "Non-nil if this buffer is read-only.\n\
3147 Each buffer has its own value of this variable.");
3148
3149 DEFVAR_PER_BUFFER ("buffer-backed-up", &current_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.");
3153
3154 DEFVAR_PER_BUFFER ("buffer-saved-size", &current_buffer->save_length,
3155 make_number (Lisp_Int),
3156 "Length of current buffer when last read in, saved or auto-saved.\n\
3157 0 initially.\n\
3158 Each buffer has its own value of this variable.");
3159
3160 DEFVAR_PER_BUFFER ("selective-display", &current_buffer->selective_display,
3161 Qnil,
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.");
3168
3169 #ifndef old
3170 DEFVAR_PER_BUFFER ("selective-display-ellipses",
3171 &current_buffer->selective_display_ellipses,
3172 Qnil,
3173 "t means display ... on previous line when a line is invisible.\n\
3174 Automatically becomes buffer-local when set in any fashion.");
3175 #endif
3176
3177 DEFVAR_PER_BUFFER ("overwrite-mode", &current_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.");
3184
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", &current_buffer->display_table,
3188 Qnil,
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.");
3208 #endif
3209 DEFVAR_PER_BUFFER ("buffer-display-table", &current_buffer->display_table,
3210 Qnil, 0);
3211
3212 /*DEFVAR_LISP ("debug-check-symbol", &Vcheck_symbol,
3213 "Don't ask.");
3214 */
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\
3221 \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;
3229
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\
3238 \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;
3246
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\
3253 \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;
3261
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\
3270 \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.");
3277
3278 Vafter_change_functions = Qnil;
3279
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);
3286
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", &current_buffer->undo_list, Qnil,
3290 "List of undo entries in current buffer.\n\
3291 Recent changes come first; older changes follow newer.\n\
3292 \n\
3293 An entry (START . END) represents an insertion which begins at\n\
3294 position START and ends at position END.\n\
3295 \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\
3299 \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\
3304 obsolete.\n\
3305 \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\
3309 \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\
3313 \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\
3316 \n\
3317 If the value of the variable is t, undo information is not recorded.");
3318 #endif
3319 DEFVAR_PER_BUFFER ("buffer-undo-list", &current_buffer->undo_list, Qnil,
3320 0);
3321
3322 DEFVAR_PER_BUFFER ("mark-active", &current_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.");
3325
3326 DEFVAR_PER_BUFFER ("cache-long-line-scans", &current_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\
3329 \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\
3337 \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\
3344 \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\
3349 \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.");
3354
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;
3358
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;
3366
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;
3370
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);
3400
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);
3416 }
3417
3418 keys_of_buffer ()
3419 {
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");
3423
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);
3427 }