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