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