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