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