* window.c (Fset_window_configuration): Don't select the frame
[bpt/emacs.git] / src / buffer.c
1 /* Buffer manipulation primitives for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1992 Free Software Foundation, Inc.
3
4 This file is part of GNU Emacs.
5
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 1, or (at your option)
9 any later version.
10
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
19
20
21 #include <sys/param.h>
22
23 #ifndef MAXPATHLEN
24 /* in 4.1, param.h fails to define this. */
25 #define MAXPATHLEN 1024
26 #endif /* not MAXPATHLEN */
27
28 #include "config.h"
29 #include "lisp.h"
30 #include "window.h"
31 #include "commands.h"
32 #include "buffer.h"
33 #include "syntax.h"
34 #include "indent.h"
35
36 struct buffer *current_buffer; /* the current buffer */
37
38 /* First buffer in chain of all buffers (in reverse order of creation).
39 Threaded through ->next. */
40
41 struct buffer *all_buffers;
42
43 /* This structure holds the default values of the buffer-local variables
44 defined with DEFVAR_PER_BUFFER, that have special slots in each buffer.
45 The default value occupies the same slot in this structure
46 as an individual buffer's value occupies in that buffer.
47 Setting the default value also goes through the alist of buffers
48 and stores into each buffer that does not say it has a local value. */
49
50 struct buffer buffer_defaults;
51
52 /* A Lisp_Object pointer to the above, used for staticpro */
53
54 static Lisp_Object Vbuffer_defaults;
55
56 /* This structure marks which slots in a buffer have corresponding
57 default values in buffer_defaults.
58 Each such slot has a nonzero value in this structure.
59 The value has only one nonzero bit.
60
61 When a buffer has its own local value for a slot,
62 the bit for that slot (found in the same slot in this structure)
63 is turned on in the buffer's local_var_flags slot.
64
65 If a slot in this structure is -1, then even though there may
66 be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
67 and the corresponding slot in buffer_defaults is not used.
68
69 If a slot is -2, then there is no DEFVAR_PER_BUFFER for it,
70 but there is a default value which is copied into each buffer.
71
72 If a slot in this structure is negative, then even though there may
73 be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
74 and the corresponding slot in buffer_defaults is not used.
75
76 If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is
77 zero, that is a bug */
78
79 struct buffer buffer_local_flags;
80
81 /* This structure holds the names of symbols whose values may be
82 buffer-local. It is indexed and accessed in the same way as the above. */
83
84 struct buffer buffer_local_symbols;
85 /* A Lisp_Object pointer to the above, used for staticpro */
86 static Lisp_Object Vbuffer_local_symbols;
87
88 /* This structure holds the required types for the values in the
89 buffer-local slots. If a slot contains Qnil, then the
90 corresponding buffer slot may contain a value of any type. If a
91 slot contains an integer, then prospective values' tags must be
92 equal to that integer. When a tag does not match, the function
93 buffer_slot_type_mismatch will signal an error. */
94 struct buffer buffer_local_types;
95
96 /* Nonzero means don't allow modification of protected fields. */
97
98 int check_protected_fields;
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 /* Function to call before changing an unmodified buffer. */
113 Lisp_Object Vfirst_change_function;
114
115 Lisp_Object Qfundamental_mode, Qmode_class, Qpermanent_local;
116
117 Lisp_Object Qprotected_field;
118
119 Lisp_Object QSFundamental; /* A string "Fundamental" */
120
121 Lisp_Object Qkill_buffer_hook;
122
123 /* For debugging; temporary. See set_buffer_internal. */
124 /* Lisp_Object Qlisp_mode, Vcheck_symbol; */
125
126 nsberror (spec)
127 Lisp_Object spec;
128 {
129 if (XTYPE (spec) == Lisp_String)
130 error ("No buffer named %s", XSTRING (spec)->data);
131 error ("Invalid buffer argument");
132 }
133 \f
134 DEFUN ("buffer-list", Fbuffer_list, Sbuffer_list, 0, 0, 0,
135 "Return a list of all existing live buffers.")
136 ()
137 {
138 return Fmapcar (Qcdr, Vbuffer_alist);
139 }
140
141 DEFUN ("get-buffer", Fget_buffer, Sget_buffer, 1, 1, 0,
142 "Return the buffer named NAME (a string).\n\
143 If there is no live buffer named NAME, return nil.\n\
144 NAME may also be a buffer; if so, the value is that buffer.")
145 (name)
146 register Lisp_Object name;
147 {
148 if (XTYPE (name) == Lisp_Buffer)
149 return name;
150 CHECK_STRING (name, 0);
151
152 return Fcdr (Fassoc (name, Vbuffer_alist));
153 }
154
155 DEFUN ("get-file-buffer", Fget_file_buffer, Sget_file_buffer, 1, 1, 0,
156 "Return the buffer visiting file FILENAME (a string).\n\
157 If there is no such live buffer, return nil.")
158 (filename)
159 register Lisp_Object filename;
160 {
161 register Lisp_Object tail, buf, tem;
162 CHECK_STRING (filename, 0);
163 filename = Fexpand_file_name (filename, Qnil);
164
165 for (tail = Vbuffer_alist; CONSP (tail); tail = XCONS (tail)->cdr)
166 {
167 buf = Fcdr (XCONS (tail)->car);
168 if (XTYPE (buf) != Lisp_Buffer) continue;
169 if (XTYPE (XBUFFER (buf)->filename) != Lisp_String) continue;
170 tem = Fstring_equal (XBUFFER (buf)->filename, filename);
171 if (!NILP (tem))
172 return buf;
173 }
174 return Qnil;
175 }
176
177 /* Incremented for each buffer created, to assign the buffer number. */
178 int buffer_count;
179
180 DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 1, 0,
181 "Return the buffer named NAME, or create such a buffer and return it.\n\
182 A new buffer is created if there is no live buffer named NAME.\n\
183 If NAME starts with a space, the new buffer does not keep undo information.\n\
184 If NAME is a buffer instead of a string, then it is the value returned.\n\
185 The value is never nil.")
186 (name)
187 register Lisp_Object name;
188 {
189 register Lisp_Object buf, function, tem;
190 int count = specpdl_ptr - specpdl;
191 register struct buffer *b;
192
193 buf = Fget_buffer (name);
194 if (!NILP (buf))
195 return buf;
196
197 b = (struct buffer *) malloc (sizeof (struct buffer));
198 if (!b)
199 memory_full ();
200
201 BUF_GAP_SIZE (b) = 20;
202 BUFFER_ALLOC (BUF_BEG_ADDR (b), BUF_GAP_SIZE (b));
203 if (! BUF_BEG_ADDR (b))
204 memory_full ();
205
206 BUF_PT (b) = 1;
207 BUF_GPT (b) = 1;
208 BUF_BEGV (b) = 1;
209 BUF_ZV (b) = 1;
210 BUF_Z (b) = 1;
211 BUF_MODIFF (b) = 1;
212
213 /* Put this on the chain of all buffers including killed ones. */
214 b->next = all_buffers;
215 all_buffers = b;
216
217 b->mark = Fmake_marker ();
218 /*b->number = make_number (++buffer_count);*/
219 b->name = name;
220 if (XSTRING (name)->data[0] != ' ')
221 b->undo_list = Qnil;
222 else
223 b->undo_list = Qt;
224
225 reset_buffer (b);
226
227 /* Put this in the alist of all live buffers. */
228 XSET (buf, Lisp_Buffer, b);
229 Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));
230
231 b->mark = Fmake_marker ();
232 b->markers = Qnil;
233 b->name = name;
234
235 function = buffer_defaults.major_mode;
236 if (NILP (function))
237 {
238 tem = Fget (current_buffer->major_mode, Qmode_class);
239 if (EQ (tem, Qnil))
240 function = current_buffer->major_mode;
241 }
242
243 if (NILP (function) || EQ (function, Qfundamental_mode))
244 return buf;
245
246 /* To select a nonfundamental mode,
247 select the buffer temporarily and then call the mode function. */
248
249 record_unwind_protect (save_excursion_restore, save_excursion_save ());
250
251 Fset_buffer (buf);
252 call0 (function);
253
254 return unbind_to (count, buf);
255 }
256
257 /* Reinitialize everything about a buffer except its name and contents. */
258
259 void
260 reset_buffer (b)
261 register struct buffer *b;
262 {
263 b->filename = Qnil;
264 b->directory = (current_buffer) ? current_buffer->directory : Qnil;
265 b->modtime = 0;
266 b->save_modified = 1;
267 b->save_length = 0;
268 b->last_window_start = 1;
269 b->backed_up = Qnil;
270 b->auto_save_modified = 0;
271 b->auto_save_file_name = Qnil;
272 b->read_only = Qnil;
273 b->fieldlist = Qnil;
274 reset_buffer_local_variables(b);
275 }
276
277 reset_buffer_local_variables(b)
278 register struct buffer *b;
279 {
280 register int offset;
281
282 /* Reset the major mode to Fundamental, together with all the
283 things that depend on the major mode.
284 default-major-mode is handled at a higher level.
285 We ignore it here. */
286 b->major_mode = Qfundamental_mode;
287 b->keymap = Qnil;
288 b->abbrev_table = Vfundamental_mode_abbrev_table;
289 b->mode_name = QSFundamental;
290 b->minor_modes = Qnil;
291 b->downcase_table = Vascii_downcase_table;
292 b->upcase_table = Vascii_upcase_table;
293 b->case_canon_table = Vascii_downcase_table;
294 b->case_eqv_table = Vascii_upcase_table;
295 #if 0
296 b->sort_table = XSTRING (Vascii_sort_table);
297 b->folding_sort_table = XSTRING (Vascii_folding_sort_table);
298 #endif /* 0 */
299
300 /* Reset all per-buffer variables to their defaults. */
301 b->local_var_alist = Qnil;
302 b->local_var_flags = 0;
303
304 /* For each slot that has a default value,
305 copy that into the slot. */
306
307 for (offset = (char *)&buffer_local_flags.name - (char *)&buffer_local_flags;
308 offset < sizeof (struct buffer);
309 offset += sizeof (Lisp_Object)) /* sizeof int == sizeof Lisp_Object */
310 if (*(int *)(offset + (char *) &buffer_local_flags) > 0
311 || *(int *)(offset + (char *) &buffer_local_flags) == -2)
312 *(Lisp_Object *)(offset + (char *)b) =
313 *(Lisp_Object *)(offset + (char *)&buffer_defaults);
314 }
315
316 /* We split this away from generate-new-buffer, because rename-buffer
317 and set-visited-file-name ought to be able to use this to really
318 rename the buffer properly. */
319
320 DEFUN ("generate-new-buffer-name", Fgenerate_new_buffer_name, Sgenerate_new_buffer_name,
321 1, 1, 0,
322 "Return a string that is the name of no existing buffer based on NAME.\n\
323 If there is no live buffer named NAME, then return NAME.\n\
324 Otherwise modify name by appending `<NUMBER>', incrementing NUMBER\n\
325 until an unused name is found, and then return that name.")
326 (name)
327 register Lisp_Object name;
328 {
329 register Lisp_Object gentemp, tem;
330 int count;
331 char number[10];
332
333 CHECK_STRING (name, 0);
334
335 tem = Fget_buffer (name);
336 if (NILP (tem))
337 return name;
338
339 count = 1;
340 while (1)
341 {
342 sprintf (number, "<%d>", ++count);
343 gentemp = concat2 (name, build_string (number));
344 tem = Fget_buffer (gentemp);
345 if (NILP (tem))
346 return gentemp;
347 }
348 }
349
350 \f
351 DEFUN ("buffer-name", Fbuffer_name, Sbuffer_name, 0, 1, 0,
352 "Return the name of BUFFER, as a string.\n\
353 With no argument or nil as argument, return the name of the current buffer.")
354 (buffer)
355 register Lisp_Object buffer;
356 {
357 if (NILP (buffer))
358 return current_buffer->name;
359 CHECK_BUFFER (buffer, 0);
360 return XBUFFER (buffer)->name;
361 }
362
363 DEFUN ("buffer-file-name", Fbuffer_file_name, Sbuffer_file_name, 0, 1, 0,
364 "Return name of file BUFFER is visiting, or nil if none.\n\
365 No argument or nil as argument means use the current buffer.")
366 (buffer)
367 register Lisp_Object buffer;
368 {
369 if (NILP (buffer))
370 return current_buffer->filename;
371 CHECK_BUFFER (buffer, 0);
372 return XBUFFER (buffer)->filename;
373 }
374
375 DEFUN ("buffer-local-variables", Fbuffer_local_variables,
376 Sbuffer_local_variables, 0, 1, 0,
377 "Return an alist of variables that are buffer-local in BUFFER.\n\
378 Each element looks like (SYMBOL . VALUE) and describes one variable.\n\
379 Note that storing new VALUEs in these elements doesn't change the variables.\n\
380 No argument or nil as argument means use current buffer as BUFFER.")
381 (buffer)
382 register Lisp_Object buffer;
383 {
384 register struct buffer *buf;
385 register Lisp_Object val;
386
387 if (NILP (buffer))
388 buf = current_buffer;
389 else
390 {
391 CHECK_BUFFER (buffer, 0);
392 buf = XBUFFER (buffer);
393 }
394
395 {
396 /* Reference each variable in the alist in our current buffer.
397 If inquiring about the current buffer, this gets the current values,
398 so store them into the alist so the alist is up to date.
399 If inquiring about some other buffer, this swaps out any values
400 for that buffer, making the alist up to date automatically. */
401 register Lisp_Object tem;
402 for (tem = buf->local_var_alist; CONSP (tem); tem = XCONS (tem)->cdr)
403 {
404 Lisp_Object v1 = Fsymbol_value (XCONS (XCONS (tem)->car)->car);
405 if (buf == current_buffer)
406 XCONS (XCONS (tem)->car)->cdr = v1;
407 }
408 }
409
410 /* Make a copy of the alist, to return it. */
411 val = Fcopy_alist (buf->local_var_alist);
412
413 /* Add on all the variables stored in special slots. */
414 {
415 register int offset, mask;
416
417 for (offset = (char *)&buffer_local_symbols.name - (char *)&buffer_local_symbols;
418 offset < sizeof (struct buffer);
419 offset += (sizeof (int))) /* sizeof int == sizeof Lisp_Object */
420 {
421 mask = *(int *)(offset + (char *) &buffer_local_flags);
422 if (mask == -1 || (buf->local_var_flags & mask))
423 if (XTYPE (*(Lisp_Object *)(offset + (char *)&buffer_local_symbols))
424 == Lisp_Symbol)
425 val = Fcons (Fcons (*(Lisp_Object *)(offset + (char *)&buffer_local_symbols),
426 *(Lisp_Object *)(offset + (char *)buf)),
427 val);
428 }
429 }
430 return (val);
431 }
432
433 \f
434 DEFUN ("buffer-modified-p", Fbuffer_modified_p, Sbuffer_modified_p,
435 0, 1, 0,
436 "Return t if BUFFER was modified since its file was last read or saved.\n\
437 No argument or nil as argument means use current buffer as BUFFER.")
438 (buffer)
439 register Lisp_Object buffer;
440 {
441 register struct buffer *buf;
442 if (NILP (buffer))
443 buf = current_buffer;
444 else
445 {
446 CHECK_BUFFER (buffer, 0);
447 buf = XBUFFER (buffer);
448 }
449
450 return buf->save_modified < BUF_MODIFF (buf) ? Qt : Qnil;
451 }
452
453 DEFUN ("set-buffer-modified-p", Fset_buffer_modified_p, Sset_buffer_modified_p,
454 1, 1, 0,
455 "Mark current buffer as modified or unmodified according to FLAG.\n\
456 A non-nil FLAG means mark the buffer modified.")
457 (flag)
458 register Lisp_Object flag;
459 {
460 register int already;
461 register Lisp_Object fn;
462
463 #ifdef CLASH_DETECTION
464 /* If buffer becoming modified, lock the file.
465 If buffer becoming unmodified, unlock the file. */
466
467 fn = current_buffer->filename;
468 if (!NILP (fn))
469 {
470 already = current_buffer->save_modified < MODIFF;
471 if (!already && !NILP (flag))
472 lock_file (fn);
473 else if (already && NILP (flag))
474 unlock_file (fn);
475 }
476 #endif /* CLASH_DETECTION */
477
478 current_buffer->save_modified = NILP (flag) ? MODIFF : 0;
479 update_mode_lines++;
480 return flag;
481 }
482
483 DEFUN ("buffer-modified-tick", Fbuffer_modified_tick, Sbuffer_modified_tick,
484 0, 1, 0,
485 "Return BUFFER's tick counter, incremented for each change in text.\n\
486 Each buffer has a tick counter which is incremented each time the text in\n\
487 that buffer is changed. It wraps around occasionally.\n\
488 No argument or nil as argument means use current buffer as BUFFER.")
489 (buffer)
490 register Lisp_Object buffer;
491 {
492 register struct buffer *buf;
493 if (NILP (buffer))
494 buf = current_buffer;
495 else
496 {
497 CHECK_BUFFER (buffer, 0);
498 buf = XBUFFER (buffer);
499 }
500
501 return make_number (BUF_MODIFF (buf));
502 }
503 \f
504 DEFUN ("rename-buffer", Frename_buffer, Srename_buffer, 1, 2,
505 "sRename buffer (to new name): ",
506 "Change current buffer's name to NEWNAME (a string).\n\
507 If second arg DISTINGUISH is nil or omitted, it is an error if a\n\
508 buffer named NEWNAME already exists.\n\
509 If DISTINGUISH is non-nil, come up with a new name using\n\
510 `generate-new-buffer-name'.\n\
511 Return the name we actually gave the buffer.\n\
512 This does not change the name of the visited file (if any).")
513 (name, distinguish)
514 register Lisp_Object name, distinguish;
515 {
516 register Lisp_Object tem, buf;
517
518 CHECK_STRING (name, 0);
519 tem = Fget_buffer (name);
520 if (XBUFFER (tem) == current_buffer)
521 return current_buffer->name;
522 if (!NILP (tem))
523 {
524 if (!NILP (distinguish))
525 name = Fgenerate_new_buffer_name (name);
526 else
527 error ("Buffer name \"%s\" is in use", XSTRING (name)->data);
528 }
529
530 current_buffer->name = name;
531 XSET (buf, Lisp_Buffer, current_buffer);
532 Fsetcar (Frassq (buf, Vbuffer_alist), name);
533 if (NILP (current_buffer->filename) && !NILP (current_buffer->auto_save_file_name))
534 call0 (intern ("rename-auto-save-file"));
535 return name;
536 }
537
538 DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 1, 0,
539 "Return most recently selected buffer other than BUFFER.\n\
540 Buffers not visible in windows are preferred to visible buffers.\n\
541 If no other buffer exists, the buffer `*scratch*' is returned.\n\
542 If BUFFER is omitted or nil, some interesting buffer is returned.")
543 (buffer)
544 register Lisp_Object buffer;
545 {
546 register Lisp_Object tail, buf, notsogood, tem;
547 notsogood = Qnil;
548
549 for (tail = Vbuffer_alist; !NILP (tail); tail = Fcdr (tail))
550 {
551 buf = Fcdr (Fcar (tail));
552 if (EQ (buf, buffer))
553 continue;
554 if (XSTRING (XBUFFER (buf)->name)->data[0] == ' ')
555 continue;
556 tem = Fget_buffer_window (buf, Qnil);
557 if (NILP (tem))
558 return buf;
559 if (NILP (notsogood))
560 notsogood = buf;
561 }
562 if (!NILP (notsogood))
563 return notsogood;
564 return Fget_buffer_create (build_string ("*scratch*"));
565 }
566 \f
567 DEFUN ("buffer-disable-undo", Fbuffer_disable_undo, Sbuffer_disable_undo, 1,1,
568 0,
569 "Make BUFFER stop keeping undo information.")
570 (buffer)
571 register Lisp_Object buffer;
572 {
573 Lisp_Object real_buffer;
574
575 if (NILP (buffer))
576 XSET (real_buffer, Lisp_Buffer, current_buffer);
577 else
578 {
579 real_buffer = Fget_buffer (buffer);
580 if (NILP (real_buffer))
581 nsberror (buffer);
582 }
583
584 XBUFFER (real_buffer)->undo_list = Qt;
585
586 return Qnil;
587 }
588
589 DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, Sbuffer_enable_undo,
590 0, 1, "",
591 "Start keeping undo information for buffer BUFFER.\n\
592 No argument or nil as argument means do this for the current buffer.")
593 (buffer)
594 register Lisp_Object buffer;
595 {
596 Lisp_Object real_buffer;
597
598 if (NILP (buffer))
599 XSET (real_buffer, Lisp_Buffer, current_buffer);
600 else
601 {
602 real_buffer = Fget_buffer (buffer);
603 if (NILP (real_buffer))
604 nsberror (buffer);
605 }
606
607 if (EQ (XBUFFER (real_buffer)->undo_list, Qt))
608 XBUFFER (real_buffer)->undo_list = Qnil;
609
610 return Qnil;
611 }
612
613 /*
614 DEFVAR_LISP ("kill-buffer-hook", no_cell, "\
615 Hook to be run (by `run-hooks', which see) when a buffer is killed.\n\
616 The buffer being killed will be current while the hook is running.\n\
617 See `kill-buffer'."
618 */
619 DEFUN ("kill-buffer", Fkill_buffer, Skill_buffer, 1, 1, "bKill buffer: ",
620 "Kill the buffer BUFFER.\n\
621 The argument may be a buffer or may be the name of a buffer.\n\
622 An argument of nil means kill the current buffer.\n\n\
623 Value is t if the buffer is actually killed, nil if user says no.\n\n\
624 The value of `kill-buffer-hook' (which may be local to that buffer),\n\
625 if not void, is a list of functions to be called, with no arguments,\n\
626 before the buffer is actually killed. The buffer to be killed is current\n\
627 when the hook functions are called.\n\n\
628 Any processes that have this buffer as the `process-buffer' are killed\n\
629 with `delete-process'.")
630 (bufname)
631 Lisp_Object bufname;
632 {
633 Lisp_Object buf;
634 register struct buffer *b;
635 register Lisp_Object tem;
636 register struct Lisp_Marker *m;
637 struct gcpro gcpro1, gcpro2;
638
639 if (NILP (bufname))
640 buf = Fcurrent_buffer ();
641 else
642 buf = Fget_buffer (bufname);
643 if (NILP (buf))
644 nsberror (bufname);
645
646 b = XBUFFER (buf);
647
648 /* Query if the buffer is still modified. */
649 if (INTERACTIVE && !NILP (b->filename)
650 && BUF_MODIFF (b) > b->save_modified)
651 {
652 GCPRO2 (buf, bufname);
653 tem = do_yes_or_no_p (format1 ("Buffer %s modified; kill anyway? ",
654 XSTRING (b->name)->data));
655 UNGCPRO;
656 if (NILP (tem))
657 return Qnil;
658 }
659
660 /* Run kill-buffer hook with the buffer to be killed the current buffer. */
661 {
662 register Lisp_Object val;
663 int count = specpdl_ptr - specpdl;
664
665 record_unwind_protect (save_excursion_restore, save_excursion_save ());
666 set_buffer_internal (b);
667 call1 (Vrun_hooks, Qkill_buffer_hook);
668 unbind_to (count, Qnil);
669 }
670
671 /* We have no more questions to ask. Verify that it is valid
672 to kill the buffer. This must be done after the questions
673 since anything can happen within do_yes_or_no_p. */
674
675 /* Don't kill the minibuffer now current. */
676 if (EQ (buf, XWINDOW (minibuf_window)->buffer))
677 return Qnil;
678
679 if (NILP (b->name))
680 return Qnil;
681
682 /* Make this buffer not be current.
683 In the process, notice if this is the sole visible buffer
684 and give up if so. */
685 if (b == current_buffer)
686 {
687 tem = Fother_buffer (buf);
688 Fset_buffer (tem);
689 if (b == current_buffer)
690 return Qnil;
691 }
692
693 /* Now there is no question: we can kill the buffer. */
694
695 #ifdef CLASH_DETECTION
696 /* Unlock this buffer's file, if it is locked. */
697 unlock_buffer (b);
698 #endif /* CLASH_DETECTION */
699
700 kill_buffer_processes (buf);
701
702 tem = Vinhibit_quit;
703 Vinhibit_quit = Qt;
704 Vbuffer_alist = Fdelq (Frassq (buf, Vbuffer_alist), Vbuffer_alist);
705 Freplace_buffer_in_windows (buf);
706 Vinhibit_quit = tem;
707
708 /* Delete any auto-save file. */
709 if (XTYPE (b->auto_save_file_name) == Lisp_String)
710 {
711 Lisp_Object tem;
712 tem = Fsymbol_value (intern ("delete-auto-save-files"));
713 if (! NILP (tem))
714 unlink (XSTRING (b->auto_save_file_name)->data);
715 }
716
717 /* Unchain all markers of this buffer
718 and leave them pointing nowhere. */
719 for (tem = b->markers; !EQ (tem, Qnil); )
720 {
721 m = XMARKER (tem);
722 m->buffer = 0;
723 tem = m->chain;
724 m->chain = Qnil;
725 }
726 b->markers = Qnil;
727
728 b->name = Qnil;
729 BUFFER_FREE (BUF_BEG_ADDR (b));
730 b->undo_list = Qnil;
731
732 return Qt;
733 }
734 \f
735 /* Move the assoc for buffer BUF to the front of buffer-alist. Since
736 we do this each time BUF is selected visibly, the more recently
737 selected buffers are always closer to the front of the list. This
738 means that other_buffer is more likely to choose a relevant buffer. */
739
740 record_buffer (buf)
741 Lisp_Object buf;
742 {
743 register Lisp_Object link, prev;
744
745 prev = Qnil;
746 for (link = Vbuffer_alist; CONSP (link); link = XCONS (link)->cdr)
747 {
748 if (EQ (XCONS (XCONS (link)->car)->cdr, buf))
749 break;
750 prev = link;
751 }
752
753 /* Effectively do Vbuffer_alist = Fdelq (link, Vbuffer_alist);
754 we cannot use Fdelq itself here because it allows quitting. */
755
756 if (NILP (prev))
757 Vbuffer_alist = XCONS (Vbuffer_alist)->cdr;
758 else
759 XCONS (prev)->cdr = XCONS (XCONS (prev)->cdr)->cdr;
760
761 XCONS(link)->cdr = Vbuffer_alist;
762 Vbuffer_alist = link;
763 }
764
765 DEFUN ("switch-to-buffer", Fswitch_to_buffer, Sswitch_to_buffer, 1, 2, "BSwitch to buffer: ",
766 "Select buffer BUFFER in the current window.\n\
767 BUFFER may be a buffer or a buffer name.\n\
768 Optional second arg NORECORD non-nil means\n\
769 do not put this buffer at the front of the list of recently selected ones.\n\
770 \n\
771 WARNING: This is NOT the way to work on another buffer temporarily\n\
772 within a Lisp program! Use `set-buffer' instead. That avoids messing with\n\
773 the window-buffer correspondences.")
774 (bufname, norecord)
775 Lisp_Object bufname, norecord;
776 {
777 register Lisp_Object buf;
778 Lisp_Object tem;
779
780 if (EQ (minibuf_window, selected_window))
781 error ("Cannot switch buffers in minibuffer window");
782 tem = Fwindow_dedicated_p (selected_window);
783 if (!NILP (tem))
784 error ("Cannot switch buffers in a dedicated window");
785
786 if (NILP (bufname))
787 buf = Fother_buffer (Fcurrent_buffer ());
788 else
789 buf = Fget_buffer_create (bufname);
790 Fset_buffer (buf);
791 if (NILP (norecord))
792 record_buffer (buf);
793
794 Fset_window_buffer (EQ (selected_window, minibuf_window)
795 ? Fnext_window (minibuf_window, Qnil) : selected_window,
796 buf);
797
798 return Qnil;
799 }
800
801 DEFUN ("pop-to-buffer", Fpop_to_buffer, Spop_to_buffer, 1, 2, 0,
802 "Select buffer BUFFER in some window, preferably a different one.\n\
803 If BUFFER is nil, then some other buffer is chosen.\n\
804 If `pop-up-windows' is non-nil, windows can be split to do this.\n\
805 If optional second arg OTHER-WINDOW is non-nil, insist on finding another\n\
806 window even if BUFFER is already visible in the selected window.")
807 (bufname, other)
808 Lisp_Object bufname, other;
809 {
810 register Lisp_Object buf;
811 if (NILP (bufname))
812 buf = Fother_buffer (Fcurrent_buffer ());
813 else
814 buf = Fget_buffer_create (bufname);
815 Fset_buffer (buf);
816 record_buffer (buf);
817 Fselect_window (Fdisplay_buffer (buf, other));
818 return Qnil;
819 }
820
821 DEFUN ("current-buffer", Fcurrent_buffer, Scurrent_buffer, 0, 0, 0,
822 "Return the current buffer as a Lisp object.")
823 ()
824 {
825 register Lisp_Object buf;
826 XSET (buf, Lisp_Buffer, current_buffer);
827 return buf;
828 }
829 \f
830 /* Set the current buffer to b */
831
832 void
833 set_buffer_internal (b)
834 register struct buffer *b;
835 {
836 register struct buffer *old_buf;
837 register Lisp_Object tail, valcontents;
838 enum Lisp_Type tem;
839
840 if (current_buffer == b)
841 return;
842
843 windows_or_buffers_changed = 1;
844 old_buf = current_buffer;
845 current_buffer = b;
846 last_known_column_point = -1; /* invalidate indentation cache */
847
848 /* Look down buffer's list of local Lisp variables
849 to find and update any that forward into C variables. */
850
851 for (tail = b->local_var_alist; !NILP (tail); tail = XCONS (tail)->cdr)
852 {
853 valcontents = XSYMBOL (XCONS (XCONS (tail)->car)->car)->value;
854 if ((XTYPE (valcontents) == Lisp_Buffer_Local_Value
855 || XTYPE (valcontents) == Lisp_Some_Buffer_Local_Value)
856 && (tem = XTYPE (XCONS (valcontents)->car),
857 (tem == Lisp_Boolfwd || tem == Lisp_Intfwd
858 || tem == Lisp_Objfwd)))
859 /* Just reference the variable
860 to cause it to become set for this buffer. */
861 Fsymbol_value (XCONS (XCONS (tail)->car)->car);
862 }
863
864 /* Do the same with any others that were local to the previous buffer */
865
866 if (old_buf)
867 for (tail = old_buf->local_var_alist; !NILP (tail); tail = XCONS (tail)->cdr)
868 {
869 valcontents = XSYMBOL (XCONS (XCONS (tail)->car)->car)->value;
870 if ((XTYPE (valcontents) == Lisp_Buffer_Local_Value
871 || XTYPE (valcontents) == Lisp_Some_Buffer_Local_Value)
872 && (tem = XTYPE (XCONS (valcontents)->car),
873 (tem == Lisp_Boolfwd || tem == Lisp_Intfwd
874 || tem == Lisp_Objfwd)))
875 /* Just reference the variable
876 to cause it to become set for this buffer. */
877 Fsymbol_value (XCONS (XCONS (tail)->car)->car);
878 }
879 }
880
881 DEFUN ("set-buffer", Fset_buffer, Sset_buffer, 1, 1, 0,
882 "Make the buffer BUFFER current for editing operations.\n\
883 BUFFER may be a buffer or the name of an existing buffer.\n\
884 See also `save-excursion' when you want to make a buffer current temporarily.\n\
885 This function does not display the buffer, so its effect ends\n\
886 when the current command terminates.\n\
887 Use `switch-to-buffer' or `pop-to-buffer' to switch buffers permanently.")
888 (bufname)
889 register Lisp_Object bufname;
890 {
891 register Lisp_Object buffer;
892 buffer = Fget_buffer (bufname);
893 if (NILP (buffer))
894 nsberror (bufname);
895 if (NILP (XBUFFER (buffer)->name))
896 error ("Selecting deleted buffer");
897 set_buffer_internal (XBUFFER (buffer));
898 return buffer;
899 }
900 \f
901 DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only,
902 Sbarf_if_buffer_read_only, 0, 0, 0,
903 "Signal a `buffer-read-only' error if the current buffer is read-only.")
904 ()
905 {
906 while (!NILP (current_buffer->read_only))
907 Fsignal (Qbuffer_read_only, (Fcons (Fcurrent_buffer (), Qnil)));
908 return Qnil;
909 }
910
911 DEFUN ("bury-buffer", Fbury_buffer, Sbury_buffer, 0, 1, "",
912 "Put BUFFER at the end of the list of all buffers.\n\
913 There it is the least likely candidate for `other-buffer' to return;\n\
914 thus, the least likely buffer for \\[switch-to-buffer] to select by default.\n\
915 BUFFER is also removed from the selected window if it was displayed there.\n\
916 If BUFFER is omitted, the current buffer is buried.")
917 (buf)
918 register Lisp_Object buf;
919 {
920 /* Figure out what buffer we're going to bury. */
921 if (NILP (buf))
922 XSET (buf, Lisp_Buffer, current_buffer);
923 else
924 {
925 Lisp_Object buf1;
926
927 buf1 = Fget_buffer (buf);
928 if (NILP (buf1))
929 nsberror (buf);
930 buf = buf1;
931 }
932
933 /* Remove it from the screen. */
934 if (EQ (buf, XWINDOW (selected_window)->buffer))
935 Fswitch_to_buffer (Fother_buffer (buf), Qnil);
936
937 /* Move it to the end of the buffer list. */
938 {
939 register Lisp_Object aelt, link;
940
941 aelt = Frassq (buf, Vbuffer_alist);
942 link = Fmemq (aelt, Vbuffer_alist);
943 Vbuffer_alist = Fdelq (aelt, Vbuffer_alist);
944 XCONS (link)->cdr = Qnil;
945 Vbuffer_alist = nconc2 (Vbuffer_alist, link);
946 }
947
948 return Qnil;
949 }
950 \f
951 DEFUN ("erase-buffer", Ferase_buffer, Serase_buffer, 0, 0, 0,
952 "Delete the entire contents of the current buffer.\n\
953 Any clipping restriction in effect (see `narrow-to-buffer') is removed,\n\
954 so the buffer is truly empty after this.")
955 ()
956 {
957 Fwiden ();
958 del_range (BEG, Z);
959 current_buffer->last_window_start = 1;
960 /* Prevent warnings, or suspension of auto saving, that would happen
961 if future size is less than past size. Use of erase-buffer
962 implies that the future text is not really related to the past text. */
963 XFASTINT (current_buffer->save_length) = 0;
964 return Qnil;
965 }
966
967 validate_region (b, e)
968 register Lisp_Object *b, *e;
969 {
970 register int i;
971
972 CHECK_NUMBER_COERCE_MARKER (*b, 0);
973 CHECK_NUMBER_COERCE_MARKER (*e, 1);
974
975 if (XINT (*b) > XINT (*e))
976 {
977 i = XFASTINT (*b); /* This is legit even if *b is < 0 */
978 *b = *e;
979 XFASTINT (*e) = i; /* because this is all we do with i. */
980 }
981
982 if (!(BEGV <= XINT (*b) && XINT (*b) <= XINT (*e)
983 && XINT (*e) <= ZV))
984 args_out_of_range (*b, *e);
985 }
986 \f
987 Lisp_Object
988 list_buffers_1 (files)
989 Lisp_Object files;
990 {
991 register Lisp_Object tail, tem, buf;
992 Lisp_Object col1, col2, col3, minspace;
993 register struct buffer *old = current_buffer, *b;
994 int desired_point = 0;
995 Lisp_Object other_file_symbol;
996
997 other_file_symbol = intern ("list-buffers-directory");
998
999 XFASTINT (col1) = 19;
1000 XFASTINT (col2) = 25;
1001 XFASTINT (col3) = 40;
1002 XFASTINT (minspace) = 1;
1003
1004 Fset_buffer (Vstandard_output);
1005
1006 tail = intern ("Buffer-menu-mode");
1007 if (!EQ (tail, current_buffer->major_mode)
1008 && (tem = Ffboundp (tail), !NILP (tem)))
1009 call0 (tail);
1010 Fbuffer_disable_undo (Vstandard_output);
1011 current_buffer->read_only = Qnil;
1012
1013 write_string ("\
1014 MR Buffer Size Mode File\n\
1015 -- ------ ---- ---- ----\n", -1);
1016
1017 for (tail = Vbuffer_alist; !NILP (tail); tail = Fcdr (tail))
1018 {
1019 buf = Fcdr (Fcar (tail));
1020 b = XBUFFER (buf);
1021 /* Don't mention the minibuffers. */
1022 if (XSTRING (b->name)->data[0] == ' ')
1023 continue;
1024 /* Optionally don't mention buffers that lack files. */
1025 if (!NILP (files) && NILP (b->filename))
1026 continue;
1027 /* Identify the current buffer. */
1028 if (b == old)
1029 desired_point = point;
1030 write_string (b == old ? "." : " ", -1);
1031 /* Identify modified buffers */
1032 write_string (BUF_MODIFF (b) > b->save_modified ? "*" : " ", -1);
1033 write_string (NILP (b->read_only) ? " " : "% ", -1);
1034 Fprinc (b->name, Qnil);
1035 Findent_to (col1, make_number (2));
1036 XFASTINT (tem) = BUF_Z (b) - BUF_BEG (b);
1037 Fprin1 (tem, Qnil);
1038 Findent_to (col2, minspace);
1039 Fprinc (b->mode_name, Qnil);
1040 Findent_to (col3, minspace);
1041
1042 if (!NILP (b->filename))
1043 Fprinc (b->filename, Qnil);
1044 else
1045 {
1046 /* No visited file; check local value of list-buffers-directory. */
1047 Lisp_Object tem;
1048 set_buffer_internal (b);
1049 tem = Fboundp (other_file_symbol);
1050 if (!NILP (tem))
1051 {
1052 tem = Fsymbol_value (other_file_symbol);
1053 Fset_buffer (Vstandard_output);
1054 if (XTYPE (tem) == Lisp_String)
1055 Fprinc (tem, Qnil);
1056 }
1057 else
1058 Fset_buffer (Vstandard_output);
1059 }
1060 write_string ("\n", -1);
1061 }
1062
1063 current_buffer->read_only = Qt;
1064 set_buffer_internal (old);
1065 /* Foo. This doesn't work since temp_output_buffer_show sets point to 1
1066 if (desired_point)
1067 XBUFFER (Vstandard_output)->text.pointloc = desired_point;
1068 */
1069 return Qnil;
1070 }
1071
1072 DEFUN ("list-buffers", Flist_buffers, Slist_buffers, 0, 1, "P",
1073 "Display a list of names of existing buffers.\n\
1074 The list is displayed in a buffer named `*Buffer List*'.\n\
1075 Note that buffers with names starting with spaces are omitted.\n\
1076 Non-null optional arg FILES-ONLY means mention only file buffers.\n\
1077 \n\
1078 The M column contains a * for buffers that are modified.\n\
1079 The R column contains a % for buffers that are read-only.")
1080 (files)
1081 Lisp_Object files;
1082 {
1083 internal_with_output_to_temp_buffer ("*Buffer List*",
1084 list_buffers_1, files);
1085 return Qnil;
1086 }
1087
1088 DEFUN ("kill-all-local-variables", Fkill_all_local_variables, Skill_all_local_variables,
1089 0, 0, 0,
1090 "Switch to Fundamental mode by killing current buffer's local variables.\n\
1091 Most local variable bindings are eliminated so that the default values\n\
1092 become effective once more. Also, the syntax table is set from\n\
1093 `standard-syntax-table', the local keymap is set to nil,\n\
1094 and the abbrev table from `fundamental-mode-abbrev-table'.\n\
1095 This function also forces redisplay of the mode line.\n\
1096 \n\
1097 Every function to select a new major mode starts by\n\
1098 calling this function.\n\n\
1099 As a special exception, local variables whose names have\n\
1100 a non-nil `permanent-local' property are not eliminated by this function.")
1101 ()
1102 {
1103 register Lisp_Object alist, sym, tem;
1104 Lisp_Object oalist;
1105 oalist = current_buffer->local_var_alist;
1106
1107 /* Make sure no local variables remain set up with this buffer
1108 for their current values. */
1109
1110 for (alist = oalist; !NILP (alist); alist = XCONS (alist)->cdr)
1111 {
1112 sym = XCONS (XCONS (alist)->car)->car;
1113
1114 /* Need not do anything if some other buffer's binding is now encached. */
1115 tem = XCONS (XCONS (XSYMBOL (sym)->value)->cdr)->car;
1116 if (XBUFFER (tem) == current_buffer)
1117 {
1118 /* Symbol is set up for this buffer's old local value.
1119 Set it up for the current buffer with the default value. */
1120
1121 tem = XCONS (XCONS (XSYMBOL (sym)->value)->cdr)->cdr;
1122 XCONS (tem)->car = tem;
1123 XCONS (XCONS (XSYMBOL (sym)->value)->cdr)->car = Fcurrent_buffer ();
1124 store_symval_forwarding (sym, XCONS (XSYMBOL (sym)->value)->car,
1125 XCONS (tem)->cdr);
1126 }
1127 }
1128
1129 /* Actually eliminate all local bindings of this buffer. */
1130
1131 reset_buffer_local_variables (current_buffer);
1132
1133 /* Redisplay mode lines; we are changing major mode. */
1134
1135 update_mode_lines++;
1136
1137 /* Any which are supposed to be permanent,
1138 make local again, with the same values they had. */
1139
1140 for (alist = oalist; !NILP (alist); alist = XCONS (alist)->cdr)
1141 {
1142 sym = XCONS (XCONS (alist)->car)->car;
1143 tem = Fget (sym, Qpermanent_local);
1144 if (! NILP (tem))
1145 {
1146 Fmake_local_variable (sym);
1147 Fset (sym, XCONS (XCONS (alist)->car)->cdr);
1148 }
1149 }
1150
1151 /* Force mode-line redisplay. Useful here because all major mode
1152 commands call this function. */
1153 update_mode_lines++;
1154
1155 return Qnil;
1156 }
1157 \f
1158 DEFUN ("region-fields", Fregion_fields, Sregion_fields, 2, 4, "",
1159 "Return list of fields overlapping a given portion of a buffer.\n\
1160 The portion is specified by arguments START, END and BUFFER.\n\
1161 BUFFER defaults to the current buffer.\n\
1162 Optional 4th arg ERROR-CHECK non nil means just report an error\n\
1163 if any protected fields overlap this portion.")
1164 (start, end, buffer, error_check)
1165 Lisp_Object start, end, buffer, error_check;
1166 {
1167 register int start_loc, end_loc;
1168 Lisp_Object fieldlist;
1169 Lisp_Object collector;
1170
1171 if (NILP (buffer))
1172 fieldlist = current_buffer->fieldlist;
1173 else
1174 {
1175 CHECK_BUFFER (buffer, 1);
1176 fieldlist = XBUFFER (buffer)->fieldlist;
1177 }
1178
1179 CHECK_NUMBER_COERCE_MARKER (start, 2);
1180 start_loc = XINT (start);
1181
1182 CHECK_NUMBER_COERCE_MARKER (end, 2);
1183 end_loc = XINT (end);
1184
1185 collector = Qnil;
1186
1187 while (XTYPE (fieldlist) == Lisp_Cons)
1188 {
1189 register Lisp_Object field;
1190 register int field_start, field_end;
1191
1192 field = XCONS (fieldlist)->car;
1193 field_start = marker_position (FIELD_START_MARKER (field)) - 1;
1194 field_end = marker_position (FIELD_END_MARKER (field));
1195
1196 if ((start_loc < field_start && end_loc > field_start)
1197 || (start_loc >= field_start && start_loc < field_end))
1198 {
1199 if (!NILP (error_check))
1200 {
1201 if (!NILP (FIELD_PROTECTED_FLAG (field)))
1202 {
1203 struct gcpro gcpro1;
1204 GCPRO1 (fieldlist);
1205 Fsignal (Qprotected_field, Fcons (field, Qnil));
1206 UNGCPRO;
1207 }
1208 }
1209 else
1210 collector = Fcons (field, collector);
1211 }
1212
1213 fieldlist = XCONS (fieldlist)->cdr;
1214 }
1215
1216 return collector;
1217 }
1218 \f
1219 /* Somebody has tried to store NEWVAL into the buffer-local slot with
1220 offset XUINT (valcontents), and NEWVAL has an unacceptable type. */
1221 void
1222 buffer_slot_type_mismatch (valcontents, newval)
1223 Lisp_Object valcontents, newval;
1224 {
1225 unsigned int offset = XUINT (valcontents);
1226 char *symbol_name =
1227 (XSYMBOL (*(Lisp_Object *)(offset + (char *)&buffer_local_symbols))
1228 ->name->data);
1229 char *type_name;
1230
1231 switch (XINT (*(Lisp_Object *)(offset + (char *)&buffer_local_types)))
1232 {
1233 case Lisp_Int: type_name = "integers"; break;
1234 case Lisp_String: type_name = "strings"; break;
1235 case Lisp_Marker: type_name = "markers"; break;
1236 case Lisp_Symbol: type_name = "symbols"; break;
1237 case Lisp_Cons: type_name = "lists"; break;
1238 case Lisp_Vector: type_name = "vector"; break;
1239 default:
1240 abort ();
1241 }
1242
1243 error ("only %s should be stored in the buffer-local variable %s",
1244 type_name, symbol_name);
1245 }
1246 \f
1247 init_buffer_once ()
1248 {
1249 register Lisp_Object tem;
1250
1251 /* Make sure all markable slots in buffer_defaults
1252 are initialized reasonably, so mark_buffer won't choke. */
1253 reset_buffer (&buffer_defaults);
1254 reset_buffer (&buffer_local_symbols);
1255 XSET (Vbuffer_defaults, Lisp_Buffer, &buffer_defaults);
1256 XSET (Vbuffer_local_symbols, Lisp_Buffer, &buffer_local_symbols);
1257
1258 /* Set up the default values of various buffer slots. */
1259 /* Must do these before making the first buffer! */
1260
1261 /* real setup is done in loaddefs.el */
1262 buffer_defaults.mode_line_format = build_string ("%-");
1263 buffer_defaults.abbrev_mode = Qnil;
1264 buffer_defaults.overwrite_mode = Qnil;
1265 buffer_defaults.case_fold_search = Qt;
1266 buffer_defaults.auto_fill_function = Qnil;
1267 buffer_defaults.selective_display = Qnil;
1268 #ifndef old
1269 buffer_defaults.selective_display_ellipses = Qt;
1270 #endif
1271 buffer_defaults.abbrev_table = Qnil;
1272 buffer_defaults.display_table = Qnil;
1273 buffer_defaults.fieldlist = Qnil;
1274 buffer_defaults.undo_list = Qnil;
1275
1276 XFASTINT (buffer_defaults.tab_width) = 8;
1277 buffer_defaults.truncate_lines = Qnil;
1278 buffer_defaults.ctl_arrow = Qt;
1279
1280 XFASTINT (buffer_defaults.fill_column) = 70;
1281 XFASTINT (buffer_defaults.left_margin) = 0;
1282
1283 /* Assign the local-flags to the slots that have default values.
1284 The local flag is a bit that is used in the buffer
1285 to say that it has its own local value for the slot.
1286 The local flag bits are in the local_var_flags slot of the buffer. */
1287
1288 /* Nothing can work if this isn't true */
1289 if (sizeof (int) != sizeof (Lisp_Object)) abort ();
1290
1291 /* 0 means not a lisp var, -1 means always local, else mask */
1292 bzero (&buffer_local_flags, sizeof buffer_local_flags);
1293 XFASTINT (buffer_local_flags.filename) = -1;
1294 XFASTINT (buffer_local_flags.directory) = -1;
1295 XFASTINT (buffer_local_flags.backed_up) = -1;
1296 XFASTINT (buffer_local_flags.save_length) = -1;
1297 XFASTINT (buffer_local_flags.auto_save_file_name) = -1;
1298 XFASTINT (buffer_local_flags.read_only) = -1;
1299 XFASTINT (buffer_local_flags.major_mode) = -1;
1300 XFASTINT (buffer_local_flags.mode_name) = -1;
1301 XFASTINT (buffer_local_flags.undo_list) = -1;
1302
1303 XFASTINT (buffer_local_flags.mode_line_format) = 1;
1304 XFASTINT (buffer_local_flags.abbrev_mode) = 2;
1305 XFASTINT (buffer_local_flags.overwrite_mode) = 4;
1306 XFASTINT (buffer_local_flags.case_fold_search) = 8;
1307 XFASTINT (buffer_local_flags.auto_fill_function) = 0x10;
1308 XFASTINT (buffer_local_flags.selective_display) = 0x20;
1309 #ifndef old
1310 XFASTINT (buffer_local_flags.selective_display_ellipses) = 0x40;
1311 #endif
1312 XFASTINT (buffer_local_flags.tab_width) = 0x80;
1313 XFASTINT (buffer_local_flags.truncate_lines) = 0x100;
1314 XFASTINT (buffer_local_flags.ctl_arrow) = 0x200;
1315 XFASTINT (buffer_local_flags.fill_column) = 0x400;
1316 XFASTINT (buffer_local_flags.left_margin) = 0x800;
1317 XFASTINT (buffer_local_flags.abbrev_table) = 0x1000;
1318 XFASTINT (buffer_local_flags.display_table) = 0x2000;
1319 XFASTINT (buffer_local_flags.fieldlist) = 0x4000;
1320 XFASTINT (buffer_local_flags.syntax_table) = 0x8000;
1321
1322 Vbuffer_alist = Qnil;
1323 current_buffer = 0;
1324 all_buffers = 0;
1325
1326 QSFundamental = build_string ("Fundamental");
1327
1328 Qfundamental_mode = intern ("fundamental-mode");
1329 buffer_defaults.major_mode = Qfundamental_mode;
1330
1331 Qmode_class = intern ("mode-class");
1332
1333 Qprotected_field = intern ("protected-field");
1334
1335 Qpermanent_local = intern ("permanent-local");
1336
1337 Qkill_buffer_hook = intern ("kill-buffer-hook");
1338
1339 Vprin1_to_string_buffer = Fget_buffer_create (build_string (" prin1"));
1340 /* super-magic invisible buffer */
1341 Vbuffer_alist = Qnil;
1342
1343 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
1344 }
1345
1346 init_buffer ()
1347 {
1348 char buf[MAXPATHLEN+1];
1349
1350 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
1351 if (getwd (buf) == 0)
1352 fatal ("`getwd' failed: %s.\n", buf);
1353
1354 #ifndef VMS
1355 /* Maybe this should really use some standard subroutine
1356 whose definition is filename syntax dependent. */
1357 if (buf[strlen (buf) - 1] != '/')
1358 strcat (buf, "/");
1359 #endif /* not VMS */
1360 current_buffer->directory = build_string (buf);
1361 }
1362
1363 /* initialize the buffer routines */
1364 syms_of_buffer ()
1365 {
1366 staticpro (&Vbuffer_defaults);
1367 staticpro (&Vbuffer_local_symbols);
1368 staticpro (&Qfundamental_mode);
1369 staticpro (&Qmode_class);
1370 staticpro (&QSFundamental);
1371 staticpro (&Vbuffer_alist);
1372 staticpro (&Qprotected_field);
1373 staticpro (&Qpermanent_local);
1374 staticpro (&Qkill_buffer_hook);
1375
1376 Fput (Qprotected_field, Qerror_conditions,
1377 Fcons (Qprotected_field, Fcons (Qerror, Qnil)));
1378 Fput (Qprotected_field, Qerror_message,
1379 build_string ("Attempt to modify a protected field"));
1380
1381 /* All these use DEFVAR_LISP_NOPRO because the slots in
1382 buffer_defaults will all be marked via Vbuffer_defaults. */
1383
1384 DEFVAR_LISP_NOPRO ("default-mode-line-format",
1385 &buffer_defaults.mode_line_format,
1386 "Default value of `mode-line-format' for buffers that don't override it.\n\
1387 This is the same as (default-value 'mode-line-format).");
1388
1389 DEFVAR_LISP_NOPRO ("default-abbrev-mode",
1390 &buffer_defaults.abbrev_mode,
1391 "Default value of `abbrev-mode' for buffers that do not override it.\n\
1392 This is the same as (default-value 'abbrev-mode).");
1393
1394 DEFVAR_LISP_NOPRO ("default-ctl-arrow",
1395 &buffer_defaults.ctl_arrow,
1396 "Default value of `ctl-arrow' for buffers that do not override it.\n\
1397 This is the same as (default-value 'ctl-arrow).");
1398
1399 DEFVAR_LISP_NOPRO ("default-truncate-lines",
1400 &buffer_defaults.truncate_lines,
1401 "Default value of `truncate-lines' for buffers that do not override it.\n\
1402 This is the same as (default-value 'truncate-lines).");
1403
1404 DEFVAR_LISP_NOPRO ("default-fill-column",
1405 &buffer_defaults.fill_column,
1406 "Default value of `fill-column' for buffers that do not override it.\n\
1407 This is the same as (default-value 'fill-column).");
1408
1409 DEFVAR_LISP_NOPRO ("default-left-margin",
1410 &buffer_defaults.left_margin,
1411 "Default value of `left-margin' for buffers that do not override it.\n\
1412 This is the same as (default-value 'left-margin).");
1413
1414 DEFVAR_LISP_NOPRO ("default-tab-width",
1415 &buffer_defaults.tab_width,
1416 "Default value of `tab-width' for buffers that do not override it.\n\
1417 This is the same as (default-value 'tab-width).");
1418
1419 DEFVAR_LISP_NOPRO ("default-case-fold-search",
1420 &buffer_defaults.case_fold_search,
1421 "Default value of `case-fold-search' for buffers that don't override it.\n\
1422 This is the same as (default-value 'case-fold-search).");
1423
1424 DEFVAR_PER_BUFFER ("mode-line-format", &current_buffer->mode_line_format,
1425 Qnil, 0);
1426
1427 /* This doc string is too long for cpp; cpp dies if it isn't in a comment.
1428 But make-docfile finds it!
1429 DEFVAR_PER_BUFFER ("mode-line-format", &current_buffer->mode_line_format,
1430 "Template for displaying mode line for current buffer.\n\
1431 Each buffer has its own value of this variable.\n\
1432 Value may be a string, a symbol or a list or cons cell.\n\
1433 For a symbol, its value is used (but it is ignored if t or nil).\n\
1434 A string appearing directly as the value of a symbol is processed verbatim\n\
1435 in that the %-constructs below are not recognized.\n\
1436 For a list whose car is a symbol, the symbol's value is taken,\n\
1437 and if that is non-nil, the cadr of the list is processed recursively.\n\
1438 Otherwise, the caddr of the list (if there is one) is processed.\n\
1439 For a list whose car is a string or list, each element is processed\n\
1440 recursively and the results are effectively concatenated.\n\
1441 For a list whose car is an integer, the cdr of the list is processed\n\
1442 and padded (if the number is positive) or truncated (if negative)\n\
1443 to the width specified by that number.\n\
1444 A string is printed verbatim in the mode line except for %-constructs:\n\
1445 (%-constructs are allowed when the string is the entire mode-line-format\n\
1446 or when it is found in a cons-cell or a list)\n\
1447 %b -- print buffer name. %f -- print visited file name.\n\
1448 %* -- print *, % or hyphen. %m -- print value of mode-name (obsolete).\n\
1449 %s -- print process status. %M -- print value of global-mode-string. (obs)\n\
1450 %p -- print percent of buffer above top of window, or top, bot or all.\n\
1451 %n -- print Narrow if appropriate.\n\
1452 %[ -- print one [ for each recursive editing level. %] similar.\n\
1453 %% -- print %. %- -- print infinitely many dashes.\n\
1454 Decimal digits after the % specify field width to which to pad.");
1455 */
1456
1457 DEFVAR_LISP_NOPRO ("default-major-mode", &buffer_defaults.major_mode,
1458 "*Major mode for new buffers. Defaults to `fundamental-mode'.\n\
1459 nil here means use current buffer's major mode.");
1460
1461 DEFVAR_PER_BUFFER ("major-mode", &current_buffer->major_mode,
1462 make_number (Lisp_Symbol),
1463 "Symbol for current buffer's major mode.");
1464
1465 DEFVAR_PER_BUFFER ("mode-name", &current_buffer->mode_name,
1466 make_number (Lisp_String),
1467 "Pretty name of current buffer's major mode (a string).");
1468
1469 DEFVAR_PER_BUFFER ("abbrev-mode", &current_buffer->abbrev_mode, Qnil,
1470 "Non-nil turns on automatic expansion of abbrevs as they are inserted.\n\
1471 Automatically becomes buffer-local when set in any fashion.");
1472
1473 DEFVAR_PER_BUFFER ("case-fold-search", &current_buffer->case_fold_search,
1474 Qnil,
1475 "*Non-nil if searches should ignore case.\n\
1476 Automatically becomes buffer-local when set in any fashion.");
1477
1478 DEFVAR_PER_BUFFER ("fill-column", &current_buffer->fill_column,
1479 make_number (Lisp_Int),
1480 "*Column beyond which automatic line-wrapping should happen.\n\
1481 Automatically becomes buffer-local when set in any fashion.");
1482
1483 DEFVAR_PER_BUFFER ("left-margin", &current_buffer->left_margin,
1484 make_number (Lisp_Int),
1485 "*Column for the default indent-line-function to indent to.\n\
1486 Linefeed indents to this column in Fundamental mode.\n\
1487 Automatically becomes buffer-local when set in any fashion.");
1488
1489 DEFVAR_PER_BUFFER ("tab-width", &current_buffer->tab_width,
1490 make_number (Lisp_Int),
1491 "*Distance between tab stops (for display of tab characters), in columns.\n\
1492 Automatically becomes buffer-local when set in any fashion.");
1493
1494 DEFVAR_PER_BUFFER ("ctl-arrow", &current_buffer->ctl_arrow, Qnil,
1495 "*Non-nil means display control chars with uparrow.\n\
1496 Nil means use backslash and octal digits.\n\
1497 Automatically becomes buffer-local when set in any fashion.\n\
1498 This variable does not apply to characters whose display is specified\n\
1499 in the current display table (if there is one).");
1500
1501 DEFVAR_PER_BUFFER ("truncate-lines", &current_buffer->truncate_lines, Qnil,
1502 "*Non-nil means do not display continuation lines;\n\
1503 give each line of text one screen line.\n\
1504 Automatically becomes buffer-local when set in any fashion.\n\
1505 \n\
1506 Note that this is overridden by the variable\n\
1507 `truncate-partial-width-windows' if that variable is non-nil\n\
1508 and this buffer is not full-frame width.");
1509
1510 DEFVAR_PER_BUFFER ("default-directory", &current_buffer->directory,
1511 make_number (Lisp_String),
1512 "Name of default directory of current buffer. Should end with slash.\n\
1513 Each buffer has its own value of this variable.");
1514
1515 DEFVAR_PER_BUFFER ("auto-fill-function", &current_buffer->auto_fill_function,
1516 Qnil,
1517 "Function called (if non-nil) to perform auto-fill.\n\
1518 It is called after self-inserting a space at a column beyond `fill-column'.\n\
1519 Each buffer has its own value of this variable.\n\
1520 NOTE: This variable is not an ordinary hook;\n\
1521 It may not be a list of functions.");
1522
1523 DEFVAR_PER_BUFFER ("buffer-file-name", &current_buffer->filename,
1524 make_number (Lisp_String),
1525 "Name of file visited in current buffer, or nil if not visiting a file.\n\
1526 Each buffer has its own value of this variable.");
1527
1528 DEFVAR_PER_BUFFER ("buffer-auto-save-file-name",
1529 &current_buffer->auto_save_file_name,
1530 make_number (Lisp_String),
1531 "Name of file for auto-saving current buffer,\n\
1532 or nil if buffer should not be auto-saved.\n\
1533 Each buffer has its own value of this variable.");
1534
1535 DEFVAR_PER_BUFFER ("buffer-read-only", &current_buffer->read_only, Qnil,
1536 "Non-nil if this buffer is read-only.\n\
1537 Each buffer has its own value of this variable.");
1538
1539 DEFVAR_PER_BUFFER ("buffer-backed-up", &current_buffer->backed_up, Qnil,
1540 "Non-nil if this buffer's file has been backed up.\n\
1541 Backing up is done before the first time the file is saved.\n\
1542 Each buffer has its own value of this variable.");
1543
1544 DEFVAR_PER_BUFFER ("buffer-saved-size", &current_buffer->save_length,
1545 make_number (Lisp_Int),
1546 "Length of current buffer when last read in, saved or auto-saved.\n\
1547 0 initially.\n\
1548 Each buffer has its own value of this variable.");
1549
1550 DEFVAR_PER_BUFFER ("selective-display", &current_buffer->selective_display,
1551 Qnil,
1552 "Non-nil enables selective display:\n\
1553 Integer N as value means display only lines\n\
1554 that start with less than n columns of space.\n\
1555 A value of t means, after a ^M, all the rest of the line is invisible.\n\
1556 Then ^M's in the file are written into files as newlines.\n\n\
1557 Automatically becomes buffer-local when set in any fashion.");
1558
1559 #ifndef old
1560 DEFVAR_PER_BUFFER ("selective-display-ellipses",
1561 &current_buffer->selective_display_ellipses,
1562 Qnil,
1563 "t means display ... on previous line when a line is invisible.\n\
1564 Automatically becomes buffer-local when set in any fashion.");
1565 #endif
1566
1567 DEFVAR_PER_BUFFER ("overwrite-mode", &current_buffer->overwrite_mode, Qnil,
1568 "Non-nil if self-insertion should replace existing text.\n\
1569 Automatically becomes buffer-local when set in any fashion.");
1570
1571 DEFVAR_PER_BUFFER ("buffer-display-table", &current_buffer->display_table,
1572 Qnil,
1573 "Display table that controls display of the contents of current buffer.\n\
1574 Automatically becomes buffer-local when set in any fashion.\n\
1575 The display table is a vector created with `make-display-table'.\n\
1576 The first 256 elements control how to display each possible text character.\n\
1577 The value should be a \"rope\" (see `make-rope') or nil;\n\
1578 nil means display the character in the default fashion.\n\
1579 The remaining five elements are ropes that control the display of\n\
1580 the end of a truncated screen line (element 256);\n\
1581 the end of a continued line (element 257);\n\
1582 the escape character used to display character codes in octal (element 258);\n\
1583 the character used as an arrow for control characters (element 259);\n\
1584 the decoration indicating the presence of invisible lines (element 260).\n\
1585 If this variable is nil, the value of `standard-display-table' is used.\n\
1586 Each window can have its own, overriding display table.");
1587
1588 DEFVAR_PER_BUFFER ("buffer-field-list", &current_buffer->fieldlist, Qnil,
1589 "List of fields in the current buffer. See `add-field'.");
1590
1591 DEFVAR_BOOL ("check-protected-fields", check_protected_fields,
1592 "Non-nil means don't allow modification of a protected field.\n\
1593 See `add-field'.");
1594 check_protected_fields = 0;
1595
1596 /*DEFVAR_LISP ("debug-check-symbol", &Vcheck_symbol,
1597 "Don't ask.");
1598 */
1599 DEFVAR_LISP ("before-change-function", &Vbefore_change_function,
1600 "Function to call before each text change.\n\
1601 Two arguments are passed to the function: the positions of\n\
1602 the beginning and end of the range of old text to be changed.\n\
1603 \(For an insertion, the beginning and end are at the same place.)\n\
1604 No information is given about the length of the text after the change.\n\
1605 position of the change\n\
1606 \n\
1607 While executing the `before-change-function', changes to buffers do not\n\
1608 cause calls to any `before-change-function' or `after-change-function'.");
1609 Vbefore_change_function = Qnil;
1610
1611 DEFVAR_LISP ("after-change-function", &Vafter_change_function,
1612 "Function to call after each text change.\n\
1613 Three arguments are passed to the function: the positions of\n\
1614 the beginning and end of the range of changed text,\n\
1615 and the length of the pre-change text replaced by that range.\n\
1616 \(For an insertion, the pre-change length is zero;\n\
1617 for a deletion, that length is the number of characters deleted,\n\
1618 and the post-change beginning and end are at the same place.)\n\
1619 \n\
1620 While executing the `after-change-function', changes to buffers do not\n\
1621 cause calls to any `before-change-function' or `after-change-function'.");
1622 Vafter_change_function = Qnil;
1623
1624 DEFVAR_LISP ("first-change-function", &Vfirst_change_function,
1625 "Function to call before changing a buffer which is unmodified.\n\
1626 The function is called, with no arguments, if it is non-nil.");
1627 Vfirst_change_function = Qnil;
1628
1629 DEFVAR_PER_BUFFER ("buffer-undo-list", &current_buffer->undo_list, Qnil,
1630 "List of undo entries in current buffer.\n\
1631 Recent changes come first; older changes follow newer.\n\
1632 \n\
1633 An entry (START . END) represents an insertion which begins at\n\
1634 position START and ends at position END.\n\
1635 \n\
1636 An entry (TEXT . POSITION) represents the deletion of the string TEXT\n\
1637 from (abs POSITION). If POSITION is positive, point was at the front\n\
1638 of the text being deleted; if negative, point was at the end.\n\
1639 \n\
1640 An entry (t HIGHWORD LOWWORD) indicates that the buffer had been\n\
1641 previously unmodified. HIGHWORD and LOWWORD are the high and low\n\
1642 16-bit words of the buffer's modification count at the time. If the\n\
1643 modification count of the most recent save is different, this entry is\n\
1644 obsolete.\n\
1645 \n\
1646 nil marks undo boundaries. The undo command treats the changes\n\
1647 between two undo boundaries as a single step to be undone.\n\
1648 \n\
1649 If the value of the variable is t, undo information is not recorded.\n\
1650 ");
1651
1652 defsubr (&Sbuffer_list);
1653 defsubr (&Sget_buffer);
1654 defsubr (&Sget_file_buffer);
1655 defsubr (&Sget_buffer_create);
1656 defsubr (&Sgenerate_new_buffer_name);
1657 defsubr (&Sbuffer_name);
1658 /*defsubr (&Sbuffer_number);*/
1659 defsubr (&Sbuffer_file_name);
1660 defsubr (&Sbuffer_local_variables);
1661 defsubr (&Sbuffer_modified_p);
1662 defsubr (&Sset_buffer_modified_p);
1663 defsubr (&Sbuffer_modified_tick);
1664 defsubr (&Srename_buffer);
1665 defsubr (&Sother_buffer);
1666 defsubr (&Sbuffer_disable_undo);
1667 defsubr (&Sbuffer_enable_undo);
1668 defsubr (&Skill_buffer);
1669 defsubr (&Serase_buffer);
1670 defsubr (&Sswitch_to_buffer);
1671 defsubr (&Spop_to_buffer);
1672 defsubr (&Scurrent_buffer);
1673 defsubr (&Sset_buffer);
1674 defsubr (&Sbarf_if_buffer_read_only);
1675 defsubr (&Sbury_buffer);
1676 defsubr (&Slist_buffers);
1677 defsubr (&Skill_all_local_variables);
1678 defsubr (&Sregion_fields);
1679 }
1680
1681 keys_of_buffer ()
1682 {
1683 initial_define_key (control_x_map, 'b', "switch-to-buffer");
1684 initial_define_key (control_x_map, 'k', "kill-buffer");
1685 initial_define_key (control_x_map, Ctl ('B'), "list-buffers");
1686 }