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