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