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