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