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