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