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