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