]> code.delx.au - gnu-emacs/blob - src/buffer.c
(echo_area_display): Use selected frame's minibuf window
[gnu-emacs] / src / buffer.c
1 /* Buffer manipulation primitives for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995
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 void set_buffer_internal_1 ();
104 static void call_overlay_mod_hooks ();
105 static void swap_out_buffer_local_variables ();
106
107 /* Alist of all buffer names vs the buffers. */
108 /* This used to be a variable, but is no longer,
109 to prevent lossage due to user rplac'ing this alist or its elements. */
110 Lisp_Object Vbuffer_alist;
111
112 /* Functions to call before and after each text change. */
113 Lisp_Object Vbefore_change_function;
114 Lisp_Object Vafter_change_function;
115 Lisp_Object Vbefore_change_functions;
116 Lisp_Object Vafter_change_functions;
117
118 Lisp_Object Vtransient_mark_mode;
119
120 /* t means ignore all read-only text properties.
121 A list means ignore such a property if its value is a member of the list.
122 Any non-nil value means ignore buffer-read-only. */
123 Lisp_Object Vinhibit_read_only;
124
125 /* List of functions to call that can query about killing a buffer.
126 If any of these functions returns nil, we don't kill it. */
127 Lisp_Object Vkill_buffer_query_functions;
128
129 /* List of functions to call before changing an unmodified buffer. */
130 Lisp_Object Vfirst_change_hook;
131 Lisp_Object Qfirst_change_hook;
132
133 Lisp_Object Qfundamental_mode, Qmode_class, Qpermanent_local;
134
135 Lisp_Object Qprotected_field;
136
137 Lisp_Object QSFundamental; /* A string "Fundamental" */
138
139 Lisp_Object Qkill_buffer_hook;
140
141 Lisp_Object Qget_file_buffer;
142
143 Lisp_Object Qoverlayp;
144
145 Lisp_Object Qpriority, Qwindow, Qevaporate, Qbefore_string, Qafter_string;
146
147 Lisp_Object Qmodification_hooks;
148 Lisp_Object Qinsert_in_front_hooks;
149 Lisp_Object Qinsert_behind_hooks;
150
151 /* For debugging; temporary. See set_buffer_internal. */
152 /* Lisp_Object Qlisp_mode, Vcheck_symbol; */
153
154 nsberror (spec)
155 Lisp_Object spec;
156 {
157 if (STRINGP (spec))
158 error ("No buffer named %s", XSTRING (spec)->data);
159 error ("Invalid buffer argument");
160 }
161 \f
162 DEFUN ("buffer-list", Fbuffer_list, Sbuffer_list, 0, 0, 0,
163 "Return a list of all existing live buffers.")
164 ()
165 {
166 return Fmapcar (Qcdr, Vbuffer_alist);
167 }
168
169 /* Like Fassoc, but use Fstring_equal to compare
170 (which ignores text properties),
171 and don't ever QUIT. */
172
173 static Lisp_Object
174 assoc_ignore_text_properties (key, list)
175 register Lisp_Object key;
176 Lisp_Object list;
177 {
178 register Lisp_Object tail;
179 for (tail = list; !NILP (tail); tail = Fcdr (tail))
180 {
181 register Lisp_Object elt, tem;
182 elt = Fcar (tail);
183 tem = Fstring_equal (Fcar (elt), key);
184 if (!NILP (tem))
185 return elt;
186 }
187 return Qnil;
188 }
189
190 DEFUN ("get-buffer", Fget_buffer, Sget_buffer, 1, 1, 0,
191 "Return the buffer named NAME (a string).\n\
192 If there is no live buffer named NAME, return nil.\n\
193 NAME may also be a buffer; if so, the value is that buffer.")
194 (name)
195 register Lisp_Object name;
196 {
197 if (BUFFERP (name))
198 return name;
199 CHECK_STRING (name, 0);
200
201 return Fcdr (assoc_ignore_text_properties (name, Vbuffer_alist));
202 }
203
204 DEFUN ("get-file-buffer", Fget_file_buffer, Sget_file_buffer, 1, 1, 0,
205 "Return the buffer visiting file FILENAME (a string).\n\
206 The buffer's `buffer-file-name' must match exactly the expansion of FILENAME.\n\
207 If there is no such live buffer, return nil.\n\
208 See also `find-buffer-visiting'.")
209 (filename)
210 register Lisp_Object filename;
211 {
212 register Lisp_Object tail, buf, tem;
213 Lisp_Object handler;
214
215 CHECK_STRING (filename, 0);
216 filename = Fexpand_file_name (filename, Qnil);
217
218 /* If the file name has special constructs in it,
219 call the corresponding file handler. */
220 handler = Ffind_file_name_handler (filename, Qget_file_buffer);
221 if (!NILP (handler))
222 return call2 (handler, Qget_file_buffer, filename);
223
224 for (tail = Vbuffer_alist; CONSP (tail); tail = XCONS (tail)->cdr)
225 {
226 buf = Fcdr (XCONS (tail)->car);
227 if (!BUFFERP (buf)) continue;
228 if (!STRINGP (XBUFFER (buf)->filename)) continue;
229 tem = Fstring_equal (XBUFFER (buf)->filename, filename);
230 if (!NILP (tem))
231 return buf;
232 }
233 return Qnil;
234 }
235
236 /* Incremented for each buffer created, to assign the buffer number. */
237 int buffer_count;
238
239 DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 1, 0,
240 "Return the buffer named NAME, or create such a buffer and return it.\n\
241 A new buffer is created if there is no live buffer named NAME.\n\
242 If NAME starts with a space, the new buffer does not keep undo information.\n\
243 If NAME is a buffer instead of a string, then it is the value returned.\n\
244 The value is never nil.")
245 (name)
246 register Lisp_Object name;
247 {
248 register Lisp_Object buf;
249 register struct buffer *b;
250
251 buf = Fget_buffer (name);
252 if (!NILP (buf))
253 return buf;
254
255 if (XSTRING (name)->size == 0)
256 error ("Empty string for buffer name is not allowed");
257
258 b = (struct buffer *) xmalloc (sizeof (struct buffer));
259
260 b->size = sizeof (struct buffer) / sizeof (EMACS_INT);
261
262 /* An ordinary buffer uses its own struct buffer_text. */
263 b->text = &b->own_text;
264 b->base_buffer = 0;
265
266 BUF_GAP_SIZE (b) = 20;
267 BLOCK_INPUT;
268 BUFFER_ALLOC (BUF_BEG_ADDR (b), BUF_GAP_SIZE (b));
269 UNBLOCK_INPUT;
270 if (! BUF_BEG_ADDR (b))
271 buffer_memory_full ();
272
273 BUF_PT (b) = 1;
274 BUF_GPT (b) = 1;
275 BUF_BEGV (b) = 1;
276 BUF_ZV (b) = 1;
277 BUF_Z (b) = 1;
278 BUF_MODIFF (b) = 1;
279 BUF_SAVE_MODIFF (b) = 1;
280 BUF_INTERVALS (b) = 0;
281
282 b->newline_cache = 0;
283 b->width_run_cache = 0;
284 b->width_table = Qnil;
285
286 /* Put this on the chain of all buffers including killed ones. */
287 b->next = all_buffers;
288 all_buffers = b;
289
290 /* An ordinary buffer normally doesn't need markers
291 to handle BEGV and ZV. */
292 b->pt_marker = Qnil;
293 b->begv_marker = Qnil;
294 b->zv_marker = Qnil;
295
296 name = Fcopy_sequence (name);
297 INITIALIZE_INTERVAL (XSTRING (name), NULL_INTERVAL);
298 b->name = name;
299
300 if (XSTRING (name)->data[0] != ' ')
301 b->undo_list = Qnil;
302 else
303 b->undo_list = Qt;
304
305 reset_buffer (b);
306 reset_buffer_local_variables (b);
307
308 /* Put this in the alist of all live buffers. */
309 XSETBUFFER (buf, b);
310 Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));
311
312 b->mark = Fmake_marker ();
313 BUF_MARKERS (b) = Qnil;
314 b->name = name;
315 return buf;
316 }
317
318 DEFUN ("make-indirect-buffer",
319 Fmake_indirect_buffer, Smake_indirect_buffer, 2, 2,
320 "bMake indirect buffer (to buffer): \nBName of indirect buffer: ",
321 "Create and return an indirect buffer for buffer BASE, named NAME.\n\
322 BASE should be an existing buffer (or buffer name).\n\
323 NAME should be a string which is not the name of an existing buffer.")
324 (base_buffer, name)
325 register Lisp_Object base_buffer, name;
326 {
327 register Lisp_Object buf;
328 register struct buffer *b;
329
330 buf = Fget_buffer (name);
331 if (!NILP (buf))
332 error ("Buffer name `%s' is in use", XSTRING (name)->data);
333
334 base_buffer = Fget_buffer (base_buffer);
335 if (NILP (base_buffer))
336 error ("No such buffer: `%s'",
337 XSTRING (XBUFFER (base_buffer)->name)->data);
338
339 if (XSTRING (name)->size == 0)
340 error ("Empty string for buffer name is not allowed");
341
342 b = (struct buffer *) xmalloc (sizeof (struct buffer));
343
344 b->size = sizeof (struct buffer) / sizeof (EMACS_INT);
345
346 if (XBUFFER (base_buffer)->base_buffer)
347 b->base_buffer = XBUFFER (base_buffer)->base_buffer;
348 else
349 b->base_buffer = XBUFFER (base_buffer);
350
351 /* Use the base buffer's text object. */
352 b->text = b->base_buffer->text;
353
354 BUF_BEGV (b) = BUF_BEGV (b->base_buffer);
355 BUF_ZV (b) = BUF_ZV (b->base_buffer);
356 BUF_PT (b) = BUF_PT (b->base_buffer);
357
358 b->newline_cache = 0;
359 b->width_run_cache = 0;
360 b->width_table = Qnil;
361
362 /* Put this on the chain of all buffers including killed ones. */
363 b->next = all_buffers;
364 all_buffers = b;
365
366 name = Fcopy_sequence (name);
367 INITIALIZE_INTERVAL (XSTRING (name), NULL_INTERVAL);
368 b->name = name;
369
370 reset_buffer (b);
371 reset_buffer_local_variables (b);
372
373 /* Put this in the alist of all live buffers. */
374 XSETBUFFER (buf, b);
375 Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));
376
377 b->mark = Fmake_marker ();
378 b->name = name;
379
380 /* Make sure the base buffer has markers for its narrowing. */
381 if (NILP (b->base_buffer->pt_marker))
382 {
383 b->base_buffer->pt_marker = Fmake_marker ();
384 Fset_marker (b->base_buffer->pt_marker,
385 make_number (BUF_PT (b->base_buffer)), base_buffer);
386 }
387 if (NILP (b->base_buffer->begv_marker))
388 {
389 b->base_buffer->begv_marker = Fmake_marker ();
390 Fset_marker (b->base_buffer->begv_marker,
391 make_number (BUF_BEGV (b->base_buffer)), base_buffer);
392 }
393 if (NILP (b->base_buffer->zv_marker))
394 {
395 b->base_buffer->zv_marker = Fmake_marker ();
396 Fset_marker (b->base_buffer->zv_marker,
397 make_number (BUF_ZV (b->base_buffer)), base_buffer);
398 }
399
400 /* Give the indirect buffer markers for its narrowing. */
401 b->pt_marker = Fpoint_marker ();
402 b->begv_marker = Fpoint_min_marker ();
403 b->zv_marker = Fpoint_max_marker ();
404
405 return buf;
406 }
407
408 /* Reinitialize everything about a buffer except its name and contents
409 and local variables. */
410
411 void
412 reset_buffer (b)
413 register struct buffer *b;
414 {
415 b->filename = Qnil;
416 b->file_truename = Qnil;
417 b->directory = (current_buffer) ? current_buffer->directory : Qnil;
418 b->modtime = 0;
419 XSETFASTINT (b->save_length, 0);
420 b->last_window_start = 1;
421 b->backed_up = Qnil;
422 b->auto_save_modified = 0;
423 b->auto_save_failure_time = -1;
424 b->auto_save_file_name = Qnil;
425 b->read_only = Qnil;
426 b->overlays_before = Qnil;
427 b->overlays_after = Qnil;
428 XSETFASTINT (b->overlay_center, 1);
429 b->mark_active = Qnil;
430 b->point_before_scroll = Qnil;
431 b->file_format = Qnil;
432 }
433
434 /* Reset buffer B's local variables info.
435 Don't use this on a buffer that has already been in use;
436 it does not treat permanent locals consistently.
437 Instead, use Fkill_all_local_variables. */
438
439 reset_buffer_local_variables (b)
440 register struct buffer *b;
441 {
442 register int offset;
443
444 /* Reset the major mode to Fundamental, together with all the
445 things that depend on the major mode.
446 default-major-mode is handled at a higher level.
447 We ignore it here. */
448 b->major_mode = Qfundamental_mode;
449 b->keymap = Qnil;
450 b->abbrev_table = Vfundamental_mode_abbrev_table;
451 b->mode_name = QSFundamental;
452 b->minor_modes = Qnil;
453 b->downcase_table = Vascii_downcase_table;
454 b->upcase_table = Vascii_upcase_table;
455 b->case_canon_table = Vascii_canon_table;
456 b->case_eqv_table = Vascii_eqv_table;
457 b->buffer_file_type = Qnil;
458 b->invisibility_spec = Qt;
459
460 #if 0
461 b->sort_table = XSTRING (Vascii_sort_table);
462 b->folding_sort_table = XSTRING (Vascii_folding_sort_table);
463 #endif /* 0 */
464
465 /* Reset all per-buffer variables to their defaults. */
466 b->local_var_alist = Qnil;
467 b->local_var_flags = 0;
468
469 /* For each slot that has a default value,
470 copy that into the slot. */
471
472 for (offset = (char *)&buffer_local_flags.name - (char *)&buffer_local_flags;
473 offset < sizeof (struct buffer);
474 offset += sizeof (Lisp_Object)) /* sizeof EMACS_INT == sizeof Lisp_Object */
475 {
476 int flag = XINT (*(Lisp_Object *)(offset + (char *)&buffer_local_flags));
477 if (flag > 0 || flag == -2)
478 *(Lisp_Object *)(offset + (char *)b) =
479 *(Lisp_Object *)(offset + (char *)&buffer_defaults);
480 }
481 }
482
483 /* We split this away from generate-new-buffer, because rename-buffer
484 and set-visited-file-name ought to be able to use this to really
485 rename the buffer properly. */
486
487 DEFUN ("generate-new-buffer-name", Fgenerate_new_buffer_name, Sgenerate_new_buffer_name,
488 1, 2, 0,
489 "Return a string that is the name of no existing buffer based on NAME.\n\
490 If there is no live buffer named NAME, then return NAME.\n\
491 Otherwise modify name by appending `<NUMBER>', incrementing NUMBER\n\
492 until an unused name is found, and then return that name.\n\
493 Optional second argument IGNORE specifies a name that is okay to use\n\
494 \(if it is in the sequence to be tried)\n\
495 even if a buffer with that name exists.")
496 (name, ignore)
497 register Lisp_Object name, ignore;
498 {
499 register Lisp_Object gentemp, tem;
500 int count;
501 char number[10];
502
503 CHECK_STRING (name, 0);
504
505 tem = Fget_buffer (name);
506 if (NILP (tem))
507 return name;
508
509 count = 1;
510 while (1)
511 {
512 sprintf (number, "<%d>", ++count);
513 gentemp = concat2 (name, build_string (number));
514 tem = Fstring_equal (gentemp, ignore);
515 if (!NILP (tem))
516 return gentemp;
517 tem = Fget_buffer (gentemp);
518 if (NILP (tem))
519 return gentemp;
520 }
521 }
522
523 \f
524 DEFUN ("buffer-name", Fbuffer_name, Sbuffer_name, 0, 1, 0,
525 "Return the name of BUFFER, as a string.\n\
526 With no argument or nil as argument, return the name of the current buffer.")
527 (buffer)
528 register Lisp_Object buffer;
529 {
530 if (NILP (buffer))
531 return current_buffer->name;
532 CHECK_BUFFER (buffer, 0);
533 return XBUFFER (buffer)->name;
534 }
535
536 DEFUN ("buffer-file-name", Fbuffer_file_name, Sbuffer_file_name, 0, 1, 0,
537 "Return name of file BUFFER is visiting, or nil if none.\n\
538 No argument or nil as argument means use the current buffer.")
539 (buffer)
540 register Lisp_Object buffer;
541 {
542 if (NILP (buffer))
543 return current_buffer->filename;
544 CHECK_BUFFER (buffer, 0);
545 return XBUFFER (buffer)->filename;
546 }
547
548 DEFUN ("buffer-base-buffer", Fbuffer_base_buffer, Sbuffer_base_buffer,
549 0, 1, 0,
550 "Return the base buffer of indirect buffer BUFFER.\n\
551 If BUFFER is not indirect, return nil.")
552 (buffer)
553 register Lisp_Object buffer;
554 {
555 struct buffer *base;
556 Lisp_Object base_buffer;
557
558 if (NILP (buffer))
559 base = current_buffer->base_buffer;
560 else
561 {
562 CHECK_BUFFER (buffer, 0);
563 base = XBUFFER (buffer)->base_buffer;
564 }
565
566 if (! base)
567 return Qnil;
568 XSETBUFFER (base_buffer, base);
569 return base_buffer;
570 }
571
572 DEFUN ("buffer-local-variables", Fbuffer_local_variables,
573 Sbuffer_local_variables, 0, 1, 0,
574 "Return an alist of variables that are buffer-local in BUFFER.\n\
575 Most elements look like (SYMBOL . VALUE), describing one variable.\n\
576 For a symbol that is locally unbound, just the symbol appears in the value.\n\
577 Note that storing new VALUEs in these elements doesn't change the variables.\n\
578 No argument or nil as argument means use current buffer as BUFFER.")
579 (buffer)
580 register Lisp_Object buffer;
581 {
582 register struct buffer *buf;
583 register Lisp_Object result;
584
585 if (NILP (buffer))
586 buf = current_buffer;
587 else
588 {
589 CHECK_BUFFER (buffer, 0);
590 buf = XBUFFER (buffer);
591 }
592
593 result = Qnil;
594
595 {
596 register Lisp_Object tail;
597 for (tail = buf->local_var_alist; CONSP (tail); tail = XCONS (tail)->cdr)
598 {
599 Lisp_Object val, elt;
600
601 elt = XCONS (tail)->car;
602
603 /* Reference each variable in the alist in buf.
604 If inquiring about the current buffer, this gets the current values,
605 so store them into the alist so the alist is up to date.
606 If inquiring about some other buffer, this swaps out any values
607 for that buffer, making the alist up to date automatically. */
608 val = find_symbol_value (XCONS (elt)->car);
609 /* Use the current buffer value only if buf is the current buffer. */
610 if (buf != current_buffer)
611 val = XCONS (elt)->cdr;
612
613 /* If symbol is unbound, put just the symbol in the list. */
614 if (EQ (val, Qunbound))
615 result = Fcons (XCONS (elt)->car, result);
616 /* Otherwise, put (symbol . value) in the list. */
617 else
618 result = Fcons (Fcons (XCONS (elt)->car, val), result);
619 }
620 }
621
622 /* Add on all the variables stored in special slots. */
623 {
624 register int offset, mask;
625
626 for (offset = (char *)&buffer_local_symbols.name - (char *)&buffer_local_symbols;
627 offset < sizeof (struct buffer);
628 offset += (sizeof (EMACS_INT))) /* sizeof EMACS_INT == sizeof Lisp_Object */
629 {
630 mask = XINT (*(Lisp_Object *)(offset + (char *)&buffer_local_flags));
631 if (mask == -1 || (buf->local_var_flags & mask))
632 if (SYMBOLP (*(Lisp_Object *)(offset
633 + (char *)&buffer_local_symbols)))
634 result = Fcons (Fcons (*((Lisp_Object *)
635 (offset + (char *)&buffer_local_symbols)),
636 *(Lisp_Object *)(offset + (char *)buf)),
637 result);
638 }
639 }
640
641 return result;
642 }
643
644 \f
645 DEFUN ("buffer-modified-p", Fbuffer_modified_p, Sbuffer_modified_p,
646 0, 1, 0,
647 "Return t if BUFFER was modified since its file was last read or saved.\n\
648 No argument or nil as argument means use current buffer as BUFFER.")
649 (buffer)
650 register Lisp_Object buffer;
651 {
652 register struct buffer *buf;
653 if (NILP (buffer))
654 buf = current_buffer;
655 else
656 {
657 CHECK_BUFFER (buffer, 0);
658 buf = XBUFFER (buffer);
659 }
660
661 return BUF_SAVE_MODIFF (buf) < BUF_MODIFF (buf) ? Qt : Qnil;
662 }
663
664 DEFUN ("set-buffer-modified-p", Fset_buffer_modified_p, Sset_buffer_modified_p,
665 1, 1, 0,
666 "Mark current buffer as modified or unmodified according to FLAG.\n\
667 A non-nil FLAG means mark the buffer modified.")
668 (flag)
669 register Lisp_Object flag;
670 {
671 register int already;
672 register Lisp_Object fn;
673
674 #ifdef CLASH_DETECTION
675 /* If buffer becoming modified, lock the file.
676 If buffer becoming unmodified, unlock the file. */
677
678 fn = current_buffer->file_truename;
679 if (!NILP (fn))
680 {
681 already = SAVE_MODIFF < MODIFF;
682 if (!already && !NILP (flag))
683 lock_file (fn);
684 else if (already && NILP (flag))
685 unlock_file (fn);
686 }
687 #endif /* CLASH_DETECTION */
688
689 SAVE_MODIFF = NILP (flag) ? MODIFF : 0;
690 update_mode_lines++;
691 return flag;
692 }
693
694 DEFUN ("buffer-modified-tick", Fbuffer_modified_tick, Sbuffer_modified_tick,
695 0, 1, 0,
696 "Return BUFFER's tick counter, incremented for each change in text.\n\
697 Each buffer has a tick counter which is incremented each time the text in\n\
698 that buffer is changed. It wraps around occasionally.\n\
699 No argument or nil as argument means use current buffer as BUFFER.")
700 (buffer)
701 register Lisp_Object buffer;
702 {
703 register struct buffer *buf;
704 if (NILP (buffer))
705 buf = current_buffer;
706 else
707 {
708 CHECK_BUFFER (buffer, 0);
709 buf = XBUFFER (buffer);
710 }
711
712 return make_number (BUF_MODIFF (buf));
713 }
714 \f
715 DEFUN ("rename-buffer", Frename_buffer, Srename_buffer, 1, 2,
716 "sRename buffer (to new name): \nP",
717 "Change current buffer's name to NEWNAME (a string).\n\
718 If second arg UNIQUE is nil or omitted, it is an error if a\n\
719 buffer named NEWNAME already exists.\n\
720 If UNIQUE is non-nil, come up with a new name using\n\
721 `generate-new-buffer-name'.\n\
722 Interactively, you can set UNIQUE with a prefix argument.\n\
723 We return the name we actually gave the buffer.\n\
724 This does not change the name of the visited file (if any).")
725 (newname, unique)
726 register Lisp_Object newname, unique;
727 {
728 register Lisp_Object tem, buf;
729
730 CHECK_STRING (newname, 0);
731
732 if (XSTRING (newname)->size == 0)
733 error ("Empty string is invalid as a buffer name");
734
735 tem = Fget_buffer (newname);
736 /* Don't short-circuit if UNIQUE is t. That is a useful way to rename
737 the buffer automatically so you can create another with the original name.
738 It makes UNIQUE equivalent to
739 (rename-buffer (generate-new-buffer-name NEWNAME)). */
740 if (NILP (unique) && XBUFFER (tem) == current_buffer)
741 return current_buffer->name;
742 if (!NILP (tem))
743 {
744 if (!NILP (unique))
745 newname = Fgenerate_new_buffer_name (newname, current_buffer->name);
746 else
747 error ("Buffer name `%s' is in use", XSTRING (newname)->data);
748 }
749
750 current_buffer->name = newname;
751
752 /* Catch redisplay's attention. Unless we do this, the mode lines for
753 any windows displaying current_buffer will stay unchanged. */
754 update_mode_lines++;
755
756 XSETBUFFER (buf, current_buffer);
757 Fsetcar (Frassq (buf, Vbuffer_alist), newname);
758 if (NILP (current_buffer->filename)
759 && !NILP (current_buffer->auto_save_file_name))
760 call0 (intern ("rename-auto-save-file"));
761 /* Refetch since that last call may have done GC. */
762 return current_buffer->name;
763 }
764
765 DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 2, 0,
766 "Return most recently selected buffer other than BUFFER.\n\
767 Buffers not visible in windows are preferred to visible buffers,\n\
768 unless optional second argument VISIBLE-OK is non-nil.\n\
769 If no other buffer exists, the buffer `*scratch*' is returned.\n\
770 If BUFFER is omitted or nil, some interesting buffer is returned.")
771 (buffer, visible_ok)
772 register Lisp_Object buffer, visible_ok;
773 {
774 register Lisp_Object tail, buf, notsogood, tem;
775 notsogood = Qnil;
776
777 for (tail = Vbuffer_alist; !NILP (tail); tail = Fcdr (tail))
778 {
779 buf = Fcdr (Fcar (tail));
780 if (EQ (buf, buffer))
781 continue;
782 if (XSTRING (XBUFFER (buf)->name)->data[0] == ' ')
783 continue;
784 #ifdef MULTI_FRAME
785 /* If the selected frame has a buffer_predicate,
786 disregard buffers that don't fit the predicate. */
787 tem = frame_buffer_predicate ();
788 if (!NILP (tem))
789 {
790 tem = call1 (tem, buf);
791 if (NILP (tem))
792 continue;
793 }
794 #endif
795
796 if (NILP (visible_ok))
797 tem = Fget_buffer_window (buf, Qt);
798 else
799 tem = Qnil;
800 if (NILP (tem))
801 return buf;
802 if (NILP (notsogood))
803 notsogood = buf;
804 }
805 if (!NILP (notsogood))
806 return notsogood;
807 return Fget_buffer_create (build_string ("*scratch*"));
808 }
809 \f
810 DEFUN ("buffer-disable-undo", Fbuffer_disable_undo, Sbuffer_disable_undo,
811 0, 1, "",
812 "Make BUFFER stop keeping undo information.\n\
813 No argument or nil as argument means do this for the current buffer.")
814 (buffer)
815 register Lisp_Object buffer;
816 {
817 Lisp_Object real_buffer;
818
819 if (NILP (buffer))
820 XSETBUFFER (real_buffer, current_buffer);
821 else
822 {
823 real_buffer = Fget_buffer (buffer);
824 if (NILP (real_buffer))
825 nsberror (buffer);
826 }
827
828 XBUFFER (real_buffer)->undo_list = Qt;
829
830 return Qnil;
831 }
832
833 DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, Sbuffer_enable_undo,
834 0, 1, "",
835 "Start keeping undo information for buffer BUFFER.\n\
836 No argument or nil as argument means do this for the current buffer.")
837 (buffer)
838 register Lisp_Object buffer;
839 {
840 Lisp_Object real_buffer;
841
842 if (NILP (buffer))
843 XSETBUFFER (real_buffer, current_buffer);
844 else
845 {
846 real_buffer = Fget_buffer (buffer);
847 if (NILP (real_buffer))
848 nsberror (buffer);
849 }
850
851 if (EQ (XBUFFER (real_buffer)->undo_list, Qt))
852 XBUFFER (real_buffer)->undo_list = Qnil;
853
854 return Qnil;
855 }
856
857 /*
858 DEFVAR_LISP ("kill-buffer-hook", no_cell, "\
859 Hook to be run (by `run-hooks', which see) when a buffer is killed.\n\
860 The buffer being killed will be current while the hook is running.\n\
861 See `kill-buffer'."
862 */
863 DEFUN ("kill-buffer", Fkill_buffer, Skill_buffer, 1, 1, "bKill buffer: ",
864 "Kill the buffer BUFFER.\n\
865 The argument may be a buffer or may be the name of a buffer.\n\
866 An argument of nil means kill the current buffer.\n\n\
867 Value is t if the buffer is actually killed, nil if user says no.\n\n\
868 The value of `kill-buffer-hook' (which may be local to that buffer),\n\
869 if not void, is a list of functions to be called, with no arguments,\n\
870 before the buffer is actually killed. The buffer to be killed is current\n\
871 when the hook functions are called.\n\n\
872 Any processes that have this buffer as the `process-buffer' are killed\n\
873 with `delete-process'.")
874 (bufname)
875 Lisp_Object bufname;
876 {
877 Lisp_Object buf;
878 register struct buffer *b;
879 register Lisp_Object tem;
880 register struct Lisp_Marker *m;
881 struct gcpro gcpro1, gcpro2;
882
883 if (NILP (bufname))
884 buf = Fcurrent_buffer ();
885 else
886 buf = Fget_buffer (bufname);
887 if (NILP (buf))
888 nsberror (bufname);
889
890 b = XBUFFER (buf);
891
892 /* Avoid trouble for buffer already dead. */
893 if (NILP (b->name))
894 return Qnil;
895
896 /* Query if the buffer is still modified. */
897 if (INTERACTIVE && !NILP (b->filename)
898 && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b))
899 {
900 GCPRO2 (buf, bufname);
901 tem = do_yes_or_no_p (format1 ("Buffer %s modified; kill anyway? ",
902 XSTRING (b->name)->data));
903 UNGCPRO;
904 if (NILP (tem))
905 return Qnil;
906 }
907
908 /* Run hooks with the buffer to be killed the current buffer. */
909 {
910 register Lisp_Object val;
911 int count = specpdl_ptr - specpdl;
912 Lisp_Object list;
913
914 record_unwind_protect (save_excursion_restore, save_excursion_save ());
915 set_buffer_internal (b);
916
917 /* First run the query functions; if any query is answered no,
918 don't kill the buffer. */
919 for (list = Vkill_buffer_query_functions; !NILP (list); list = Fcdr (list))
920 {
921 tem = call0 (Fcar (list));
922 if (NILP (tem))
923 return unbind_to (count, Qnil);
924 }
925
926 /* Then run the hooks. */
927 if (!NILP (Vrun_hooks))
928 call1 (Vrun_hooks, Qkill_buffer_hook);
929 unbind_to (count, Qnil);
930 }
931
932 /* We have no more questions to ask. Verify that it is valid
933 to kill the buffer. This must be done after the questions
934 since anything can happen within do_yes_or_no_p. */
935
936 /* Don't kill the minibuffer now current. */
937 if (EQ (buf, XWINDOW (minibuf_window)->buffer))
938 return Qnil;
939
940 if (NILP (b->name))
941 return Qnil;
942
943 /* When we kill a base buffer, kill all its indirect buffers.
944 We do it at this stage so nothing terrible happens if they
945 ask questions or their hooks get errors. */
946 if (! b->base_buffer)
947 {
948 struct buffer *other;
949
950 GCPRO1 (buf);
951
952 for (other = all_buffers; other; other = other->next)
953 /* all_buffers contains dead buffers too;
954 don't re-kill them. */
955 if (other->base_buffer == b && !NILP (other->name))
956 {
957 Lisp_Object buf;
958 XSETBUFFER (buf, other);
959 Fkill_buffer (buf);
960 }
961
962 UNGCPRO;
963 }
964
965 /* Make this buffer not be current.
966 In the process, notice if this is the sole visible buffer
967 and give up if so. */
968 if (b == current_buffer)
969 {
970 tem = Fother_buffer (buf, Qnil);
971 Fset_buffer (tem);
972 if (b == current_buffer)
973 return Qnil;
974 }
975
976 /* Now there is no question: we can kill the buffer. */
977
978 #ifdef CLASH_DETECTION
979 /* Unlock this buffer's file, if it is locked. */
980 unlock_buffer (b);
981 #endif /* CLASH_DETECTION */
982
983 kill_buffer_processes (buf);
984
985 tem = Vinhibit_quit;
986 Vinhibit_quit = Qt;
987 Vbuffer_alist = Fdelq (Frassq (buf, Vbuffer_alist), Vbuffer_alist);
988 Freplace_buffer_in_windows (buf);
989 Vinhibit_quit = tem;
990
991 /* Delete any auto-save file, if we saved it in this session. */
992 if (STRINGP (b->auto_save_file_name)
993 && b->auto_save_modified != 0)
994 {
995 Lisp_Object tem;
996 tem = Fsymbol_value (intern ("delete-auto-save-files"));
997 if (! NILP (tem))
998 internal_delete_file (b->auto_save_file_name);
999 }
1000
1001 if (b->base_buffer)
1002 {
1003 /* Unchain all markers that belong to this indirect buffer.
1004 Don't unchain the markers that belong to the base buffer
1005 or its other indirect buffers. */
1006 for (tem = BUF_MARKERS (b); !NILP (tem); )
1007 {
1008 Lisp_Object next;
1009 m = XMARKER (tem);
1010 next = m->chain;
1011 if (m->buffer == b)
1012 unchain_marker (tem);
1013 tem = next;
1014 }
1015 }
1016 else
1017 {
1018 /* Unchain all markers of this buffer and its indirect buffers.
1019 and leave them pointing nowhere. */
1020 for (tem = BUF_MARKERS (b); !NILP (tem); )
1021 {
1022 m = XMARKER (tem);
1023 m->buffer = 0;
1024 tem = m->chain;
1025 m->chain = Qnil;
1026 }
1027 BUF_MARKERS (b) = Qnil;
1028
1029 #ifdef USE_TEXT_PROPERTIES
1030 BUF_INTERVALS (b) = NULL_INTERVAL;
1031 #endif
1032
1033 /* Perhaps we should explicitly free the interval tree here... */
1034 }
1035
1036 /* Reset the local variables, so that this buffer's local values
1037 won't be protected from GC. They would be protected
1038 if they happened to remain encached in their symbols.
1039 This gets rid of them for certain. */
1040 swap_out_buffer_local_variables (b);
1041 reset_buffer_local_variables (b);
1042
1043 b->name = Qnil;
1044
1045 BLOCK_INPUT;
1046 if (! b->base_buffer)
1047 BUFFER_FREE (BUF_BEG_ADDR (b));
1048
1049 if (b->newline_cache)
1050 {
1051 free_region_cache (b->newline_cache);
1052 b->newline_cache = 0;
1053 }
1054 if (b->width_run_cache)
1055 {
1056 free_region_cache (b->width_run_cache);
1057 b->width_run_cache = 0;
1058 }
1059 b->width_table = Qnil;
1060 UNBLOCK_INPUT;
1061 b->undo_list = Qnil;
1062
1063 return Qt;
1064 }
1065 \f
1066 /* Move the assoc for buffer BUF to the front of buffer-alist. Since
1067 we do this each time BUF is selected visibly, the more recently
1068 selected buffers are always closer to the front of the list. This
1069 means that other_buffer is more likely to choose a relevant buffer. */
1070
1071 record_buffer (buf)
1072 Lisp_Object buf;
1073 {
1074 register Lisp_Object link, prev;
1075
1076 prev = Qnil;
1077 for (link = Vbuffer_alist; CONSP (link); link = XCONS (link)->cdr)
1078 {
1079 if (EQ (XCONS (XCONS (link)->car)->cdr, buf))
1080 break;
1081 prev = link;
1082 }
1083
1084 /* Effectively do Vbuffer_alist = Fdelq (link, Vbuffer_alist);
1085 we cannot use Fdelq itself here because it allows quitting. */
1086
1087 if (NILP (prev))
1088 Vbuffer_alist = XCONS (Vbuffer_alist)->cdr;
1089 else
1090 XCONS (prev)->cdr = XCONS (XCONS (prev)->cdr)->cdr;
1091
1092 XCONS(link)->cdr = Vbuffer_alist;
1093 Vbuffer_alist = link;
1094 }
1095
1096 DEFUN ("set-buffer-major-mode", Fset_buffer_major_mode, Sset_buffer_major_mode, 1, 1, 0,
1097 "Set an appropriate major mode for BUFFER, according to `default-major-mode'.\n\
1098 Use this function before selecting the buffer, since it may need to inspect\n\
1099 the current buffer's major mode.")
1100 (buf)
1101 Lisp_Object buf;
1102 {
1103 int count;
1104 Lisp_Object function;
1105
1106 function = buffer_defaults.major_mode;
1107 if (NILP (function) && NILP (Fget (current_buffer->major_mode, Qmode_class)))
1108 function = current_buffer->major_mode;
1109
1110 if (NILP (function) || EQ (function, Qfundamental_mode))
1111 return Qnil;
1112
1113 count = specpdl_ptr - specpdl;
1114
1115 /* To select a nonfundamental mode,
1116 select the buffer temporarily and then call the mode function. */
1117
1118 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1119
1120 Fset_buffer (buf);
1121 call0 (function);
1122
1123 return unbind_to (count, Qnil);
1124 }
1125
1126 DEFUN ("switch-to-buffer", Fswitch_to_buffer, Sswitch_to_buffer, 1, 2, "BSwitch to buffer: ",
1127 "Select buffer BUFFER in the current window.\n\
1128 BUFFER may be a buffer or a buffer name.\n\
1129 Optional second arg NORECORD non-nil means\n\
1130 do not put this buffer at the front of the list of recently selected ones.\n\
1131 \n\
1132 WARNING: This is NOT the way to work on another buffer temporarily\n\
1133 within a Lisp program! Use `set-buffer' instead. That avoids messing with\n\
1134 the window-buffer correspondences.")
1135 (bufname, norecord)
1136 Lisp_Object bufname, norecord;
1137 {
1138 register Lisp_Object buf;
1139 Lisp_Object tem;
1140
1141 if (EQ (minibuf_window, selected_window))
1142 error ("Cannot switch buffers in minibuffer window");
1143 tem = Fwindow_dedicated_p (selected_window);
1144 if (!NILP (tem))
1145 error ("Cannot switch buffers in a dedicated window");
1146
1147 if (NILP (bufname))
1148 buf = Fother_buffer (Fcurrent_buffer (), Qnil);
1149 else
1150 {
1151 buf = Fget_buffer (bufname);
1152 if (NILP (buf))
1153 {
1154 buf = Fget_buffer_create (bufname);
1155 Fset_buffer_major_mode (buf);
1156 }
1157 }
1158 Fset_buffer (buf);
1159 if (NILP (norecord))
1160 record_buffer (buf);
1161
1162 Fset_window_buffer (EQ (selected_window, minibuf_window)
1163 ? Fnext_window (minibuf_window, Qnil, Qnil)
1164 : selected_window,
1165 buf);
1166
1167 return buf;
1168 }
1169
1170 DEFUN ("pop-to-buffer", Fpop_to_buffer, Spop_to_buffer, 1, 2, 0,
1171 "Select buffer BUFFER in some window, preferably a different one.\n\
1172 If BUFFER is nil, then some other buffer is chosen.\n\
1173 If `pop-up-windows' is non-nil, windows can be split to do this.\n\
1174 If optional second arg OTHER-WINDOW is non-nil, insist on finding another\n\
1175 window even if BUFFER is already visible in the selected window.")
1176 (bufname, other)
1177 Lisp_Object bufname, other;
1178 {
1179 register Lisp_Object buf;
1180 if (NILP (bufname))
1181 buf = Fother_buffer (Fcurrent_buffer (), Qnil);
1182 else
1183 {
1184 buf = Fget_buffer (bufname);
1185 if (NILP (buf))
1186 {
1187 buf = Fget_buffer_create (bufname);
1188 Fset_buffer_major_mode (buf);
1189 }
1190 }
1191 Fset_buffer (buf);
1192 record_buffer (buf);
1193 Fselect_window (Fdisplay_buffer (buf, other));
1194 return buf;
1195 }
1196
1197 DEFUN ("current-buffer", Fcurrent_buffer, Scurrent_buffer, 0, 0, 0,
1198 "Return the current buffer as a Lisp object.")
1199 ()
1200 {
1201 register Lisp_Object buf;
1202 XSETBUFFER (buf, current_buffer);
1203 return buf;
1204 }
1205 \f
1206 /* Set the current buffer to B. */
1207
1208 void
1209 set_buffer_internal (b)
1210 register struct buffer *b;
1211 {
1212 register struct buffer *old_buf;
1213 register Lisp_Object tail, valcontents;
1214 Lisp_Object tem;
1215
1216 if (current_buffer == b)
1217 return;
1218
1219 windows_or_buffers_changed = 1;
1220 set_buffer_internal_1 (b);
1221 }
1222
1223 /* Set the current buffer to B, and do not set windows_or_buffers_changed.
1224 This is used by redisplay. */
1225
1226 void
1227 set_buffer_internal_1 (b)
1228 register struct buffer *b;
1229 {
1230 register struct buffer *old_buf;
1231 register Lisp_Object tail, valcontents;
1232 Lisp_Object tem;
1233
1234 if (current_buffer == b)
1235 return;
1236
1237 old_buf = current_buffer;
1238 current_buffer = b;
1239 last_known_column_point = -1; /* invalidate indentation cache */
1240
1241 if (old_buf)
1242 {
1243 /* Put the undo list back in the base buffer, so that it appears
1244 that an indirect buffer shares the undo list of its base. */
1245 if (old_buf->base_buffer)
1246 old_buf->base_buffer->undo_list = old_buf->undo_list;
1247
1248 /* If the old current buffer has markers to record PT, BEGV and ZV
1249 when it is not current, update them now. */
1250 if (! NILP (old_buf->pt_marker))
1251 {
1252 Lisp_Object obuf;
1253 XSETBUFFER (obuf, old_buf);
1254 Fset_marker (old_buf->pt_marker, BUF_PT (old_buf), obuf);
1255 }
1256 if (! NILP (old_buf->begv_marker))
1257 {
1258 Lisp_Object obuf;
1259 XSETBUFFER (obuf, old_buf);
1260 Fset_marker (old_buf->begv_marker, BUF_BEGV (old_buf), obuf);
1261 }
1262 if (! NILP (old_buf->zv_marker))
1263 {
1264 Lisp_Object obuf;
1265 XSETBUFFER (obuf, old_buf);
1266 Fset_marker (old_buf->zv_marker, BUF_ZV (old_buf), obuf);
1267 }
1268 }
1269
1270 /* Get the undo list from the base buffer, so that it appears
1271 that an indirect buffer shares the undo list of its base. */
1272 if (b->base_buffer)
1273 b->undo_list = b->base_buffer->undo_list;
1274
1275 /* If the new current buffer has markers to record PT, BEGV and ZV
1276 when it is not current, fetch them now. */
1277 if (! NILP (b->pt_marker))
1278 BUF_PT (b) = marker_position (b->pt_marker);
1279 if (! NILP (b->begv_marker))
1280 BUF_BEGV (b) = marker_position (b->begv_marker);
1281 if (! NILP (b->zv_marker))
1282 BUF_ZV (b) = marker_position (b->zv_marker);
1283
1284 /* Look down buffer's list of local Lisp variables
1285 to find and update any that forward into C variables. */
1286
1287 for (tail = b->local_var_alist; !NILP (tail); tail = XCONS (tail)->cdr)
1288 {
1289 valcontents = XSYMBOL (XCONS (XCONS (tail)->car)->car)->value;
1290 if ((BUFFER_LOCAL_VALUEP (valcontents)
1291 || SOME_BUFFER_LOCAL_VALUEP (valcontents))
1292 && (tem = XBUFFER_LOCAL_VALUE (valcontents)->car,
1293 (BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem))))
1294 /* Just reference the variable
1295 to cause it to become set for this buffer. */
1296 Fsymbol_value (XCONS (XCONS (tail)->car)->car);
1297 }
1298
1299 /* Do the same with any others that were local to the previous buffer */
1300
1301 if (old_buf)
1302 for (tail = old_buf->local_var_alist; !NILP (tail); tail = XCONS (tail)->cdr)
1303 {
1304 valcontents = XSYMBOL (XCONS (XCONS (tail)->car)->car)->value;
1305 if ((BUFFER_LOCAL_VALUEP (valcontents)
1306 || SOME_BUFFER_LOCAL_VALUEP (valcontents))
1307 && (tem = XBUFFER_LOCAL_VALUE (valcontents)->car,
1308 (BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem))))
1309 /* Just reference the variable
1310 to cause it to become set for this buffer. */
1311 Fsymbol_value (XCONS (XCONS (tail)->car)->car);
1312 }
1313 }
1314
1315 /* Switch to buffer B temporarily for redisplay purposes.
1316 This avoids certain things that don't need to be done within redisplay. */
1317
1318 void
1319 set_buffer_temp (b)
1320 struct buffer *b;
1321 {
1322 register struct buffer *old_buf;
1323
1324 if (current_buffer == b)
1325 return;
1326
1327 old_buf = current_buffer;
1328 current_buffer = b;
1329
1330 if (old_buf)
1331 {
1332 /* If the old current buffer has markers to record PT, BEGV and ZV
1333 when it is not current, update them now. */
1334 if (! NILP (old_buf->pt_marker))
1335 {
1336 Lisp_Object obuf;
1337 XSETBUFFER (obuf, old_buf);
1338 Fset_marker (old_buf->pt_marker, BUF_PT (old_buf), obuf);
1339 }
1340 if (! NILP (old_buf->begv_marker))
1341 {
1342 Lisp_Object obuf;
1343 XSETBUFFER (obuf, old_buf);
1344 Fset_marker (old_buf->begv_marker, BUF_BEGV (old_buf), obuf);
1345 }
1346 if (! NILP (old_buf->zv_marker))
1347 {
1348 Lisp_Object obuf;
1349 XSETBUFFER (obuf, old_buf);
1350 Fset_marker (old_buf->zv_marker, BUF_ZV (old_buf), obuf);
1351 }
1352 }
1353
1354 /* If the new current buffer has markers to record PT, BEGV and ZV
1355 when it is not current, fetch them now. */
1356 if (! NILP (b->pt_marker))
1357 BUF_PT (b) = marker_position (b->pt_marker);
1358 if (! NILP (b->begv_marker))
1359 BUF_BEGV (b) = marker_position (b->begv_marker);
1360 if (! NILP (b->zv_marker))
1361 BUF_ZV (b) = marker_position (b->zv_marker);
1362 }
1363
1364 DEFUN ("set-buffer", Fset_buffer, Sset_buffer, 1, 1, 0,
1365 "Make the buffer BUFFER current for editing operations.\n\
1366 BUFFER may be a buffer or the name of an existing buffer.\n\
1367 See also `save-excursion' when you want to make a buffer current temporarily.\n\
1368 This function does not display the buffer, so its effect ends\n\
1369 when the current command terminates.\n\
1370 Use `switch-to-buffer' or `pop-to-buffer' to switch buffers permanently.")
1371 (bufname)
1372 register Lisp_Object bufname;
1373 {
1374 register Lisp_Object buffer;
1375 buffer = Fget_buffer (bufname);
1376 if (NILP (buffer))
1377 nsberror (bufname);
1378 if (NILP (XBUFFER (buffer)->name))
1379 error ("Selecting deleted buffer");
1380 set_buffer_internal (XBUFFER (buffer));
1381 return buffer;
1382 }
1383 \f
1384 DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only,
1385 Sbarf_if_buffer_read_only, 0, 0, 0,
1386 "Signal a `buffer-read-only' error if the current buffer is read-only.")
1387 ()
1388 {
1389 if (!NILP (current_buffer->read_only)
1390 && NILP (Vinhibit_read_only))
1391 Fsignal (Qbuffer_read_only, (Fcons (Fcurrent_buffer (), Qnil)));
1392 return Qnil;
1393 }
1394
1395 DEFUN ("bury-buffer", Fbury_buffer, Sbury_buffer, 0, 1, "",
1396 "Put BUFFER at the end of the list of all buffers.\n\
1397 There it is the least likely candidate for `other-buffer' to return;\n\
1398 thus, the least likely buffer for \\[switch-to-buffer] to select by default.\n\
1399 If BUFFER is nil or omitted, bury the current buffer.\n\
1400 Also, if BUFFER is nil or omitted, remove the current buffer from the\n\
1401 selected window if it is displayed there.")
1402 (buf)
1403 register Lisp_Object buf;
1404 {
1405 /* Figure out what buffer we're going to bury. */
1406 if (NILP (buf))
1407 {
1408 XSETBUFFER (buf, current_buffer);
1409
1410 /* If we're burying the current buffer, unshow it. */
1411 Fswitch_to_buffer (Fother_buffer (buf, Qnil), Qnil);
1412 }
1413 else
1414 {
1415 Lisp_Object buf1;
1416
1417 buf1 = Fget_buffer (buf);
1418 if (NILP (buf1))
1419 nsberror (buf);
1420 buf = buf1;
1421 }
1422
1423 /* Move buf to the end of the buffer list. */
1424 {
1425 register Lisp_Object aelt, link;
1426
1427 aelt = Frassq (buf, Vbuffer_alist);
1428 link = Fmemq (aelt, Vbuffer_alist);
1429 Vbuffer_alist = Fdelq (aelt, Vbuffer_alist);
1430 XCONS (link)->cdr = Qnil;
1431 Vbuffer_alist = nconc2 (Vbuffer_alist, link);
1432 }
1433
1434 return Qnil;
1435 }
1436 \f
1437 DEFUN ("erase-buffer", Ferase_buffer, Serase_buffer, 0, 0, "*",
1438 "Delete the entire contents of the current buffer.\n\
1439 Any narrowing restriction in effect (see `narrow-to-region') is removed,\n\
1440 so the buffer is truly empty after this.")
1441 ()
1442 {
1443 Fwiden ();
1444 del_range (BEG, Z);
1445 current_buffer->last_window_start = 1;
1446 /* Prevent warnings, or suspension of auto saving, that would happen
1447 if future size is less than past size. Use of erase-buffer
1448 implies that the future text is not really related to the past text. */
1449 XSETFASTINT (current_buffer->save_length, 0);
1450 return Qnil;
1451 }
1452
1453 validate_region (b, e)
1454 register Lisp_Object *b, *e;
1455 {
1456 CHECK_NUMBER_COERCE_MARKER (*b, 0);
1457 CHECK_NUMBER_COERCE_MARKER (*e, 1);
1458
1459 if (XINT (*b) > XINT (*e))
1460 {
1461 Lisp_Object tem;
1462 tem = *b; *b = *e; *e = tem;
1463 }
1464
1465 if (!(BEGV <= XINT (*b) && XINT (*b) <= XINT (*e)
1466 && XINT (*e) <= ZV))
1467 args_out_of_range (*b, *e);
1468 }
1469 \f
1470 DEFUN ("kill-all-local-variables", Fkill_all_local_variables, Skill_all_local_variables,
1471 0, 0, 0,
1472 "Switch to Fundamental mode by killing current buffer's local variables.\n\
1473 Most local variable bindings are eliminated so that the default values\n\
1474 become effective once more. Also, the syntax table is set from\n\
1475 `standard-syntax-table', the local keymap is set to nil,\n\
1476 and the abbrev table from `fundamental-mode-abbrev-table'.\n\
1477 This function also forces redisplay of the mode line.\n\
1478 \n\
1479 Every function to select a new major mode starts by\n\
1480 calling this function.\n\n\
1481 As a special exception, local variables whose names have\n\
1482 a non-nil `permanent-local' property are not eliminated by this function.\n\
1483 \n\
1484 The first thing this function does is run\n\
1485 the normal hook `change-major-mode-hook'.")
1486 ()
1487 {
1488 register Lisp_Object alist, sym, tem;
1489 Lisp_Object oalist;
1490
1491 if (!NILP (Vrun_hooks))
1492 call1 (Vrun_hooks, intern ("change-major-mode-hook"));
1493 oalist = current_buffer->local_var_alist;
1494
1495 /* Make sure none of the bindings in oalist
1496 remain swapped in, in their symbols. */
1497
1498 swap_out_buffer_local_variables (current_buffer);
1499
1500 /* Actually eliminate all local bindings of this buffer. */
1501
1502 reset_buffer_local_variables (current_buffer);
1503
1504 /* Redisplay mode lines; we are changing major mode. */
1505
1506 update_mode_lines++;
1507
1508 /* Any which are supposed to be permanent,
1509 make local again, with the same values they had. */
1510
1511 for (alist = oalist; !NILP (alist); alist = XCONS (alist)->cdr)
1512 {
1513 sym = XCONS (XCONS (alist)->car)->car;
1514 tem = Fget (sym, Qpermanent_local);
1515 if (! NILP (tem))
1516 {
1517 Fmake_local_variable (sym);
1518 Fset (sym, XCONS (XCONS (alist)->car)->cdr);
1519 }
1520 }
1521
1522 /* Force mode-line redisplay. Useful here because all major mode
1523 commands call this function. */
1524 update_mode_lines++;
1525
1526 return Qnil;
1527 }
1528
1529 /* Make sure no local variables remain set up with buffer B
1530 for their current values. */
1531
1532 static void
1533 swap_out_buffer_local_variables (b)
1534 struct buffer *b;
1535 {
1536 Lisp_Object oalist, alist, sym, tem, buffer;
1537
1538 XSETBUFFER (buffer, b);
1539 oalist = b->local_var_alist;
1540
1541 for (alist = oalist; !NILP (alist); alist = XCONS (alist)->cdr)
1542 {
1543 sym = XCONS (XCONS (alist)->car)->car;
1544
1545 /* Need not do anything if some other buffer's binding is now encached. */
1546 tem = XCONS (XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->cdr)->car;
1547 if (XBUFFER (tem) == current_buffer)
1548 {
1549 /* Symbol is set up for this buffer's old local value.
1550 Set it up for the current buffer with the default value. */
1551
1552 tem = XCONS (XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->cdr)->cdr;
1553 /* Store the symbol's current value into the alist entry
1554 it is currently set up for. This is so that, if the
1555 local is marked permanent, and we make it local again
1556 later in Fkill_all_local_variables, we don't lose the value. */
1557 XCONS (XCONS (tem)->car)->cdr
1558 = do_symval_forwarding (XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->car);
1559 /* Switch to the symbol's default-value alist entry. */
1560 XCONS (tem)->car = tem;
1561 /* Mark it as current for buffer B. */
1562 XCONS (XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->cdr)->car
1563 = buffer;
1564 /* Store the current value into any forwarding in the symbol. */
1565 store_symval_forwarding (sym, XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->car,
1566 XCONS (tem)->cdr);
1567 }
1568 }
1569 }
1570 \f
1571 /* Find all the overlays in the current buffer that contain position POS.
1572 Return the number found, and store them in a vector in *VEC_PTR.
1573 Store in *LEN_PTR the size allocated for the vector.
1574 Store in *NEXT_PTR the next position after POS where an overlay starts,
1575 or ZV if there are no more overlays.
1576 Store in *PREV_PTR the previous position before POS where an overlay ends,
1577 or BEGV if there are no previous overlays.
1578 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
1579
1580 *VEC_PTR and *LEN_PTR should contain a valid vector and size
1581 when this function is called.
1582
1583 If EXTEND is non-zero, we make the vector bigger if necessary.
1584 If EXTEND is zero, we never extend the vector,
1585 and we store only as many overlays as will fit.
1586 But we still return the total number of overlays. */
1587
1588 int
1589 overlays_at (pos, extend, vec_ptr, len_ptr, next_ptr, prev_ptr)
1590 int pos;
1591 int extend;
1592 Lisp_Object **vec_ptr;
1593 int *len_ptr;
1594 int *next_ptr;
1595 int *prev_ptr;
1596 {
1597 Lisp_Object tail, overlay, start, end, result;
1598 int idx = 0;
1599 int len = *len_ptr;
1600 Lisp_Object *vec = *vec_ptr;
1601 int next = ZV;
1602 int prev = BEGV;
1603 int inhibit_storing = 0;
1604
1605 for (tail = current_buffer->overlays_before;
1606 GC_CONSP (tail);
1607 tail = XCONS (tail)->cdr)
1608 {
1609 int startpos, endpos;
1610
1611 overlay = XCONS (tail)->car;
1612
1613 start = OVERLAY_START (overlay);
1614 end = OVERLAY_END (overlay);
1615 endpos = OVERLAY_POSITION (end);
1616 if (endpos < pos)
1617 {
1618 if (prev < endpos)
1619 prev = endpos;
1620 break;
1621 }
1622 if (endpos == pos)
1623 continue;
1624 startpos = OVERLAY_POSITION (start);
1625 if (startpos <= pos)
1626 {
1627 if (idx == len)
1628 {
1629 /* The supplied vector is full.
1630 Either make it bigger, or don't store any more in it. */
1631 if (extend)
1632 {
1633 *len_ptr = len *= 2;
1634 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
1635 *vec_ptr = vec;
1636 }
1637 else
1638 inhibit_storing = 1;
1639 }
1640
1641 if (!inhibit_storing)
1642 vec[idx] = overlay;
1643 /* Keep counting overlays even if we can't return them all. */
1644 idx++;
1645 }
1646 else if (startpos < next)
1647 next = startpos;
1648 }
1649
1650 for (tail = current_buffer->overlays_after;
1651 GC_CONSP (tail);
1652 tail = XCONS (tail)->cdr)
1653 {
1654 int startpos, endpos;
1655
1656 overlay = XCONS (tail)->car;
1657
1658 start = OVERLAY_START (overlay);
1659 end = OVERLAY_END (overlay);
1660 startpos = OVERLAY_POSITION (start);
1661 if (pos < startpos)
1662 {
1663 if (startpos < next)
1664 next = startpos;
1665 break;
1666 }
1667 endpos = OVERLAY_POSITION (end);
1668 if (pos < endpos)
1669 {
1670 if (idx == len)
1671 {
1672 if (extend)
1673 {
1674 *len_ptr = len *= 2;
1675 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
1676 *vec_ptr = vec;
1677 }
1678 else
1679 inhibit_storing = 1;
1680 }
1681
1682 if (!inhibit_storing)
1683 vec[idx] = overlay;
1684 idx++;
1685 }
1686 else if (endpos < pos && endpos > prev)
1687 prev = endpos;
1688 }
1689
1690 if (next_ptr)
1691 *next_ptr = next;
1692 if (prev_ptr)
1693 *prev_ptr = prev;
1694 return idx;
1695 }
1696 \f
1697 /* Find all the overlays in the current buffer that overlap the range BEG-END
1698 or are empty at BEG.
1699
1700 Return the number found, and store them in a vector in *VEC_PTR.
1701 Store in *LEN_PTR the size allocated for the vector.
1702 Store in *NEXT_PTR the next position after POS where an overlay starts,
1703 or ZV if there are no more overlays.
1704 Store in *PREV_PTR the previous position before POS where an overlay ends,
1705 or BEGV if there are no previous overlays.
1706 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
1707
1708 *VEC_PTR and *LEN_PTR should contain a valid vector and size
1709 when this function is called.
1710
1711 If EXTEND is non-zero, we make the vector bigger if necessary.
1712 If EXTEND is zero, we never extend the vector,
1713 and we store only as many overlays as will fit.
1714 But we still return the total number of overlays. */
1715
1716 int
1717 overlays_in (beg, end, extend, vec_ptr, len_ptr, next_ptr, prev_ptr)
1718 int beg, end;
1719 int extend;
1720 Lisp_Object **vec_ptr;
1721 int *len_ptr;
1722 int *next_ptr;
1723 int *prev_ptr;
1724 {
1725 Lisp_Object tail, overlay, ostart, oend, result;
1726 int idx = 0;
1727 int len = *len_ptr;
1728 Lisp_Object *vec = *vec_ptr;
1729 int next = ZV;
1730 int prev = BEGV;
1731 int inhibit_storing = 0;
1732
1733 for (tail = current_buffer->overlays_before;
1734 GC_CONSP (tail);
1735 tail = XCONS (tail)->cdr)
1736 {
1737 int startpos, endpos;
1738
1739 overlay = XCONS (tail)->car;
1740
1741 ostart = OVERLAY_START (overlay);
1742 oend = OVERLAY_END (overlay);
1743 endpos = OVERLAY_POSITION (oend);
1744 if (endpos < beg)
1745 {
1746 if (prev < endpos)
1747 prev = endpos;
1748 break;
1749 }
1750 startpos = OVERLAY_POSITION (ostart);
1751 /* Count an interval if it either overlaps the range
1752 or is empty at the start of the range. */
1753 if ((beg < endpos && startpos < end)
1754 || (startpos == endpos && beg == endpos))
1755 {
1756 if (idx == len)
1757 {
1758 /* The supplied vector is full.
1759 Either make it bigger, or don't store any more in it. */
1760 if (extend)
1761 {
1762 *len_ptr = len *= 2;
1763 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
1764 *vec_ptr = vec;
1765 }
1766 else
1767 inhibit_storing = 1;
1768 }
1769
1770 if (!inhibit_storing)
1771 vec[idx] = overlay;
1772 /* Keep counting overlays even if we can't return them all. */
1773 idx++;
1774 }
1775 else if (startpos < next)
1776 next = startpos;
1777 }
1778
1779 for (tail = current_buffer->overlays_after;
1780 GC_CONSP (tail);
1781 tail = XCONS (tail)->cdr)
1782 {
1783 int startpos, endpos;
1784
1785 overlay = XCONS (tail)->car;
1786
1787 ostart = OVERLAY_START (overlay);
1788 oend = OVERLAY_END (overlay);
1789 startpos = OVERLAY_POSITION (ostart);
1790 if (end < startpos)
1791 {
1792 if (startpos < next)
1793 next = startpos;
1794 break;
1795 }
1796 endpos = OVERLAY_POSITION (oend);
1797 /* Count an interval if it either overlaps the range
1798 or is empty at the start of the range. */
1799 if ((beg < endpos && startpos < end)
1800 || (startpos == endpos && beg == endpos))
1801 {
1802 if (idx == len)
1803 {
1804 if (extend)
1805 {
1806 *len_ptr = len *= 2;
1807 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
1808 *vec_ptr = vec;
1809 }
1810 else
1811 inhibit_storing = 1;
1812 }
1813
1814 if (!inhibit_storing)
1815 vec[idx] = overlay;
1816 idx++;
1817 }
1818 else if (endpos < beg && endpos > prev)
1819 prev = endpos;
1820 }
1821
1822 if (next_ptr)
1823 *next_ptr = next;
1824 if (prev_ptr)
1825 *prev_ptr = prev;
1826 return idx;
1827 }
1828 \f
1829 /* Fast function to just test if we're at an overlay boundary. */
1830 int
1831 overlay_touches_p (pos)
1832 int pos;
1833 {
1834 Lisp_Object tail, overlay;
1835
1836 for (tail = current_buffer->overlays_before; GC_CONSP (tail);
1837 tail = XCONS (tail)->cdr)
1838 {
1839 int endpos;
1840
1841 overlay = XCONS (tail)->car;
1842 if (!GC_OVERLAYP (overlay))
1843 abort ();
1844
1845 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
1846 if (endpos < pos)
1847 break;
1848 if (endpos == pos || OVERLAY_POSITION (OVERLAY_START (overlay)) == pos)
1849 return 1;
1850 }
1851
1852 for (tail = current_buffer->overlays_after; GC_CONSP (tail);
1853 tail = XCONS (tail)->cdr)
1854 {
1855 int startpos;
1856
1857 overlay = XCONS (tail)->car;
1858 if (!GC_OVERLAYP (overlay))
1859 abort ();
1860
1861 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
1862 if (pos < startpos)
1863 break;
1864 if (startpos == pos || OVERLAY_POSITION (OVERLAY_END (overlay)) == pos)
1865 return 1;
1866 }
1867 return 0;
1868 }
1869 \f
1870 struct sortvec
1871 {
1872 Lisp_Object overlay;
1873 int beg, end;
1874 int priority;
1875 };
1876
1877 static int
1878 compare_overlays (s1, s2)
1879 struct sortvec *s1, *s2;
1880 {
1881 if (s1->priority != s2->priority)
1882 return s1->priority - s2->priority;
1883 if (s1->beg != s2->beg)
1884 return s1->beg - s2->beg;
1885 if (s1->end != s2->end)
1886 return s2->end - s1->end;
1887 return 0;
1888 }
1889
1890 /* Sort an array of overlays by priority. The array is modified in place.
1891 The return value is the new size; this may be smaller than the original
1892 size if some of the overlays were invalid or were window-specific. */
1893 int
1894 sort_overlays (overlay_vec, noverlays, w)
1895 Lisp_Object *overlay_vec;
1896 int noverlays;
1897 struct window *w;
1898 {
1899 int i, j;
1900 struct sortvec *sortvec;
1901 sortvec = (struct sortvec *) alloca (noverlays * sizeof (struct sortvec));
1902
1903 /* Put the valid and relevant overlays into sortvec. */
1904
1905 for (i = 0, j = 0; i < noverlays; i++)
1906 {
1907 Lisp_Object tem;
1908 Lisp_Object overlay;
1909
1910 overlay = overlay_vec[i];
1911 if (OVERLAY_VALID (overlay)
1912 && OVERLAY_POSITION (OVERLAY_START (overlay)) > 0
1913 && OVERLAY_POSITION (OVERLAY_END (overlay)) > 0)
1914 {
1915 /* If we're interested in a specific window, then ignore
1916 overlays that are limited to some other window. */
1917 if (w)
1918 {
1919 Lisp_Object window;
1920
1921 window = Foverlay_get (overlay, Qwindow);
1922 if (WINDOWP (window) && XWINDOW (window) != w)
1923 continue;
1924 }
1925
1926 /* This overlay is good and counts: put it into sortvec. */
1927 sortvec[j].overlay = overlay;
1928 sortvec[j].beg = OVERLAY_POSITION (OVERLAY_START (overlay));
1929 sortvec[j].end = OVERLAY_POSITION (OVERLAY_END (overlay));
1930 tem = Foverlay_get (overlay, Qpriority);
1931 if (INTEGERP (tem))
1932 sortvec[j].priority = XINT (tem);
1933 else
1934 sortvec[j].priority = 0;
1935 j++;
1936 }
1937 }
1938 noverlays = j;
1939
1940 /* Sort the overlays into the proper order: increasing priority. */
1941
1942 if (noverlays > 1)
1943 qsort (sortvec, noverlays, sizeof (struct sortvec), compare_overlays);
1944
1945 for (i = 0; i < noverlays; i++)
1946 overlay_vec[i] = sortvec[i].overlay;
1947 return (noverlays);
1948 }
1949 \f
1950 struct sortstr
1951 {
1952 Lisp_Object string;
1953 int size;
1954 int priority;
1955 };
1956
1957 /* A comparison function suitable for passing to qsort. */
1958 static int
1959 cmp_for_strings (as1, as2)
1960 char *as1, *as2;
1961 {
1962 struct sortstr *s1 = (struct sortstr *)as1;
1963 struct sortstr *s2 = (struct sortstr *)as2;
1964 if (s1->size != s2->size)
1965 return s2->size - s1->size;
1966 if (s1->priority != s2->priority)
1967 return s1->priority - s2->priority;
1968 return 0;
1969 }
1970
1971 /* Buffers for storing the overlays touching a given position.
1972 These are expanded as needed, but never freed. */
1973 static struct sortstr *overlay_heads, *overlay_tails;
1974 static char *overlay_str_buf;
1975
1976 /* Allocated length of those buffers. */
1977 static int overlay_heads_len, overlay_tails_len, overlay_str_len;
1978
1979 /* Return the concatenation of the strings associated with overlays that
1980 begin or end at POS, ignoring overlays that are specific to a window
1981 other than W. The strings are concatenated in the appropriate order:
1982 shorter overlays nest inside longer ones, and higher priority inside
1983 lower. Returns the string length, and stores the contents indirectly
1984 through PSTR, if that variable is non-null. The string may be
1985 overwritten by subsequent calls. */
1986 int
1987 overlay_strings (pos, w, pstr)
1988 int pos;
1989 struct window *w;
1990 char **pstr;
1991 {
1992 Lisp_Object ov, overlay, window, str, tem;
1993 int ntail = 0, nhead = 0;
1994 int total = 0;
1995 int startpos, endpos;
1996
1997 for (ov = current_buffer->overlays_before; CONSP (ov); ov = XCONS (ov)->cdr)
1998 {
1999 overlay = XCONS (ov)->car;
2000 if (!OVERLAYP (overlay))
2001 abort ();
2002
2003 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2004 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2005 if (endpos < pos)
2006 break;
2007 if (endpos != pos && startpos != pos)
2008 continue;
2009 window = Foverlay_get (overlay, Qwindow);
2010 if (WINDOWP (window) && XWINDOW (window) != w)
2011 continue;
2012 if (endpos == pos)
2013 {
2014 str = Foverlay_get (overlay, Qafter_string);
2015 if (STRINGP (str))
2016 {
2017 if (ntail == overlay_tails_len)
2018 {
2019 if (! overlay_tails)
2020 {
2021 overlay_tails_len = 5;
2022 overlay_tails = ((struct sortstr *)
2023 xmalloc (5 * sizeof (struct sortstr)));
2024 }
2025 else
2026 {
2027 overlay_tails_len *= 2;
2028 overlay_tails = ((struct sortstr *)
2029 xrealloc (overlay_tails,
2030 (overlay_tails_len
2031 * sizeof (struct sortstr))));
2032 }
2033 }
2034 overlay_tails[ntail].string = str;
2035 overlay_tails[ntail].size = endpos - startpos;
2036 tem = Foverlay_get (overlay, Qpriority);
2037 overlay_tails[ntail].priority = (INTEGERP (tem) ? XINT (tem) : 0);
2038 ntail++;
2039 total += XSTRING (str)->size;
2040 }
2041 }
2042 if (startpos == pos)
2043 {
2044 str = Foverlay_get (overlay, Qbefore_string);
2045 if (STRINGP (str))
2046 {
2047 if (nhead == overlay_heads_len)
2048 {
2049 if (! overlay_heads)
2050 {
2051 overlay_heads_len = 5;
2052 overlay_heads = ((struct sortstr *)
2053 xmalloc (5 * sizeof (struct sortstr)));
2054 }
2055 else
2056 {
2057 overlay_heads_len *= 2;
2058 overlay_heads = ((struct sortstr *)
2059 xrealloc (overlay_heads,
2060 (overlay_heads_len
2061 * sizeof (struct sortstr))));
2062 }
2063 }
2064 overlay_heads[nhead].string = str;
2065 overlay_heads[nhead].size = endpos - startpos;
2066 tem = Foverlay_get (overlay, Qpriority);
2067 overlay_heads[nhead].priority = (INTEGERP (tem) ? XINT (tem) : 0);
2068 nhead++;
2069 total += XSTRING (str)->size;
2070 }
2071 }
2072 }
2073 for (ov = current_buffer->overlays_after; CONSP (ov); ov = XCONS (ov)->cdr)
2074 {
2075 overlay = XCONS (ov)->car;
2076 if (!OVERLAYP (overlay))
2077 abort ();
2078
2079 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2080 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2081 if (startpos > pos)
2082 break;
2083 if (endpos == pos)
2084 {
2085 str = Foverlay_get (overlay, Qafter_string);
2086 if (STRINGP (str))
2087 {
2088 if (ntail == overlay_tails_len)
2089 {
2090 if (! overlay_tails)
2091 {
2092 overlay_tails_len = 5;
2093 overlay_tails = ((struct sortstr *)
2094 xmalloc (5 * sizeof (struct sortstr)));
2095 }
2096 else
2097 {
2098 overlay_tails_len *= 2;
2099 overlay_tails = ((struct sortstr *)
2100 xrealloc (overlay_tails,
2101 (overlay_tails_len
2102 * sizeof (struct sortstr))));
2103 }
2104 }
2105 overlay_tails[ntail].string = str;
2106 overlay_tails[ntail].size = endpos - startpos;
2107 tem = Foverlay_get (overlay, Qpriority);
2108 overlay_tails[ntail].priority = (INTEGERP (tem) ? XINT (tem) : 0);
2109 ntail++;
2110 total += XSTRING (str)->size;
2111 }
2112 }
2113 if (startpos == pos)
2114 {
2115 str = Foverlay_get (overlay, Qbefore_string);
2116 if (STRINGP (str))
2117 {
2118 if (nhead == overlay_heads_len)
2119 {
2120 if (! overlay_heads)
2121 {
2122 overlay_heads_len = 5;
2123 overlay_heads = ((struct sortstr *)
2124 xmalloc (5 * sizeof (struct sortstr)));
2125 }
2126 else
2127 {
2128 overlay_heads_len *= 2;
2129 overlay_heads = ((struct sortstr *)
2130 xrealloc (overlay_heads,
2131 (overlay_heads_len
2132 * sizeof (struct sortstr))));
2133 }
2134 }
2135 overlay_heads[nhead].string = str;
2136 overlay_heads[nhead].size = endpos - startpos;
2137 tem = Foverlay_get (overlay, Qpriority);
2138 overlay_heads[nhead].priority = (INTEGERP (tem) ? XINT (tem) : 0);
2139 nhead++;
2140 total += XSTRING (str)->size;
2141 }
2142 }
2143 }
2144 if (ntail > 1)
2145 qsort (overlay_tails, ntail, sizeof (struct sortstr), cmp_for_strings);
2146 if (nhead > 1)
2147 qsort (overlay_heads, nhead, sizeof (struct sortstr), cmp_for_strings);
2148 if (total)
2149 {
2150 int i;
2151 char *p;
2152
2153 if (total > overlay_str_len)
2154 {
2155 if (! overlay_str_buf)
2156 overlay_str_buf = (char *)xmalloc (total);
2157 else
2158 overlay_str_buf = (char *)xrealloc (overlay_str_buf, total);
2159 overlay_str_len = total;
2160 }
2161 p = overlay_str_buf;
2162 for (i = ntail; --i >= 0;)
2163 {
2164 tem = overlay_tails[i].string;
2165 bcopy (XSTRING (tem)->data, p, XSTRING (tem)->size);
2166 p += XSTRING (tem)->size;
2167 }
2168 for (i = 0; i < nhead; ++i)
2169 {
2170 tem = overlay_heads[i].string;
2171 bcopy (XSTRING (tem)->data, p, XSTRING (tem)->size);
2172 p += XSTRING (tem)->size;
2173 }
2174 if (pstr)
2175 *pstr = overlay_str_buf;
2176 }
2177 return total;
2178 }
2179 \f
2180 /* Shift overlays in BUF's overlay lists, to center the lists at POS. */
2181
2182 void
2183 recenter_overlay_lists (buf, pos)
2184 struct buffer *buf;
2185 int pos;
2186 {
2187 Lisp_Object overlay, tail, next, prev, beg, end;
2188
2189 /* See if anything in overlays_before should move to overlays_after. */
2190
2191 /* We don't strictly need prev in this loop; it should always be nil.
2192 But we use it for symmetry and in case that should cease to be true
2193 with some future change. */
2194 prev = Qnil;
2195 for (tail = buf->overlays_before;
2196 CONSP (tail);
2197 prev = tail, tail = next)
2198 {
2199 next = XCONS (tail)->cdr;
2200 overlay = XCONS (tail)->car;
2201
2202 /* If the overlay is not valid, get rid of it. */
2203 if (!OVERLAY_VALID (overlay))
2204 #if 1
2205 abort ();
2206 #else
2207 {
2208 /* Splice the cons cell TAIL out of overlays_before. */
2209 if (!NILP (prev))
2210 XCONS (prev)->cdr = next;
2211 else
2212 buf->overlays_before = next;
2213 tail = prev;
2214 continue;
2215 }
2216 #endif
2217
2218 beg = OVERLAY_START (overlay);
2219 end = OVERLAY_END (overlay);
2220
2221 if (OVERLAY_POSITION (end) > pos)
2222 {
2223 /* OVERLAY needs to be moved. */
2224 int where = OVERLAY_POSITION (beg);
2225 Lisp_Object other, other_prev;
2226
2227 /* Splice the cons cell TAIL out of overlays_before. */
2228 if (!NILP (prev))
2229 XCONS (prev)->cdr = next;
2230 else
2231 buf->overlays_before = next;
2232
2233 /* Search thru overlays_after for where to put it. */
2234 other_prev = Qnil;
2235 for (other = buf->overlays_after;
2236 CONSP (other);
2237 other_prev = other, other = XCONS (other)->cdr)
2238 {
2239 Lisp_Object otherbeg, otheroverlay, follower;
2240 int win;
2241
2242 otheroverlay = XCONS (other)->car;
2243 if (! OVERLAY_VALID (otheroverlay))
2244 abort ();
2245
2246 otherbeg = OVERLAY_START (otheroverlay);
2247 if (OVERLAY_POSITION (otherbeg) >= where)
2248 break;
2249 }
2250
2251 /* Add TAIL to overlays_after before OTHER. */
2252 XCONS (tail)->cdr = other;
2253 if (!NILP (other_prev))
2254 XCONS (other_prev)->cdr = tail;
2255 else
2256 buf->overlays_after = tail;
2257 tail = prev;
2258 }
2259 else
2260 /* We've reached the things that should stay in overlays_before.
2261 All the rest of overlays_before must end even earlier,
2262 so stop now. */
2263 break;
2264 }
2265
2266 /* See if anything in overlays_after should be in overlays_before. */
2267 prev = Qnil;
2268 for (tail = buf->overlays_after;
2269 CONSP (tail);
2270 prev = tail, tail = next)
2271 {
2272 next = XCONS (tail)->cdr;
2273 overlay = XCONS (tail)->car;
2274
2275 /* If the overlay is not valid, get rid of it. */
2276 if (!OVERLAY_VALID (overlay))
2277 #if 1
2278 abort ();
2279 #else
2280 {
2281 /* Splice the cons cell TAIL out of overlays_after. */
2282 if (!NILP (prev))
2283 XCONS (prev)->cdr = next;
2284 else
2285 buf->overlays_after = next;
2286 tail = prev;
2287 continue;
2288 }
2289 #endif
2290
2291 beg = OVERLAY_START (overlay);
2292 end = OVERLAY_END (overlay);
2293
2294 /* Stop looking, when we know that nothing further
2295 can possibly end before POS. */
2296 if (OVERLAY_POSITION (beg) > pos)
2297 break;
2298
2299 if (OVERLAY_POSITION (end) <= pos)
2300 {
2301 /* OVERLAY needs to be moved. */
2302 int where = OVERLAY_POSITION (end);
2303 Lisp_Object other, other_prev;
2304
2305 /* Splice the cons cell TAIL out of overlays_after. */
2306 if (!NILP (prev))
2307 XCONS (prev)->cdr = next;
2308 else
2309 buf->overlays_after = next;
2310
2311 /* Search thru overlays_before for where to put it. */
2312 other_prev = Qnil;
2313 for (other = buf->overlays_before;
2314 CONSP (other);
2315 other_prev = other, other = XCONS (other)->cdr)
2316 {
2317 Lisp_Object otherend, otheroverlay;
2318 int win;
2319
2320 otheroverlay = XCONS (other)->car;
2321 if (! OVERLAY_VALID (otheroverlay))
2322 abort ();
2323
2324 otherend = OVERLAY_END (otheroverlay);
2325 if (OVERLAY_POSITION (otherend) <= where)
2326 break;
2327 }
2328
2329 /* Add TAIL to overlays_before before OTHER. */
2330 XCONS (tail)->cdr = other;
2331 if (!NILP (other_prev))
2332 XCONS (other_prev)->cdr = tail;
2333 else
2334 buf->overlays_before = tail;
2335 tail = prev;
2336 }
2337 }
2338
2339 XSETFASTINT (buf->overlay_center, pos);
2340 }
2341
2342 void
2343 adjust_overlays_for_insert (pos, length)
2344 int pos;
2345 int length;
2346 {
2347 /* After an insertion, the lists are still sorted properly,
2348 but we may need to update the value of the overlay center. */
2349 if (XFASTINT (current_buffer->overlay_center) >= pos)
2350 XSETFASTINT (current_buffer->overlay_center,
2351 XFASTINT (current_buffer->overlay_center) + length);
2352 }
2353
2354 void
2355 adjust_overlays_for_delete (pos, length)
2356 int pos;
2357 int length;
2358 {
2359 if (XFASTINT (current_buffer->overlay_center) < pos)
2360 /* The deletion was to our right. No change needed; the before- and
2361 after-lists are still consistent. */
2362 ;
2363 else if (XFASTINT (current_buffer->overlay_center) > pos + length)
2364 /* The deletion was to our left. We need to adjust the center value
2365 to account for the change in position, but the lists are consistent
2366 given the new value. */
2367 XSETFASTINT (current_buffer->overlay_center,
2368 XFASTINT (current_buffer->overlay_center) - length);
2369 else
2370 /* We're right in the middle. There might be things on the after-list
2371 that now belong on the before-list. Recentering will move them,
2372 and also update the center point. */
2373 recenter_overlay_lists (current_buffer, pos);
2374 }
2375
2376 /* Fix up overlays that were garbled as a result of permuting markers
2377 in the range START through END. Any overlay with at least one
2378 endpoint in this range will need to be unlinked from the overlay
2379 list and reinserted in its proper place.
2380 Such an overlay might even have negative size at this point.
2381 If so, we'll reverse the endpoints. Can you think of anything
2382 better to do in this situation? */
2383 void
2384 fix_overlays_in_range (start, end)
2385 register int start, end;
2386 {
2387 Lisp_Object tem, overlay;
2388 Lisp_Object before_list, after_list;
2389 Lisp_Object *ptail, *pbefore = &before_list, *pafter = &after_list;
2390 int startpos, endpos;
2391
2392 /* This algorithm shifts links around instead of consing and GCing.
2393 The loop invariant is that before_list (resp. after_list) is a
2394 well-formed list except that its last element, the one that
2395 *pbefore (resp. *pafter) points to, is still uninitialized.
2396 So it's not a bug that before_list isn't initialized, although
2397 it may look strange. */
2398 for (ptail = &current_buffer->overlays_before; CONSP (*ptail);)
2399 {
2400 overlay = XCONS (*ptail)->car;
2401 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2402 if (endpos < start)
2403 break;
2404 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2405 if (endpos < end
2406 || (startpos >= start && startpos < end))
2407 {
2408 /* If the overlay is backwards, fix that now. */
2409 if (startpos > endpos)
2410 {
2411 int tem;
2412 Fset_marker (OVERLAY_START (overlay), endpos, Qnil);
2413 Fset_marker (OVERLAY_END (overlay), startpos, Qnil);
2414 tem = startpos; startpos = endpos; endpos = tem;
2415 }
2416 /* Add it to the end of the wrong list. Later on,
2417 recenter_overlay_lists will move it to the right place. */
2418 if (endpos < XINT (current_buffer->overlay_center))
2419 {
2420 *pafter = *ptail;
2421 pafter = &XCONS (*ptail)->cdr;
2422 }
2423 else
2424 {
2425 *pbefore = *ptail;
2426 pbefore = &XCONS (*ptail)->cdr;
2427 }
2428 *ptail = XCONS (*ptail)->cdr;
2429 }
2430 else
2431 ptail = &XCONS (*ptail)->cdr;
2432 }
2433 for (ptail = &current_buffer->overlays_after; CONSP (*ptail);)
2434 {
2435 overlay = XCONS (*ptail)->car;
2436 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2437 if (startpos >= end)
2438 break;
2439 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2440 if (startpos >= start
2441 || (endpos >= start && endpos < end))
2442 {
2443 if (startpos > endpos)
2444 {
2445 int tem;
2446 Fset_marker (OVERLAY_START (overlay), endpos, Qnil);
2447 Fset_marker (OVERLAY_END (overlay), startpos, Qnil);
2448 tem = startpos; startpos = endpos; endpos = tem;
2449 }
2450 if (endpos < XINT (current_buffer->overlay_center))
2451 {
2452 *pafter = *ptail;
2453 pafter = &XCONS (*ptail)->cdr;
2454 }
2455 else
2456 {
2457 *pbefore = *ptail;
2458 pbefore = &XCONS (*ptail)->cdr;
2459 }
2460 *ptail = XCONS (*ptail)->cdr;
2461 }
2462 else
2463 ptail = &XCONS (*ptail)->cdr;
2464 }
2465
2466 /* Splice the constructed (wrong) lists into the buffer's lists,
2467 and let the recenter function make it sane again. */
2468 *pbefore = current_buffer->overlays_before;
2469 current_buffer->overlays_before = before_list;
2470 recenter_overlay_lists (current_buffer,
2471 XINT (current_buffer->overlay_center));
2472
2473 *pafter = current_buffer->overlays_after;
2474 current_buffer->overlays_after = after_list;
2475 recenter_overlay_lists (current_buffer,
2476 XINT (current_buffer->overlay_center));
2477 }
2478 \f
2479 DEFUN ("overlayp", Foverlayp, Soverlayp, 1, 1, 0,
2480 "Return t if OBJECT is an overlay.")
2481 (object)
2482 Lisp_Object object;
2483 {
2484 return (OVERLAYP (object) ? Qt : Qnil);
2485 }
2486
2487 DEFUN ("make-overlay", Fmake_overlay, Smake_overlay, 2, 3, 0,
2488 "Create a new overlay with range BEG to END in BUFFER.\n\
2489 If omitted, BUFFER defaults to the current buffer.\n\
2490 BEG and END may be integers or markers.")
2491 (beg, end, buffer)
2492 Lisp_Object beg, end, buffer;
2493 {
2494 Lisp_Object overlay;
2495 struct buffer *b;
2496
2497 if (NILP (buffer))
2498 XSETBUFFER (buffer, current_buffer);
2499 else
2500 CHECK_BUFFER (buffer, 2);
2501 if (MARKERP (beg)
2502 && ! EQ (Fmarker_buffer (beg), buffer))
2503 error ("Marker points into wrong buffer");
2504 if (MARKERP (end)
2505 && ! EQ (Fmarker_buffer (end), buffer))
2506 error ("Marker points into wrong buffer");
2507
2508 CHECK_NUMBER_COERCE_MARKER (beg, 1);
2509 CHECK_NUMBER_COERCE_MARKER (end, 1);
2510
2511 if (XINT (beg) > XINT (end))
2512 {
2513 Lisp_Object temp;
2514 temp = beg; beg = end; end = temp;
2515 }
2516
2517 b = XBUFFER (buffer);
2518
2519 beg = Fset_marker (Fmake_marker (), beg, buffer);
2520 end = Fset_marker (Fmake_marker (), end, buffer);
2521
2522 overlay = allocate_misc ();
2523 XMISCTYPE (overlay) = Lisp_Misc_Overlay;
2524 XOVERLAY (overlay)->start = beg;
2525 XOVERLAY (overlay)->end = end;
2526 XOVERLAY (overlay)->plist = Qnil;
2527
2528 /* Put the new overlay on the wrong list. */
2529 end = OVERLAY_END (overlay);
2530 if (OVERLAY_POSITION (end) < XINT (b->overlay_center))
2531 b->overlays_after = Fcons (overlay, b->overlays_after);
2532 else
2533 b->overlays_before = Fcons (overlay, b->overlays_before);
2534
2535 /* This puts it in the right list, and in the right order. */
2536 recenter_overlay_lists (b, XINT (b->overlay_center));
2537
2538 /* We don't need to redisplay the region covered by the overlay, because
2539 the overlay has no properties at the moment. */
2540
2541 return overlay;
2542 }
2543
2544 DEFUN ("move-overlay", Fmove_overlay, Smove_overlay, 3, 4, 0,
2545 "Set the endpoints of OVERLAY to BEG and END in BUFFER.\n\
2546 If BUFFER is omitted, leave OVERLAY in the same buffer it inhabits now.\n\
2547 If BUFFER is omitted, and OVERLAY is in no buffer, put it in the current\n\
2548 buffer.")
2549 (overlay, beg, end, buffer)
2550 Lisp_Object overlay, beg, end, buffer;
2551 {
2552 struct buffer *b, *ob;
2553 Lisp_Object obuffer;
2554 int count = specpdl_ptr - specpdl;
2555
2556 CHECK_OVERLAY (overlay, 0);
2557 if (NILP (buffer))
2558 buffer = Fmarker_buffer (OVERLAY_START (overlay));
2559 if (NILP (buffer))
2560 XSETBUFFER (buffer, current_buffer);
2561 CHECK_BUFFER (buffer, 3);
2562
2563 if (MARKERP (beg)
2564 && ! EQ (Fmarker_buffer (beg), buffer))
2565 error ("Marker points into wrong buffer");
2566 if (MARKERP (end)
2567 && ! EQ (Fmarker_buffer (end), buffer))
2568 error ("Marker points into wrong buffer");
2569
2570 CHECK_NUMBER_COERCE_MARKER (beg, 1);
2571 CHECK_NUMBER_COERCE_MARKER (end, 1);
2572
2573 if (XINT (beg) == XINT (end) && ! NILP (Foverlay_get (overlay, Qevaporate)))
2574 return Fdelete_overlay (overlay);
2575
2576 if (XINT (beg) > XINT (end))
2577 {
2578 Lisp_Object temp;
2579 temp = beg; beg = end; end = temp;
2580 }
2581
2582 specbind (Qinhibit_quit, Qt);
2583
2584 obuffer = Fmarker_buffer (OVERLAY_START (overlay));
2585 b = XBUFFER (buffer);
2586 ob = XBUFFER (obuffer);
2587
2588 /* If the overlay has changed buffers, do a thorough redisplay. */
2589 if (!EQ (buffer, obuffer))
2590 {
2591 /* Redisplay where the overlay was. */
2592 if (!NILP (obuffer))
2593 {
2594 Lisp_Object o_beg;
2595 Lisp_Object o_end;
2596
2597 o_beg = OVERLAY_START (overlay);
2598 o_end = OVERLAY_END (overlay);
2599 o_beg = OVERLAY_POSITION (o_beg);
2600 o_end = OVERLAY_POSITION (o_end);
2601
2602 redisplay_region (ob, XINT (o_beg), XINT (o_end));
2603 }
2604
2605 /* Redisplay where the overlay is going to be. */
2606 redisplay_region (b, XINT (beg), XINT (end));
2607 }
2608 else
2609 /* Redisplay the area the overlay has just left, or just enclosed. */
2610 {
2611 Lisp_Object o_beg;
2612 Lisp_Object o_end;
2613 int change_beg, change_end;
2614
2615 o_beg = OVERLAY_START (overlay);
2616 o_end = OVERLAY_END (overlay);
2617 o_beg = OVERLAY_POSITION (o_beg);
2618 o_end = OVERLAY_POSITION (o_end);
2619
2620 if (XINT (o_beg) == XINT (beg))
2621 redisplay_region (b, XINT (o_end), XINT (end));
2622 else if (XINT (o_end) == XINT (end))
2623 redisplay_region (b, XINT (o_beg), XINT (beg));
2624 else
2625 {
2626 if (XINT (beg) < XINT (o_beg)) o_beg = beg;
2627 if (XINT (end) > XINT (o_end)) o_end = end;
2628 redisplay_region (b, XINT (o_beg), XINT (o_end));
2629 }
2630 }
2631
2632 if (!NILP (obuffer))
2633 {
2634 ob->overlays_before = Fdelq (overlay, ob->overlays_before);
2635 ob->overlays_after = Fdelq (overlay, ob->overlays_after);
2636 }
2637
2638 Fset_marker (OVERLAY_START (overlay), beg, buffer);
2639 Fset_marker (OVERLAY_END (overlay), end, buffer);
2640
2641 /* Put the overlay on the wrong list. */
2642 end = OVERLAY_END (overlay);
2643 if (OVERLAY_POSITION (end) < XINT (b->overlay_center))
2644 b->overlays_after = Fcons (overlay, b->overlays_after);
2645 else
2646 b->overlays_before = Fcons (overlay, b->overlays_before);
2647
2648 /* This puts it in the right list, and in the right order. */
2649 recenter_overlay_lists (b, XINT (b->overlay_center));
2650
2651 return unbind_to (count, overlay);
2652 }
2653
2654 DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0,
2655 "Delete the overlay OVERLAY from its buffer.")
2656 (overlay)
2657 Lisp_Object overlay;
2658 {
2659 Lisp_Object buffer;
2660 struct buffer *b;
2661 int count = specpdl_ptr - specpdl;
2662
2663 CHECK_OVERLAY (overlay, 0);
2664
2665 buffer = Fmarker_buffer (OVERLAY_START (overlay));
2666 if (NILP (buffer))
2667 return Qnil;
2668
2669 b = XBUFFER (buffer);
2670
2671 specbind (Qinhibit_quit, Qt);
2672
2673 b->overlays_before = Fdelq (overlay, b->overlays_before);
2674 b->overlays_after = Fdelq (overlay, b->overlays_after);
2675
2676 redisplay_region (b,
2677 marker_position (OVERLAY_START (overlay)),
2678 marker_position (OVERLAY_END (overlay)));
2679
2680 Fset_marker (OVERLAY_START (overlay), Qnil, Qnil);
2681 Fset_marker (OVERLAY_END (overlay), Qnil, Qnil);
2682
2683 return unbind_to (count, Qnil);
2684 }
2685 \f
2686 /* Overlay dissection functions. */
2687
2688 DEFUN ("overlay-start", Foverlay_start, Soverlay_start, 1, 1, 0,
2689 "Return the position at which OVERLAY starts.")
2690 (overlay)
2691 Lisp_Object overlay;
2692 {
2693 CHECK_OVERLAY (overlay, 0);
2694
2695 return (Fmarker_position (OVERLAY_START (overlay)));
2696 }
2697
2698 DEFUN ("overlay-end", Foverlay_end, Soverlay_end, 1, 1, 0,
2699 "Return the position at which OVERLAY ends.")
2700 (overlay)
2701 Lisp_Object overlay;
2702 {
2703 CHECK_OVERLAY (overlay, 0);
2704
2705 return (Fmarker_position (OVERLAY_END (overlay)));
2706 }
2707
2708 DEFUN ("overlay-buffer", Foverlay_buffer, Soverlay_buffer, 1, 1, 0,
2709 "Return the buffer OVERLAY belongs to.")
2710 (overlay)
2711 Lisp_Object overlay;
2712 {
2713 CHECK_OVERLAY (overlay, 0);
2714
2715 return Fmarker_buffer (OVERLAY_START (overlay));
2716 }
2717
2718 DEFUN ("overlay-properties", Foverlay_properties, Soverlay_properties, 1, 1, 0,
2719 "Return a list of the properties on OVERLAY.\n\
2720 This is a copy of OVERLAY's plist; modifying its conses has no effect on\n\
2721 OVERLAY.")
2722 (overlay)
2723 Lisp_Object overlay;
2724 {
2725 CHECK_OVERLAY (overlay, 0);
2726
2727 return Fcopy_sequence (XOVERLAY (overlay)->plist);
2728 }
2729
2730 \f
2731 DEFUN ("overlays-at", Foverlays_at, Soverlays_at, 1, 1, 0,
2732 "Return a list of the overlays that contain position POS.")
2733 (pos)
2734 Lisp_Object pos;
2735 {
2736 int noverlays;
2737 Lisp_Object *overlay_vec;
2738 int len;
2739 Lisp_Object result;
2740
2741 CHECK_NUMBER_COERCE_MARKER (pos, 0);
2742
2743 len = 10;
2744 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
2745
2746 /* Put all the overlays we want in a vector in overlay_vec.
2747 Store the length in len. */
2748 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
2749 (int *) 0, (int *) 0);
2750
2751 /* Make a list of them all. */
2752 result = Flist (noverlays, overlay_vec);
2753
2754 xfree (overlay_vec);
2755 return result;
2756 }
2757
2758 DEFUN ("overlays-in", Foverlays_in, Soverlays_in, 2, 2, 0,
2759 "Return a list of the overlays that overlap the region BEG ... END.\n\
2760 Overlap means that at least one character is contained within the overlay\n\
2761 and also contained within the specified region.\n\
2762 Empty overlays are included in the result if they are located at BEG\n\
2763 or between BEG and END.")
2764 (beg, end)
2765 Lisp_Object beg, end;
2766 {
2767 int noverlays;
2768 Lisp_Object *overlay_vec;
2769 int len;
2770 Lisp_Object result;
2771
2772 CHECK_NUMBER_COERCE_MARKER (beg, 0);
2773 CHECK_NUMBER_COERCE_MARKER (end, 0);
2774
2775 len = 10;
2776 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
2777
2778 /* Put all the overlays we want in a vector in overlay_vec.
2779 Store the length in len. */
2780 noverlays = overlays_in (XINT (beg), XINT (end), 1, &overlay_vec, &len,
2781 (int *) 0, (int *) 0);
2782
2783 /* Make a list of them all. */
2784 result = Flist (noverlays, overlay_vec);
2785
2786 xfree (overlay_vec);
2787 return result;
2788 }
2789
2790 DEFUN ("next-overlay-change", Fnext_overlay_change, Snext_overlay_change,
2791 1, 1, 0,
2792 "Return the next position after POS where an overlay starts or ends.\n\
2793 If there are no more overlay boundaries after POS, return (point-max).")
2794 (pos)
2795 Lisp_Object pos;
2796 {
2797 int noverlays;
2798 int endpos;
2799 Lisp_Object *overlay_vec;
2800 int len;
2801 int i;
2802
2803 CHECK_NUMBER_COERCE_MARKER (pos, 0);
2804
2805 len = 10;
2806 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
2807
2808 /* Put all the overlays we want in a vector in overlay_vec.
2809 Store the length in len.
2810 endpos gets the position where the next overlay starts. */
2811 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
2812 &endpos, (int *) 0);
2813
2814 /* If any of these overlays ends before endpos,
2815 use its ending point instead. */
2816 for (i = 0; i < noverlays; i++)
2817 {
2818 Lisp_Object oend;
2819 int oendpos;
2820
2821 oend = OVERLAY_END (overlay_vec[i]);
2822 oendpos = OVERLAY_POSITION (oend);
2823 if (oendpos < endpos)
2824 endpos = oendpos;
2825 }
2826
2827 xfree (overlay_vec);
2828 return make_number (endpos);
2829 }
2830
2831 DEFUN ("previous-overlay-change", Fprevious_overlay_change,
2832 Sprevious_overlay_change, 1, 1, 0,
2833 "Return the previous position before POS where an overlay starts or ends.\n\
2834 If there are no more overlay boundaries before POS, return (point-min).")
2835 (pos)
2836 Lisp_Object pos;
2837 {
2838 int noverlays;
2839 int prevpos;
2840 Lisp_Object *overlay_vec;
2841 int len;
2842 int i;
2843 Lisp_Object tail;
2844
2845 CHECK_NUMBER_COERCE_MARKER (pos, 0);
2846
2847 len = 10;
2848 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
2849
2850 /* At beginning of buffer, we know the answer;
2851 avoid bug subtracting 1 below. */
2852 if (XINT (pos) == BEGV)
2853 return pos;
2854
2855 /* Put all the overlays we want in a vector in overlay_vec.
2856 Store the length in len.
2857 prevpos gets the position of an overlay end. */
2858 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
2859 (int *) 0, &prevpos);
2860
2861 /* If any of these overlays starts after prevpos,
2862 maybe use its starting point instead. */
2863 for (i = 0; i < noverlays; i++)
2864 {
2865 Lisp_Object ostart;
2866 int ostartpos;
2867
2868 ostart = OVERLAY_START (overlay_vec[i]);
2869 ostartpos = OVERLAY_POSITION (ostart);
2870 if (ostartpos > prevpos && ostartpos < XINT (pos))
2871 prevpos = ostartpos;
2872 }
2873
2874 /* If any overlay ends at pos, consider its starting point too. */
2875 for (tail = current_buffer->overlays_before;
2876 GC_CONSP (tail);
2877 tail = XCONS (tail)->cdr)
2878 {
2879 Lisp_Object overlay, ostart;
2880 int ostartpos;
2881
2882 overlay = XCONS (tail)->car;
2883
2884 ostart = OVERLAY_START (overlay);
2885 ostartpos = OVERLAY_POSITION (ostart);
2886 if (ostartpos > prevpos && ostartpos < XINT (pos))
2887 prevpos = ostartpos;
2888 }
2889
2890 xfree (overlay_vec);
2891 return make_number (prevpos);
2892 }
2893 \f
2894 /* These functions are for debugging overlays. */
2895
2896 DEFUN ("overlay-lists", Foverlay_lists, Soverlay_lists, 0, 0, 0,
2897 "Return a pair of lists giving all the overlays of the current buffer.\n\
2898 The car has all the overlays before the overlay center;\n\
2899 the cdr has all the overlays after the overlay center.\n\
2900 Recentering overlays moves overlays between these lists.\n\
2901 The lists you get are copies, so that changing them has no effect.\n\
2902 However, the overlays you get are the real objects that the buffer uses.")
2903 ()
2904 {
2905 Lisp_Object before, after;
2906 before = current_buffer->overlays_before;
2907 if (CONSP (before))
2908 before = Fcopy_sequence (before);
2909 after = current_buffer->overlays_after;
2910 if (CONSP (after))
2911 after = Fcopy_sequence (after);
2912
2913 return Fcons (before, after);
2914 }
2915
2916 DEFUN ("overlay-recenter", Foverlay_recenter, Soverlay_recenter, 1, 1, 0,
2917 "Recenter the overlays of the current buffer around position POS.")
2918 (pos)
2919 Lisp_Object pos;
2920 {
2921 CHECK_NUMBER_COERCE_MARKER (pos, 0);
2922
2923 recenter_overlay_lists (current_buffer, XINT (pos));
2924 return Qnil;
2925 }
2926 \f
2927 DEFUN ("overlay-get", Foverlay_get, Soverlay_get, 2, 2, 0,
2928 "Get the property of overlay OVERLAY with property name NAME.")
2929 (overlay, prop)
2930 Lisp_Object overlay, prop;
2931 {
2932 Lisp_Object plist, fallback;
2933
2934 CHECK_OVERLAY (overlay, 0);
2935
2936 fallback = Qnil;
2937
2938 for (plist = XOVERLAY (overlay)->plist;
2939 CONSP (plist) && CONSP (XCONS (plist)->cdr);
2940 plist = XCONS (XCONS (plist)->cdr)->cdr)
2941 {
2942 if (EQ (XCONS (plist)->car, prop))
2943 return XCONS (XCONS (plist)->cdr)->car;
2944 else if (EQ (XCONS (plist)->car, Qcategory))
2945 {
2946 Lisp_Object tem;
2947 tem = Fcar (Fcdr (plist));
2948 if (SYMBOLP (tem))
2949 fallback = Fget (tem, prop);
2950 }
2951 }
2952
2953 return fallback;
2954 }
2955
2956 DEFUN ("overlay-put", Foverlay_put, Soverlay_put, 3, 3, 0,
2957 "Set one property of overlay OVERLAY: give property PROP value VALUE.")
2958 (overlay, prop, value)
2959 Lisp_Object overlay, prop, value;
2960 {
2961 Lisp_Object tail, buffer;
2962 int changed;
2963
2964 CHECK_OVERLAY (overlay, 0);
2965
2966 buffer = Fmarker_buffer (OVERLAY_START (overlay));
2967
2968 for (tail = XOVERLAY (overlay)->plist;
2969 CONSP (tail) && CONSP (XCONS (tail)->cdr);
2970 tail = XCONS (XCONS (tail)->cdr)->cdr)
2971 if (EQ (XCONS (tail)->car, prop))
2972 {
2973 changed = !EQ (XCONS (XCONS (tail)->cdr)->car, value);
2974 XCONS (XCONS (tail)->cdr)->car = value;
2975 goto found;
2976 }
2977 /* It wasn't in the list, so add it to the front. */
2978 changed = !NILP (value);
2979 XOVERLAY (overlay)->plist
2980 = Fcons (prop, Fcons (value, XOVERLAY (overlay)->plist));
2981 found:
2982 if (! NILP (buffer))
2983 {
2984 if (changed)
2985 redisplay_region (XBUFFER (buffer),
2986 marker_position (OVERLAY_START (overlay)),
2987 marker_position (OVERLAY_END (overlay)));
2988 if (EQ (prop, Qevaporate) && ! NILP (value)
2989 && (OVERLAY_POSITION (OVERLAY_START (overlay))
2990 == OVERLAY_POSITION (OVERLAY_END (overlay))))
2991 Fdelete_overlay (overlay);
2992 }
2993 return value;
2994 }
2995 \f
2996 /* Subroutine of report_overlay_modification. */
2997
2998 /* Lisp vector holding overlay hook functions to call.
2999 Vector elements come in pairs.
3000 Each even-index element is a list of hook functions.
3001 The following odd-index element is the overlay they came from.
3002
3003 Before the buffer change, we fill in this vector
3004 as we call overlay hook functions.
3005 After the buffer change, we get the functions to call from this vector.
3006 This way we always call the same functions before and after the change. */
3007 static Lisp_Object last_overlay_modification_hooks;
3008
3009 /* Number of elements actually used in last_overlay_modification_hooks. */
3010 static int last_overlay_modification_hooks_used;
3011
3012 /* Add one functionlist/overlay pair
3013 to the end of last_overlay_modification_hooks. */
3014
3015 static void
3016 add_overlay_mod_hooklist (functionlist, overlay)
3017 Lisp_Object functionlist, overlay;
3018 {
3019 int oldsize = XVECTOR (last_overlay_modification_hooks)->size;
3020
3021 if (last_overlay_modification_hooks_used == oldsize)
3022 {
3023 Lisp_Object old;
3024 old = last_overlay_modification_hooks;
3025 last_overlay_modification_hooks
3026 = Fmake_vector (make_number (oldsize * 2), Qnil);
3027 bcopy (XVECTOR (last_overlay_modification_hooks)->contents,
3028 XVECTOR (old)->contents,
3029 sizeof (Lisp_Object) * oldsize);
3030 }
3031 XVECTOR (last_overlay_modification_hooks)->contents[last_overlay_modification_hooks_used++] = functionlist;
3032 XVECTOR (last_overlay_modification_hooks)->contents[last_overlay_modification_hooks_used++] = overlay;
3033 }
3034 \f
3035 /* Run the modification-hooks of overlays that include
3036 any part of the text in START to END.
3037 If this change is an insertion, also
3038 run the insert-before-hooks of overlay starting at END,
3039 and the insert-after-hooks of overlay ending at START.
3040
3041 This is called both before and after the modification.
3042 AFTER is nonzero when we call after the modification.
3043
3044 ARG1, ARG2, ARG3 are arguments to pass to the hook functions.
3045 When AFTER is nonzero, they are the start position,
3046 the position after the inserted new text,
3047 and the length of deleted or replaced old text. */
3048
3049 void
3050 report_overlay_modification (start, end, after, arg1, arg2, arg3)
3051 Lisp_Object start, end;
3052 int after;
3053 Lisp_Object arg1, arg2, arg3;
3054 {
3055 Lisp_Object prop, overlay, tail;
3056 /* 1 if this change is an insertion. */
3057 int insertion = (after ? XFASTINT (arg3) == 0 : EQ (start, end));
3058 int tail_copied;
3059 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
3060
3061 overlay = Qnil;
3062 tail = Qnil;
3063 GCPRO5 (overlay, tail, arg1, arg2, arg3);
3064
3065 if (after)
3066 {
3067 /* Call the functions recorded in last_overlay_modification_hooks
3068 rather than scanning the overlays again.
3069 First copy the vector contents, in case some of these hooks
3070 do subsequent modification of the buffer. */
3071 int size = last_overlay_modification_hooks_used;
3072 Lisp_Object *copy = (Lisp_Object *) alloca (size * sizeof (Lisp_Object));
3073 int i;
3074
3075 bcopy (XVECTOR (last_overlay_modification_hooks)->contents,
3076 copy, size * sizeof (Lisp_Object));
3077 gcpro1.var = copy;
3078 gcpro1.nvars = size;
3079
3080 for (i = 0; i < size;)
3081 {
3082 Lisp_Object prop, overlay;
3083 prop = copy[i++];
3084 overlay = copy[i++];
3085 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
3086 }
3087 UNGCPRO;
3088 return;
3089 }
3090
3091 /* We are being called before a change.
3092 Scan the overlays to find the functions to call. */
3093 last_overlay_modification_hooks_used = 0;
3094 tail_copied = 0;
3095 for (tail = current_buffer->overlays_before;
3096 CONSP (tail);
3097 tail = XCONS (tail)->cdr)
3098 {
3099 int startpos, endpos;
3100 Lisp_Object ostart, oend;
3101
3102 overlay = XCONS (tail)->car;
3103
3104 ostart = OVERLAY_START (overlay);
3105 oend = OVERLAY_END (overlay);
3106 endpos = OVERLAY_POSITION (oend);
3107 if (XFASTINT (start) > endpos)
3108 break;
3109 startpos = OVERLAY_POSITION (ostart);
3110 if (insertion && (XFASTINT (start) == startpos
3111 || XFASTINT (end) == startpos))
3112 {
3113 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
3114 if (!NILP (prop))
3115 {
3116 /* Copy TAIL in case the hook recenters the overlay lists. */
3117 if (!tail_copied)
3118 tail = Fcopy_sequence (tail);
3119 tail_copied = 1;
3120 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
3121 }
3122 }
3123 if (insertion && (XFASTINT (start) == endpos
3124 || XFASTINT (end) == endpos))
3125 {
3126 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
3127 if (!NILP (prop))
3128 {
3129 if (!tail_copied)
3130 tail = Fcopy_sequence (tail);
3131 tail_copied = 1;
3132 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
3133 }
3134 }
3135 /* Test for intersecting intervals. This does the right thing
3136 for both insertion and deletion. */
3137 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
3138 {
3139 prop = Foverlay_get (overlay, Qmodification_hooks);
3140 if (!NILP (prop))
3141 {
3142 if (!tail_copied)
3143 tail = Fcopy_sequence (tail);
3144 tail_copied = 1;
3145 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
3146 }
3147 }
3148 }
3149
3150 tail_copied = 0;
3151 for (tail = current_buffer->overlays_after;
3152 CONSP (tail);
3153 tail = XCONS (tail)->cdr)
3154 {
3155 int startpos, endpos;
3156 Lisp_Object ostart, oend;
3157
3158 overlay = XCONS (tail)->car;
3159
3160 ostart = OVERLAY_START (overlay);
3161 oend = OVERLAY_END (overlay);
3162 startpos = OVERLAY_POSITION (ostart);
3163 endpos = OVERLAY_POSITION (oend);
3164 if (XFASTINT (end) < startpos)
3165 break;
3166 if (insertion && (XFASTINT (start) == startpos
3167 || XFASTINT (end) == startpos))
3168 {
3169 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
3170 if (!NILP (prop))
3171 {
3172 if (!tail_copied)
3173 tail = Fcopy_sequence (tail);
3174 tail_copied = 1;
3175 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
3176 }
3177 }
3178 if (insertion && (XFASTINT (start) == endpos
3179 || XFASTINT (end) == endpos))
3180 {
3181 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
3182 if (!NILP (prop))
3183 {
3184 if (!tail_copied)
3185 tail = Fcopy_sequence (tail);
3186 tail_copied = 1;
3187 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
3188 }
3189 }
3190 /* Test for intersecting intervals. This does the right thing
3191 for both insertion and deletion. */
3192 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
3193 {
3194 prop = Foverlay_get (overlay, Qmodification_hooks);
3195 if (!NILP (prop))
3196 {
3197 if (!tail_copied)
3198 tail = Fcopy_sequence (tail);
3199 tail_copied = 1;
3200 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
3201 }
3202 }
3203 }
3204
3205 UNGCPRO;
3206 }
3207
3208 static void
3209 call_overlay_mod_hooks (list, overlay, after, arg1, arg2, arg3)
3210 Lisp_Object list, overlay;
3211 int after;
3212 Lisp_Object arg1, arg2, arg3;
3213 {
3214 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3215
3216 GCPRO4 (list, arg1, arg2, arg3);
3217 if (! after)
3218 add_overlay_mod_hooklist (list, overlay);
3219
3220 while (!NILP (list))
3221 {
3222 if (NILP (arg3))
3223 call4 (Fcar (list), overlay, after ? Qt : Qnil, arg1, arg2);
3224 else
3225 call5 (Fcar (list), overlay, after ? Qt : Qnil, arg1, arg2, arg3);
3226 list = Fcdr (list);
3227 }
3228 UNGCPRO;
3229 }
3230
3231 /* Delete any zero-sized overlays at position POS, if the `evaporate'
3232 property is set. */
3233 void
3234 evaporate_overlays (pos)
3235 int pos;
3236 {
3237 Lisp_Object tail, overlay, hit_list;
3238
3239 hit_list = Qnil;
3240 if (pos <= XFASTINT (current_buffer->overlay_center))
3241 for (tail = current_buffer->overlays_before; CONSP (tail);
3242 tail = XCONS (tail)->cdr)
3243 {
3244 int endpos;
3245 overlay = XCONS (tail)->car;
3246 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3247 if (endpos < pos)
3248 break;
3249 if (endpos == pos && OVERLAY_POSITION (OVERLAY_START (overlay)) == pos
3250 && ! NILP (Foverlay_get (overlay, Qevaporate)))
3251 hit_list = Fcons (overlay, hit_list);
3252 }
3253 else
3254 for (tail = current_buffer->overlays_after; CONSP (tail);
3255 tail = XCONS (tail)->cdr)
3256 {
3257 int startpos;
3258 overlay = XCONS (tail)->car;
3259 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3260 if (startpos > pos)
3261 break;
3262 if (startpos == pos && OVERLAY_POSITION (OVERLAY_END (overlay)) == pos
3263 && ! NILP (Foverlay_get (overlay, Qevaporate)))
3264 hit_list = Fcons (overlay, hit_list);
3265 }
3266 for (; CONSP (hit_list); hit_list = XCONS (hit_list)->cdr)
3267 Fdelete_overlay (XCONS (hit_list)->car);
3268 }
3269 \f
3270 /* Somebody has tried to store a value with an unacceptable type
3271 into the buffer-local slot with offset OFFSET. */
3272 void
3273 buffer_slot_type_mismatch (offset)
3274 int offset;
3275 {
3276 Lisp_Object sym;
3277 char *type_name;
3278 sym = *(Lisp_Object *)(offset + (char *)&buffer_local_symbols);
3279 switch (XINT (*(Lisp_Object *)(offset + (char *)&buffer_local_types)))
3280 {
3281 case Lisp_Int: type_name = "integers"; break;
3282 case Lisp_String: type_name = "strings"; break;
3283 case Lisp_Symbol: type_name = "symbols"; break;
3284 default:
3285 abort ();
3286 }
3287
3288 error ("only %s should be stored in the buffer-local variable %s",
3289 type_name, XSYMBOL (sym)->name->data);
3290 }
3291 \f
3292 init_buffer_once ()
3293 {
3294 register Lisp_Object tem;
3295
3296 /* Make sure all markable slots in buffer_defaults
3297 are initialized reasonably, so mark_buffer won't choke. */
3298 reset_buffer (&buffer_defaults);
3299 reset_buffer_local_variables (&buffer_defaults);
3300 reset_buffer (&buffer_local_symbols);
3301 reset_buffer_local_variables (&buffer_local_symbols);
3302 /* Prevent GC from getting confused. */
3303 buffer_defaults.text = &buffer_defaults.own_text;
3304 buffer_local_symbols.text = &buffer_local_symbols.own_text;
3305 #ifdef USE_TEXT_PROPERTIES
3306 BUF_INTERVALS (&buffer_defaults) = 0;
3307 BUF_INTERVALS (&buffer_local_symbols) = 0;
3308 #endif
3309 XSETBUFFER (Vbuffer_defaults, &buffer_defaults);
3310 XSETBUFFER (Vbuffer_local_symbols, &buffer_local_symbols);
3311
3312 /* Set up the default values of various buffer slots. */
3313 /* Must do these before making the first buffer! */
3314
3315 /* real setup is done in loaddefs.el */
3316 buffer_defaults.mode_line_format = build_string ("%-");
3317 buffer_defaults.abbrev_mode = Qnil;
3318 buffer_defaults.overwrite_mode = Qnil;
3319 buffer_defaults.case_fold_search = Qt;
3320 buffer_defaults.auto_fill_function = Qnil;
3321 buffer_defaults.selective_display = Qnil;
3322 #ifndef old
3323 buffer_defaults.selective_display_ellipses = Qt;
3324 #endif
3325 buffer_defaults.abbrev_table = Qnil;
3326 buffer_defaults.display_table = Qnil;
3327 buffer_defaults.undo_list = Qnil;
3328 buffer_defaults.mark_active = Qnil;
3329 buffer_defaults.file_format = Qnil;
3330 buffer_defaults.overlays_before = Qnil;
3331 buffer_defaults.overlays_after = Qnil;
3332 XSETFASTINT (buffer_defaults.overlay_center, BEG);
3333
3334 XSETFASTINT (buffer_defaults.tab_width, 8);
3335 buffer_defaults.truncate_lines = Qnil;
3336 buffer_defaults.ctl_arrow = Qt;
3337
3338 #ifdef DOS_NT
3339 buffer_defaults.buffer_file_type = Qnil; /* TEXT */
3340 #endif
3341 XSETFASTINT (buffer_defaults.fill_column, 70);
3342 XSETFASTINT (buffer_defaults.left_margin, 0);
3343 buffer_defaults.cache_long_line_scans = Qnil;
3344 buffer_defaults.file_truename = Qnil;
3345
3346 /* Assign the local-flags to the slots that have default values.
3347 The local flag is a bit that is used in the buffer
3348 to say that it has its own local value for the slot.
3349 The local flag bits are in the local_var_flags slot of the buffer. */
3350
3351 /* Nothing can work if this isn't true */
3352 if (sizeof (EMACS_INT) != sizeof (Lisp_Object)) abort ();
3353
3354 /* 0 means not a lisp var, -1 means always local, else mask */
3355 bzero (&buffer_local_flags, sizeof buffer_local_flags);
3356 XSETINT (buffer_local_flags.filename, -1);
3357 XSETINT (buffer_local_flags.directory, -1);
3358 XSETINT (buffer_local_flags.backed_up, -1);
3359 XSETINT (buffer_local_flags.save_length, -1);
3360 XSETINT (buffer_local_flags.auto_save_file_name, -1);
3361 XSETINT (buffer_local_flags.read_only, -1);
3362 XSETINT (buffer_local_flags.major_mode, -1);
3363 XSETINT (buffer_local_flags.mode_name, -1);
3364 XSETINT (buffer_local_flags.undo_list, -1);
3365 XSETINT (buffer_local_flags.mark_active, -1);
3366 XSETINT (buffer_local_flags.point_before_scroll, -1);
3367 XSETINT (buffer_local_flags.file_truename, -1);
3368 XSETINT (buffer_local_flags.invisibility_spec, -1);
3369
3370 XSETFASTINT (buffer_local_flags.mode_line_format, 1);
3371 XSETFASTINT (buffer_local_flags.abbrev_mode, 2);
3372 XSETFASTINT (buffer_local_flags.overwrite_mode, 4);
3373 XSETFASTINT (buffer_local_flags.case_fold_search, 8);
3374 XSETFASTINT (buffer_local_flags.auto_fill_function, 0x10);
3375 XSETFASTINT (buffer_local_flags.selective_display, 0x20);
3376 #ifndef old
3377 XSETFASTINT (buffer_local_flags.selective_display_ellipses, 0x40);
3378 #endif
3379 XSETFASTINT (buffer_local_flags.tab_width, 0x80);
3380 XSETFASTINT (buffer_local_flags.truncate_lines, 0x100);
3381 XSETFASTINT (buffer_local_flags.ctl_arrow, 0x200);
3382 XSETFASTINT (buffer_local_flags.fill_column, 0x400);
3383 XSETFASTINT (buffer_local_flags.left_margin, 0x800);
3384 XSETFASTINT (buffer_local_flags.abbrev_table, 0x1000);
3385 XSETFASTINT (buffer_local_flags.display_table, 0x2000);
3386 XSETFASTINT (buffer_local_flags.syntax_table, 0x8000);
3387 XSETFASTINT (buffer_local_flags.cache_long_line_scans, 0x10000);
3388 XSETFASTINT (buffer_local_flags.file_format, 0x20000);
3389 #ifdef DOS_NT
3390 XSETFASTINT (buffer_local_flags.buffer_file_type, 0x4000);
3391 #endif
3392
3393 Vbuffer_alist = Qnil;
3394 current_buffer = 0;
3395 all_buffers = 0;
3396
3397 QSFundamental = build_string ("Fundamental");
3398
3399 Qfundamental_mode = intern ("fundamental-mode");
3400 buffer_defaults.major_mode = Qfundamental_mode;
3401
3402 Qmode_class = intern ("mode-class");
3403
3404 Qprotected_field = intern ("protected-field");
3405
3406 Qpermanent_local = intern ("permanent-local");
3407
3408 Qkill_buffer_hook = intern ("kill-buffer-hook");
3409
3410 Vprin1_to_string_buffer = Fget_buffer_create (build_string (" prin1"));
3411 /* super-magic invisible buffer */
3412 Vbuffer_alist = Qnil;
3413
3414 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
3415 }
3416
3417 init_buffer ()
3418 {
3419 char buf[MAXPATHLEN+1];
3420 char *pwd;
3421 struct stat dotstat, pwdstat;
3422 Lisp_Object temp;
3423 int rc;
3424
3425 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
3426
3427 /* If PWD is accurate, use it instead of calling getwd. This is faster
3428 when PWD is right, and may avoid a fatal error. */
3429 if ((pwd = getenv ("PWD")) != 0 && IS_DIRECTORY_SEP (*pwd)
3430 && stat (pwd, &pwdstat) == 0
3431 && stat (".", &dotstat) == 0
3432 && dotstat.st_ino == pwdstat.st_ino
3433 && dotstat.st_dev == pwdstat.st_dev
3434 && strlen (pwd) < MAXPATHLEN)
3435 strcpy (buf, pwd);
3436 else if (getwd (buf) == 0)
3437 fatal ("`getwd' failed: %s\n", buf);
3438
3439 #ifndef VMS
3440 /* Maybe this should really use some standard subroutine
3441 whose definition is filename syntax dependent. */
3442 rc = strlen (buf);
3443 if (!(IS_DIRECTORY_SEP (buf[rc - 1])))
3444 {
3445 buf[rc] = DIRECTORY_SEP;
3446 buf[rc + 1] = '\0';
3447 }
3448 #endif /* not VMS */
3449 current_buffer->directory = build_string (buf);
3450
3451 temp = get_minibuffer (0);
3452 XBUFFER (temp)->directory = current_buffer->directory;
3453 }
3454
3455 /* initialize the buffer routines */
3456 syms_of_buffer ()
3457 {
3458 extern Lisp_Object Qdisabled;
3459
3460 staticpro (&last_overlay_modification_hooks);
3461 last_overlay_modification_hooks
3462 = Fmake_vector (make_number (10), Qnil);
3463
3464 staticpro (&Vbuffer_defaults);
3465 staticpro (&Vbuffer_local_symbols);
3466 staticpro (&Qfundamental_mode);
3467 staticpro (&Qmode_class);
3468 staticpro (&QSFundamental);
3469 staticpro (&Vbuffer_alist);
3470 staticpro (&Qprotected_field);
3471 staticpro (&Qpermanent_local);
3472 staticpro (&Qkill_buffer_hook);
3473 staticpro (&Qoverlayp);
3474 Qevaporate = intern ("evaporate");
3475 staticpro (&Qevaporate);
3476 staticpro (&Qmodification_hooks);
3477 Qmodification_hooks = intern ("modification-hooks");
3478 staticpro (&Qinsert_in_front_hooks);
3479 Qinsert_in_front_hooks = intern ("insert-in-front-hooks");
3480 staticpro (&Qinsert_behind_hooks);
3481 Qinsert_behind_hooks = intern ("insert-behind-hooks");
3482 staticpro (&Qget_file_buffer);
3483 Qget_file_buffer = intern ("get-file-buffer");
3484 Qpriority = intern ("priority");
3485 staticpro (&Qpriority);
3486 Qwindow = intern ("window");
3487 staticpro (&Qwindow);
3488 Qbefore_string = intern ("before-string");
3489 staticpro (&Qbefore_string);
3490 Qafter_string = intern ("after-string");
3491 staticpro (&Qafter_string);
3492
3493 Qoverlayp = intern ("overlayp");
3494
3495 Fput (Qprotected_field, Qerror_conditions,
3496 Fcons (Qprotected_field, Fcons (Qerror, Qnil)));
3497 Fput (Qprotected_field, Qerror_message,
3498 build_string ("Attempt to modify a protected field"));
3499
3500 /* All these use DEFVAR_LISP_NOPRO because the slots in
3501 buffer_defaults will all be marked via Vbuffer_defaults. */
3502
3503 DEFVAR_LISP_NOPRO ("default-mode-line-format",
3504 &buffer_defaults.mode_line_format,
3505 "Default value of `mode-line-format' for buffers that don't override it.\n\
3506 This is the same as (default-value 'mode-line-format).");
3507
3508 DEFVAR_LISP_NOPRO ("default-abbrev-mode",
3509 &buffer_defaults.abbrev_mode,
3510 "Default value of `abbrev-mode' for buffers that do not override it.\n\
3511 This is the same as (default-value 'abbrev-mode).");
3512
3513 DEFVAR_LISP_NOPRO ("default-ctl-arrow",
3514 &buffer_defaults.ctl_arrow,
3515 "Default value of `ctl-arrow' for buffers that do not override it.\n\
3516 This is the same as (default-value 'ctl-arrow).");
3517
3518 DEFVAR_LISP_NOPRO ("default-truncate-lines",
3519 &buffer_defaults.truncate_lines,
3520 "Default value of `truncate-lines' for buffers that do not override it.\n\
3521 This is the same as (default-value 'truncate-lines).");
3522
3523 DEFVAR_LISP_NOPRO ("default-fill-column",
3524 &buffer_defaults.fill_column,
3525 "Default value of `fill-column' for buffers that do not override it.\n\
3526 This is the same as (default-value 'fill-column).");
3527
3528 DEFVAR_LISP_NOPRO ("default-left-margin",
3529 &buffer_defaults.left_margin,
3530 "Default value of `left-margin' for buffers that do not override it.\n\
3531 This is the same as (default-value 'left-margin).");
3532
3533 DEFVAR_LISP_NOPRO ("default-tab-width",
3534 &buffer_defaults.tab_width,
3535 "Default value of `tab-width' for buffers that do not override it.\n\
3536 This is the same as (default-value 'tab-width).");
3537
3538 DEFVAR_LISP_NOPRO ("default-case-fold-search",
3539 &buffer_defaults.case_fold_search,
3540 "Default value of `case-fold-search' for buffers that don't override it.\n\
3541 This is the same as (default-value 'case-fold-search).");
3542
3543 #ifdef DOS_NT
3544 DEFVAR_LISP_NOPRO ("default-buffer-file-type",
3545 &buffer_defaults.buffer_file_type,
3546 "Default file type for buffers that do not override it.\n\
3547 This is the same as (default-value 'buffer-file-type).\n\
3548 The file type is nil for text, t for binary.");
3549 #endif
3550
3551 DEFVAR_PER_BUFFER ("mode-line-format", &current_buffer->mode_line_format,
3552 Qnil, 0);
3553
3554 /* This doc string is too long for cpp; cpp dies if it isn't in a comment.
3555 But make-docfile finds it!
3556 DEFVAR_PER_BUFFER ("mode-line-format", &current_buffer->mode_line_format,
3557 Qnil,
3558 "Template for displaying mode line for current buffer.\n\
3559 Each buffer has its own value of this variable.\n\
3560 Value may be a string, a symbol or a list or cons cell.\n\
3561 For a symbol, its value is used (but it is ignored if t or nil).\n\
3562 A string appearing directly as the value of a symbol is processed verbatim\n\
3563 in that the %-constructs below are not recognized.\n\
3564 For a list whose car is a symbol, the symbol's value is taken,\n\
3565 and if that is non-nil, the cadr of the list is processed recursively.\n\
3566 Otherwise, the caddr of the list (if there is one) is processed.\n\
3567 For a list whose car is a string or list, each element is processed\n\
3568 recursively and the results are effectively concatenated.\n\
3569 For a list whose car is an integer, the cdr of the list is processed\n\
3570 and padded (if the number is positive) or truncated (if negative)\n\
3571 to the width specified by that number.\n\
3572 A string is printed verbatim in the mode line except for %-constructs:\n\
3573 (%-constructs are allowed when the string is the entire mode-line-format\n\
3574 or when it is found in a cons-cell or a list)\n\
3575 %b -- print buffer name. %f -- print visited file name.\n\
3576 %* -- print %, * or hyphen. %+ -- print *, % or hyphen.\n\
3577 % means buffer is read-only and * means it is modified.\n\
3578 For a modified read-only buffer, %* gives % and %+ gives *.\n\
3579 %s -- print process status. %l -- print the current line number.\n\
3580 %p -- print percent of buffer above top of window, or Top, Bot or All.\n\
3581 %P -- print percent of buffer above bottom of window, perhaps plus Top,\n\
3582 or print Bottom or All.\n\
3583 %n -- print Narrow if appropriate.\n\
3584 %t -- print T if files is text, B if binary.\n\
3585 %[ -- print one [ for each recursive editing level. %] similar.\n\
3586 %% -- print %. %- -- print infinitely many dashes.\n\
3587 Decimal digits after the % specify field width to which to pad.");
3588 */
3589
3590 DEFVAR_LISP_NOPRO ("default-major-mode", &buffer_defaults.major_mode,
3591 "*Major mode for new buffers. Defaults to `fundamental-mode'.\n\
3592 nil here means use current buffer's major mode.");
3593
3594 DEFVAR_PER_BUFFER ("major-mode", &current_buffer->major_mode,
3595 make_number (Lisp_Symbol),
3596 "Symbol for current buffer's major mode.");
3597
3598 DEFVAR_PER_BUFFER ("mode-name", &current_buffer->mode_name,
3599 make_number (Lisp_String),
3600 "Pretty name of current buffer's major mode (a string).");
3601
3602 DEFVAR_PER_BUFFER ("abbrev-mode", &current_buffer->abbrev_mode, Qnil,
3603 "Non-nil turns on automatic expansion of abbrevs as they are inserted.\n\
3604 Automatically becomes buffer-local when set in any fashion.");
3605
3606 DEFVAR_PER_BUFFER ("case-fold-search", &current_buffer->case_fold_search,
3607 Qnil,
3608 "*Non-nil if searches should ignore case.\n\
3609 Automatically becomes buffer-local when set in any fashion.");
3610
3611 DEFVAR_PER_BUFFER ("fill-column", &current_buffer->fill_column,
3612 make_number (Lisp_Int),
3613 "*Column beyond which automatic line-wrapping should happen.\n\
3614 Automatically becomes buffer-local when set in any fashion.");
3615
3616 DEFVAR_PER_BUFFER ("left-margin", &current_buffer->left_margin,
3617 make_number (Lisp_Int),
3618 "*Column for the default indent-line-function to indent to.\n\
3619 Linefeed indents to this column in Fundamental mode.\n\
3620 Automatically becomes buffer-local when set in any fashion.");
3621
3622 DEFVAR_PER_BUFFER ("tab-width", &current_buffer->tab_width,
3623 make_number (Lisp_Int),
3624 "*Distance between tab stops (for display of tab characters), in columns.\n\
3625 Automatically becomes buffer-local when set in any fashion.");
3626
3627 DEFVAR_PER_BUFFER ("ctl-arrow", &current_buffer->ctl_arrow, Qnil,
3628 "*Non-nil means display control chars with uparrow.\n\
3629 Nil means use backslash and octal digits.\n\
3630 Automatically becomes buffer-local when set in any fashion.\n\
3631 This variable does not apply to characters whose display is specified\n\
3632 in the current display table (if there is one).");
3633
3634 DEFVAR_PER_BUFFER ("truncate-lines", &current_buffer->truncate_lines, Qnil,
3635 "*Non-nil means do not display continuation lines;\n\
3636 give each line of text one screen line.\n\
3637 Automatically becomes buffer-local when set in any fashion.\n\
3638 \n\
3639 Note that this is overridden by the variable\n\
3640 `truncate-partial-width-windows' if that variable is non-nil\n\
3641 and this buffer is not full-frame width.");
3642
3643 #ifdef DOS_NT
3644 DEFVAR_PER_BUFFER ("buffer-file-type", &current_buffer->buffer_file_type,
3645 Qnil,
3646 "Non-nil if the visited file is a binary file.\n\
3647 This variable is meaningful on MS-DOG and Windows NT.\n\
3648 On those systems, it is automatically local in every buffer.\n\
3649 On other systems, this variable is normally always nil.");
3650 #endif
3651
3652 DEFVAR_PER_BUFFER ("default-directory", &current_buffer->directory,
3653 make_number (Lisp_String),
3654 "Name of default directory of current buffer. Should end with slash.\n\
3655 Each buffer has its own value of this variable.");
3656
3657 DEFVAR_PER_BUFFER ("auto-fill-function", &current_buffer->auto_fill_function,
3658 Qnil,
3659 "Function called (if non-nil) to perform auto-fill.\n\
3660 It is called after self-inserting a space at a column beyond `fill-column'.\n\
3661 Each buffer has its own value of this variable.\n\
3662 NOTE: This variable is not an ordinary hook;\n\
3663 It may not be a list of functions.");
3664
3665 DEFVAR_PER_BUFFER ("buffer-file-name", &current_buffer->filename,
3666 make_number (Lisp_String),
3667 "Name of file visited in current buffer, or nil if not visiting a file.\n\
3668 Each buffer has its own value of this variable.");
3669
3670 DEFVAR_PER_BUFFER ("buffer-file-truename", &current_buffer->file_truename,
3671 make_number (Lisp_String),
3672 "Abbreviated truename of file visited in current buffer, or nil if none.\n\
3673 The truename of a file is calculated by `file-truename'\n\
3674 and then abbreviated with `abbreviate-file-name'.\n\
3675 Each buffer has its own value of this variable.");
3676
3677 DEFVAR_PER_BUFFER ("buffer-auto-save-file-name",
3678 &current_buffer->auto_save_file_name,
3679 make_number (Lisp_String),
3680 "Name of file for auto-saving current buffer,\n\
3681 or nil if buffer should not be auto-saved.\n\
3682 Each buffer has its own value of this variable.");
3683
3684 DEFVAR_PER_BUFFER ("buffer-read-only", &current_buffer->read_only, Qnil,
3685 "Non-nil if this buffer is read-only.\n\
3686 Each buffer has its own value of this variable.");
3687
3688 DEFVAR_PER_BUFFER ("buffer-backed-up", &current_buffer->backed_up, Qnil,
3689 "Non-nil if this buffer's file has been backed up.\n\
3690 Backing up is done before the first time the file is saved.\n\
3691 Each buffer has its own value of this variable.");
3692
3693 DEFVAR_PER_BUFFER ("buffer-saved-size", &current_buffer->save_length,
3694 make_number (Lisp_Int),
3695 "Length of current buffer when last read in, saved or auto-saved.\n\
3696 0 initially.\n\
3697 Each buffer has its own value of this variable.");
3698
3699 DEFVAR_PER_BUFFER ("selective-display", &current_buffer->selective_display,
3700 Qnil,
3701 "Non-nil enables selective display:\n\
3702 Integer N as value means display only lines\n\
3703 that start with less than n columns of space.\n\
3704 A value of t means, after a ^M, all the rest of the line is invisible.\n\
3705 Then ^M's in the file are written into files as newlines.\n\n\
3706 Automatically becomes buffer-local when set in any fashion.");
3707
3708 #ifndef old
3709 DEFVAR_PER_BUFFER ("selective-display-ellipses",
3710 &current_buffer->selective_display_ellipses,
3711 Qnil,
3712 "t means display ... on previous line when a line is invisible.\n\
3713 Automatically becomes buffer-local when set in any fashion.");
3714 #endif
3715
3716 DEFVAR_PER_BUFFER ("overwrite-mode", &current_buffer->overwrite_mode, Qnil,
3717 "Non-nil if self-insertion should replace existing text.\n\
3718 The value should be one of `overwrite-mode-textual',\n\
3719 `overwrite-mode-binary', or nil.\n\
3720 If it is `overwrite-mode-textual', self-insertion still\n\
3721 inserts at the end of a line, and inserts when point is before a tab,\n\
3722 until the tab is filled in.\n\
3723 If `overwrite-mode-binary', self-insertion replaces newlines and tabs too.\n\
3724 Automatically becomes buffer-local when set in any fashion.");
3725
3726 #if 0 /* The doc string is too long for some compilers,
3727 but make-docfile can find it in this comment. */
3728 DEFVAR_PER_BUFFER ("buffer-display-table", &current_buffer->display_table,
3729 Qnil,
3730 "Display table that controls display of the contents of current buffer.\n\
3731 Automatically becomes buffer-local when set in any fashion.\n\
3732 The display table is a vector created with `make-display-table'.\n\
3733 The first 256 elements control how to display each possible text character.\n\
3734 Each value should be a vector of characters or nil;\n\
3735 nil means display the character in the default fashion.\n\
3736 The remaining six elements control the display of\n\
3737 the end of a truncated screen line (element 256, a single character);\n\
3738 the end of a continued line (element 257, a single character);\n\
3739 the escape character used to display character codes in octal\n\
3740 (element 258, a single character);\n\
3741 the character used as an arrow for control characters (element 259,\n\
3742 a single character);\n\
3743 the decoration indicating the presence of invisible lines (element 260,\n\
3744 a vector of characters);\n\
3745 the character used to draw the border between side-by-side windows\n\
3746 (element 261, a single character).\n\
3747 If this variable is nil, the value of `standard-display-table' is used.\n\
3748 Each window can have its own, overriding display table.");
3749 #endif
3750 DEFVAR_PER_BUFFER ("buffer-display-table", &current_buffer->display_table,
3751 Qnil, 0);
3752
3753 /*DEFVAR_LISP ("debug-check-symbol", &Vcheck_symbol,
3754 "Don't ask.");
3755 */
3756 DEFVAR_LISP ("before-change-function", &Vbefore_change_function,
3757 "Function to call before each text change.\n\
3758 Two arguments are passed to the function: the positions of\n\
3759 the beginning and end of the range of old text to be changed.\n\
3760 \(For an insertion, the beginning and end are at the same place.)\n\
3761 No information is given about the length of the text after the change.\n\
3762 \n\
3763 Buffer changes made while executing the `before-change-function'\n\
3764 don't call any before-change or after-change functions.\n\
3765 That's because these variables are temporarily set to nil.\n\
3766 As a result, a hook function cannot straightforwardly alter the value of\n\
3767 these variables. See the Emacs Lisp manual for a way of\n\
3768 accomplishing an equivalent result by using other variables.");
3769 Vbefore_change_function = Qnil;
3770
3771 DEFVAR_LISP ("after-change-function", &Vafter_change_function,
3772 "Function to call after each text change.\n\
3773 Three arguments are passed to the function: the positions of\n\
3774 the beginning and end of the range of changed text,\n\
3775 and the length of the pre-change text replaced by that range.\n\
3776 \(For an insertion, the pre-change length is zero;\n\
3777 for a deletion, that length is the number of characters deleted,\n\
3778 and the post-change beginning and end are at the same place.)\n\
3779 \n\
3780 Buffer changes made while executing the `after-change-function'\n\
3781 don't call any before-change or after-change functions.\n\
3782 That's because these variables are temporarily set to nil.\n\
3783 As a result, a hook function cannot straightforwardly alter the value of\n\
3784 these variables. See the Emacs Lisp manual for a way of\n\
3785 accomplishing an equivalent result by using other variables.");
3786 Vafter_change_function = Qnil;
3787
3788 DEFVAR_LISP ("before-change-functions", &Vbefore_change_functions,
3789 "List of functions to call before each text change.\n\
3790 Two arguments are passed to each function: the positions of\n\
3791 the beginning and end of the range of old text to be changed.\n\
3792 \(For an insertion, the beginning and end are at the same place.)\n\
3793 No information is given about the length of the text after the change.\n\
3794 \n\
3795 Buffer changes made while executing the `before-change-functions'\n\
3796 don't call any before-change or after-change functions.\n\
3797 That's because these variables are temporarily set to nil.\n\
3798 As a result, a hook function cannot straightforwardly alter the value of\n\
3799 these variables. See the Emacs Lisp manual for a way of\n\
3800 accomplishing an equivalent result by using other variables.");
3801 Vbefore_change_functions = Qnil;
3802
3803 DEFVAR_LISP ("after-change-functions", &Vafter_change_functions,
3804 "List of function to call after each text change.\n\
3805 Three arguments are passed to each function: the positions of\n\
3806 the beginning and end of the range of changed text,\n\
3807 and the length of the pre-change text replaced by that range.\n\
3808 \(For an insertion, the pre-change length is zero;\n\
3809 for a deletion, that length is the number of characters deleted,\n\
3810 and the post-change beginning and end are at the same place.)\n\
3811 \n\
3812 Buffer changes made while executing the `after-change-functions'\n\
3813 don't call any before-change or after-change functions.\n\
3814 That's because these variables are temporarily set to nil.\n\
3815 As a result, a hook function cannot straightforwardly alter the value of\n\
3816 these variables. See the Emacs Lisp manual for a way of\n\
3817 accomplishing an equivalent result by using other variables.");
3818
3819 Vafter_change_functions = Qnil;
3820
3821 DEFVAR_LISP ("first-change-hook", &Vfirst_change_hook,
3822 "A list of functions to call before changing a buffer which is unmodified.\n\
3823 The functions are run using the `run-hooks' function.");
3824 Vfirst_change_hook = Qnil;
3825 Qfirst_change_hook = intern ("first-change-hook");
3826 staticpro (&Qfirst_change_hook);
3827
3828 #if 0 /* The doc string is too long for some compilers,
3829 but make-docfile can find it in this comment. */
3830 DEFVAR_PER_BUFFER ("buffer-undo-list", &current_buffer->undo_list, Qnil,
3831 "List of undo entries in current buffer.\n\
3832 Recent changes come first; older changes follow newer.\n\
3833 \n\
3834 An entry (BEG . END) represents an insertion which begins at\n\
3835 position BEG and ends at position END.\n\
3836 \n\
3837 An entry (TEXT . POSITION) represents the deletion of the string TEXT\n\
3838 from (abs POSITION). If POSITION is positive, point was at the front\n\
3839 of the text being deleted; if negative, point was at the end.\n\
3840 \n\
3841 An entry (t HIGH . LOW) indicates that the buffer previously had\n\
3842 \"unmodified\" status. HIGH and LOW are the high and low 16-bit portions\n\
3843 of the visited file's modification time, as of that time. If the\n\
3844 modification time of the most recent save is different, this entry is\n\
3845 obsolete.\n\
3846 \n\
3847 An entry (nil PROPERTY VALUE BEG . END) indicates that a text property\n\
3848 was modified between BEG and END. PROPERTY is the property name,\n\
3849 and VALUE is the old value.\n\
3850 \n\
3851 An entry of the form POSITION indicates that point was at the buffer\n\
3852 location given by the integer. Undoing an entry of this form places\n\
3853 point at POSITION.\n\
3854 \n\
3855 nil marks undo boundaries. The undo command treats the changes\n\
3856 between two undo boundaries as a single step to be undone.\n\
3857 \n\
3858 If the value of the variable is t, undo information is not recorded.");
3859 #endif
3860 DEFVAR_PER_BUFFER ("buffer-undo-list", &current_buffer->undo_list, Qnil,
3861 0);
3862
3863 DEFVAR_PER_BUFFER ("mark-active", &current_buffer->mark_active, Qnil,
3864 "Non-nil means the mark and region are currently active in this buffer.\n\
3865 Automatically local in all buffers.");
3866
3867 DEFVAR_PER_BUFFER ("cache-long-line-scans", &current_buffer->cache_long_line_scans, Qnil,
3868 "Non-nil means that Emacs should use caches to handle long lines more quickly.\n\
3869 This variable is buffer-local, in all buffers.\n\
3870 \n\
3871 Normally, the line-motion functions work by scanning the buffer for\n\
3872 newlines. Columnar operations (like move-to-column and\n\
3873 compute-motion) also work by scanning the buffer, summing character\n\
3874 widths as they go. This works well for ordinary text, but if the\n\
3875 buffer's lines are very long (say, more than 500 characters), these\n\
3876 motion functions will take longer to execute. Emacs may also take\n\
3877 longer to update the display.\n\
3878 \n\
3879 If cache-long-line-scans is non-nil, these motion functions cache the\n\
3880 results of their scans, and consult the cache to avoid rescanning\n\
3881 regions of the buffer until the text is modified. The caches are most\n\
3882 beneficial when they prevent the most searching---that is, when the\n\
3883 buffer contains long lines and large regions of characters with the\n\
3884 same, fixed screen width.\n\
3885 \n\
3886 When cache-long-line-scans is non-nil, processing short lines will\n\
3887 become slightly slower (because of the overhead of consulting the\n\
3888 cache), and the caches will use memory roughly proportional to the\n\
3889 number of newlines and characters whose screen width varies.\n\
3890 \n\
3891 The caches require no explicit maintenance; their accuracy is\n\
3892 maintained internally by the Emacs primitives. Enabling or disabling\n\
3893 the cache should not affect the behavior of any of the motion\n\
3894 functions; it should only affect their performance.");
3895
3896 DEFVAR_PER_BUFFER ("point-before-scroll", &current_buffer->point_before_scroll, Qnil,
3897 "Value of point before the last series of scroll operations, or nil.");
3898
3899 DEFVAR_PER_BUFFER ("buffer-file-format", &current_buffer->file_format, Qnil,
3900 "List of formats to use when saving this buffer.\n\
3901 Formats are defined by `format-alist'. This variable is\n\
3902 set when a file is visited. Automatically local in all buffers.");
3903
3904 DEFVAR_PER_BUFFER ("buffer-invisibility-spec",
3905 &current_buffer->invisibility_spec, Qnil,
3906 "Invisibility spec of this buffer.\n\
3907 The default is t, which means that text is invisible\n\
3908 if it has a non-nil `invisible' property.\n\
3909 If the value is a list, a text character is invisible if its `invisible'\n\
3910 property is an element in that list.\n\
3911 If an element is a cons cell of the form (PROP . ELLIPSIS),\n\
3912 then characters with property value PROP are invisible,\n\
3913 and they have an ellipsis as well if ELLIPSIS is non-nil.");
3914
3915 DEFVAR_LISP ("transient-mark-mode", &Vtransient_mark_mode,
3916 "*Non-nil means deactivate the mark when the buffer contents change.");
3917 Vtransient_mark_mode = Qnil;
3918
3919 DEFVAR_LISP ("inhibit-read-only", &Vinhibit_read_only,
3920 "*Non-nil means disregard read-only status of buffers or characters.\n\
3921 If the value is t, disregard `buffer-read-only' and all `read-only'\n\
3922 text properties. If the value is a list, disregard `buffer-read-only'\n\
3923 and disregard a `read-only' text property if the property value\n\
3924 is a member of the list.");
3925 Vinhibit_read_only = Qnil;
3926
3927 DEFVAR_LISP ("kill-buffer-query-functions", &Vkill_buffer_query_functions,
3928 "List of functions called with no args to query before killing a buffer.");
3929 Vkill_buffer_query_functions = Qnil;
3930
3931 defsubr (&Sbuffer_list);
3932 defsubr (&Sget_buffer);
3933 defsubr (&Sget_file_buffer);
3934 defsubr (&Sget_buffer_create);
3935 defsubr (&Smake_indirect_buffer);
3936 defsubr (&Sgenerate_new_buffer_name);
3937 defsubr (&Sbuffer_name);
3938 /*defsubr (&Sbuffer_number);*/
3939 defsubr (&Sbuffer_file_name);
3940 defsubr (&Sbuffer_base_buffer);
3941 defsubr (&Sbuffer_local_variables);
3942 defsubr (&Sbuffer_modified_p);
3943 defsubr (&Sset_buffer_modified_p);
3944 defsubr (&Sbuffer_modified_tick);
3945 defsubr (&Srename_buffer);
3946 defsubr (&Sother_buffer);
3947 defsubr (&Sbuffer_disable_undo);
3948 defsubr (&Sbuffer_enable_undo);
3949 defsubr (&Skill_buffer);
3950 defsubr (&Serase_buffer);
3951 defsubr (&Sset_buffer_major_mode);
3952 defsubr (&Sswitch_to_buffer);
3953 defsubr (&Spop_to_buffer);
3954 defsubr (&Scurrent_buffer);
3955 defsubr (&Sset_buffer);
3956 defsubr (&Sbarf_if_buffer_read_only);
3957 defsubr (&Sbury_buffer);
3958 defsubr (&Skill_all_local_variables);
3959
3960 defsubr (&Soverlayp);
3961 defsubr (&Smake_overlay);
3962 defsubr (&Sdelete_overlay);
3963 defsubr (&Smove_overlay);
3964 defsubr (&Soverlay_start);
3965 defsubr (&Soverlay_end);
3966 defsubr (&Soverlay_buffer);
3967 defsubr (&Soverlay_properties);
3968 defsubr (&Soverlays_at);
3969 defsubr (&Soverlays_in);
3970 defsubr (&Snext_overlay_change);
3971 defsubr (&Sprevious_overlay_change);
3972 defsubr (&Soverlay_recenter);
3973 defsubr (&Soverlay_lists);
3974 defsubr (&Soverlay_get);
3975 defsubr (&Soverlay_put);
3976 }
3977
3978 keys_of_buffer ()
3979 {
3980 initial_define_key (control_x_map, 'b', "switch-to-buffer");
3981 initial_define_key (control_x_map, 'k', "kill-buffer");
3982
3983 /* This must not be in syms_of_buffer, because Qdisabled is not
3984 initialized when that function gets called. */
3985 Fput (intern ("erase-buffer"), Qdisabled, Qt);
3986 }