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