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