]> code.delx.au - gnu-emacs/blob - src/buffer.c
* buffer.c (reset_buffer): Don't assign to b->save_length as if it
[gnu-emacs] / src / buffer.c
1 /* Buffer manipulation primitives for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1992 Free Software Foundation, Inc.
3
4 This file is part of GNU Emacs.
5
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 1, or (at your option)
9 any later version.
10
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
19
20
21 #include <sys/param.h>
22
23 #ifndef MAXPATHLEN
24 /* in 4.1, param.h fails to define this. */
25 #define MAXPATHLEN 1024
26 #endif /* not MAXPATHLEN */
27
28 #include "config.h"
29 #include "lisp.h"
30 #include "intervals.h"
31 #include "window.h"
32 #include "commands.h"
33 #include "buffer.h"
34 #include "syntax.h"
35 #include "indent.h"
36
37 struct 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
42 struct 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
51 struct buffer buffer_defaults;
52
53 /* A Lisp_Object pointer to the above, used for staticpro */
54
55 static 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
80 struct 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
85 struct buffer buffer_local_symbols;
86 /* A Lisp_Object pointer to the above, used for staticpro */
87 static Lisp_Object Vbuffer_local_symbols;
88
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. */
95 struct buffer buffer_local_types;
96
97 /* Nonzero means don't allow modification of protected fields. */
98
99 int check_protected_fields;
100
101 Lisp_Object Fset_buffer ();
102 void set_buffer_internal ();
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. */
107 Lisp_Object Vbuffer_alist;
108
109 /* Functions to call before and after each text change. */
110 Lisp_Object Vbefore_change_function;
111 Lisp_Object Vafter_change_function;
112
113 /* Function to call before changing an unmodified buffer. */
114 Lisp_Object Vfirst_change_function;
115
116 Lisp_Object Qfundamental_mode, Qmode_class, Qpermanent_local;
117
118 Lisp_Object Qprotected_field;
119
120 Lisp_Object QSFundamental; /* A string "Fundamental" */
121
122 Lisp_Object Qkill_buffer_hook;
123
124 /* For debugging; temporary. See set_buffer_internal. */
125 /* Lisp_Object Qlisp_mode, Vcheck_symbol; */
126
127 nsberror (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
135 DEFUN ("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
142 DEFUN ("get-buffer", Fget_buffer, Sget_buffer, 1, 1, 0,
143 "Return the buffer named NAME (a string).\n\
144 If there is no live buffer named NAME, return nil.\n\
145 NAME 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
156 DEFUN ("get-file-buffer", Fget_file_buffer, Sget_file_buffer, 1, 1, 0,
157 "Return the buffer visiting file FILENAME (a string).\n\
158 If 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);
172 if (!NILP (tem))
173 return buf;
174 }
175 return Qnil;
176 }
177
178 /* Incremented for each buffer created, to assign the buffer number. */
179 int buffer_count;
180
181 DEFUN ("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\
183 A new buffer is created if there is no live buffer named NAME.\n\
184 If NAME starts with a space, the new buffer does not keep undo information.\n\
185 If NAME is a buffer instead of a string, then it is the value returned.\n\
186 The 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);
195 if (!NILP (buf))
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;
237 if (NILP (function))
238 {
239 tem = Fget (current_buffer->major_mode, Qmode_class);
240 if (EQ (tem, Qnil))
241 function = current_buffer->major_mode;
242 }
243
244 if (NILP (function) || EQ (function, Qfundamental_mode))
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
260 void
261 reset_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;
268 XFASTINT (b->save_length) = 0;
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;
275
276 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
277 INITIALIZE_INTERVAL (b, NULL_INTERVAL);
278
279 reset_buffer_local_variables(b);
280 }
281
282 reset_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
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
325 DEFUN ("generate-new-buffer-name", Fgenerate_new_buffer_name, Sgenerate_new_buffer_name,
326 1, 1, 0,
327 "Return a string that is the name of no existing buffer based on NAME.\n\
328 If there is no live buffer named NAME, then return NAME.\n\
329 Otherwise modify name by appending `<NUMBER>', incrementing NUMBER\n\
330 until an unused name is found, and then return that name.")
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);
341 if (NILP (tem))
342 return name;
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);
350 if (NILP (tem))
351 return gentemp;
352 }
353 }
354
355 \f
356 DEFUN ("buffer-name", Fbuffer_name, Sbuffer_name, 0, 1, 0,
357 "Return the name of BUFFER, as a string.\n\
358 With no argument or nil as argument, return the name of the current buffer.")
359 (buffer)
360 register Lisp_Object buffer;
361 {
362 if (NILP (buffer))
363 return current_buffer->name;
364 CHECK_BUFFER (buffer, 0);
365 return XBUFFER (buffer)->name;
366 }
367
368 DEFUN ("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\
370 No argument or nil as argument means use the current buffer.")
371 (buffer)
372 register Lisp_Object buffer;
373 {
374 if (NILP (buffer))
375 return current_buffer->filename;
376 CHECK_BUFFER (buffer, 0);
377 return XBUFFER (buffer)->filename;
378 }
379
380 DEFUN ("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\
383 Each element looks like (SYMBOL . VALUE) and describes one variable.\n\
384 Note that storing new VALUEs in these elements doesn't change the variables.\n\
385 No 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
392 if (NILP (buffer))
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
439 DEFUN ("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\
442 No argument or nil as argument means use current buffer as BUFFER.")
443 (buffer)
444 register Lisp_Object buffer;
445 {
446 register struct buffer *buf;
447 if (NILP (buffer))
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
458 DEFUN ("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\
461 A 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;
473 if (!NILP (fn))
474 {
475 already = current_buffer->save_modified < MODIFF;
476 if (!already && !NILP (flag))
477 lock_file (fn);
478 else if (already && NILP (flag))
479 unlock_file (fn);
480 }
481 #endif /* CLASH_DETECTION */
482
483 current_buffer->save_modified = NILP (flag) ? MODIFF : 0;
484 update_mode_lines++;
485 return flag;
486 }
487
488 DEFUN ("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\
491 Each buffer has a tick counter which is incremented each time the text in\n\
492 that buffer is changed. It wraps around occasionally.\n\
493 No argument or nil as argument means use current buffer as BUFFER.")
494 (buffer)
495 register Lisp_Object buffer;
496 {
497 register struct buffer *buf;
498 if (NILP (buffer))
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
509 DEFUN ("rename-buffer", Frename_buffer, Srename_buffer, 1, 2,
510 "sRename buffer (to new name): ",
511 "Change current buffer's name to NEWNAME (a string).\n\
512 If second arg DISTINGUISH is nil or omitted, it is an error if a\n\
513 buffer named NEWNAME already exists.\n\
514 If DISTINGUISH is non-nil, come up with a new name using\n\
515 `generate-new-buffer-name'.\n\
516 Return the name we actually gave the buffer.\n\
517 This does not change the name of the visited file (if any).")
518 (name, distinguish)
519 register Lisp_Object name, distinguish;
520 {
521 register Lisp_Object tem, buf;
522
523 CHECK_STRING (name, 0);
524 tem = Fget_buffer (name);
525 if (XBUFFER (tem) == current_buffer)
526 return current_buffer->name;
527 if (!NILP (tem))
528 {
529 if (!NILP (distinguish))
530 name = Fgenerate_new_buffer_name (name);
531 else
532 error ("Buffer name \"%s\" is in use", XSTRING (name)->data);
533 }
534
535 current_buffer->name = name;
536 XSET (buf, Lisp_Buffer, current_buffer);
537 Fsetcar (Frassq (buf, Vbuffer_alist), name);
538 if (NILP (current_buffer->filename) && !NILP (current_buffer->auto_save_file_name))
539 call0 (intern ("rename-auto-save-file"));
540 return name;
541 }
542
543 DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 2, 0,
544 "Return most recently selected buffer other than BUFFER.\n\
545 Buffers not visible in windows are preferred to visible buffers,\n\
546 unless optional second argument VISIBLE-OK is non-nil.\n\
547 If no other buffer exists, the buffer `*scratch*' is returned.\n\
548 If BUFFER is omitted or nil, some interesting buffer is returned.")
549 (buffer, visible_ok)
550 register Lisp_Object buffer, visible_ok;
551 {
552 register Lisp_Object tail, buf, notsogood, tem;
553 notsogood = Qnil;
554
555 for (tail = Vbuffer_alist; !NILP (tail); tail = Fcdr (tail))
556 {
557 buf = Fcdr (Fcar (tail));
558 if (EQ (buf, buffer))
559 continue;
560 if (XSTRING (XBUFFER (buf)->name)->data[0] == ' ')
561 continue;
562 if (NILP (visible_ok))
563 tem = Fget_buffer_window (buf, Qnil);
564 else
565 tem = Qnil;
566 if (NILP (tem))
567 return buf;
568 if (NILP (notsogood))
569 notsogood = buf;
570 }
571 if (!NILP (notsogood))
572 return notsogood;
573 return Fget_buffer_create (build_string ("*scratch*"));
574 }
575 \f
576 DEFUN ("buffer-disable-undo", Fbuffer_disable_undo, Sbuffer_disable_undo, 1,1,
577 0,
578 "Make BUFFER stop keeping undo information.")
579 (buffer)
580 register Lisp_Object buffer;
581 {
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
595 return Qnil;
596 }
597
598 DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, Sbuffer_enable_undo,
599 0, 1, "",
600 "Start keeping undo information for buffer BUFFER.\n\
601 No argument or nil as argument means do this for the current buffer.")
602 (buffer)
603 register Lisp_Object buffer;
604 {
605 Lisp_Object real_buffer;
606
607 if (NILP (buffer))
608 XSET (real_buffer, Lisp_Buffer, current_buffer);
609 else
610 {
611 real_buffer = Fget_buffer (buffer);
612 if (NILP (real_buffer))
613 nsberror (buffer);
614 }
615
616 if (EQ (XBUFFER (real_buffer)->undo_list, Qt))
617 XBUFFER (real_buffer)->undo_list = Qnil;
618
619 return Qnil;
620 }
621
622 /*
623 DEFVAR_LISP ("kill-buffer-hook", no_cell, "\
624 Hook to be run (by `run-hooks', which see) when a buffer is killed.\n\
625 The buffer being killed will be current while the hook is running.\n\
626 See `kill-buffer'."
627 */
628 DEFUN ("kill-buffer", Fkill_buffer, Skill_buffer, 1, 1, "bKill buffer: ",
629 "Kill the buffer BUFFER.\n\
630 The argument may be a buffer or may be the name of a buffer.\n\
631 An argument of nil means kill the current buffer.\n\n\
632 Value is t if the buffer is actually killed, nil if user says no.\n\n\
633 The value of `kill-buffer-hook' (which may be local to that buffer),\n\
634 if not void, is a list of functions to be called, with no arguments,\n\
635 before the buffer is actually killed. The buffer to be killed is current\n\
636 when the hook functions are called.\n\n\
637 Any processes that have this buffer as the `process-buffer' are killed\n\
638 with `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
648 if (NILP (bufname))
649 buf = Fcurrent_buffer ();
650 else
651 buf = Fget_buffer (bufname);
652 if (NILP (buf))
653 nsberror (bufname);
654
655 b = XBUFFER (buf);
656
657 /* Query if the buffer is still modified. */
658 if (INTERACTIVE && !NILP (b->filename)
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;
665 if (NILP (tem))
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
688 if (NILP (b->name))
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 {
696 tem = Fother_buffer (buf, Qnil);
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
709 kill_buffer_processes (buf);
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"));
722 if (! NILP (tem))
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
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
741 b->name = Qnil;
742 BUFFER_FREE (BUF_BEG_ADDR (b));
743 b->undo_list = Qnil;
744
745 return Qt;
746 }
747 \f
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. */
752
753 record_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
766 /* Effectively do Vbuffer_alist = Fdelq (link, Vbuffer_alist);
767 we cannot use Fdelq itself here because it allows quitting. */
768
769 if (NILP (prev))
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
778 DEFUN ("switch-to-buffer", Fswitch_to_buffer, Sswitch_to_buffer, 1, 2, "BSwitch to buffer: ",
779 "Select buffer BUFFER in the current window.\n\
780 BUFFER may be a buffer or a buffer name.\n\
781 Optional second arg NORECORD non-nil means\n\
782 do not put this buffer at the front of the list of recently selected ones.\n\
783 \n\
784 WARNING: This is NOT the way to work on another buffer temporarily\n\
785 within a Lisp program! Use `set-buffer' instead. That avoids messing with\n\
786 the 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);
796 if (!NILP (tem))
797 error ("Cannot switch buffers in a dedicated window");
798
799 if (NILP (bufname))
800 buf = Fother_buffer (Fcurrent_buffer (), Qnil);
801 else
802 buf = Fget_buffer_create (bufname);
803 Fset_buffer (buf);
804 if (NILP (norecord))
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
814 DEFUN ("pop-to-buffer", Fpop_to_buffer, Spop_to_buffer, 1, 2, 0,
815 "Select buffer BUFFER in some window, preferably a different one.\n\
816 If BUFFER is nil, then some other buffer is chosen.\n\
817 If `pop-up-windows' is non-nil, windows can be split to do this.\n\
818 If optional second arg OTHER-WINDOW is non-nil, insist on finding another\n\
819 window even if BUFFER is already visible in the selected window.")
820 (bufname, other)
821 Lisp_Object bufname, other;
822 {
823 register Lisp_Object buf;
824 if (NILP (bufname))
825 buf = Fother_buffer (Fcurrent_buffer (), Qnil);
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
834 DEFUN ("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
845 void
846 set_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
864 for (tail = b->local_var_alist; !NILP (tail); tail = XCONS (tail)->cdr)
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)
880 for (tail = old_buf->local_var_alist; !NILP (tail); tail = XCONS (tail)->cdr)
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
894 DEFUN ("set-buffer", Fset_buffer, Sset_buffer, 1, 1, 0,
895 "Make the buffer BUFFER current for editing operations.\n\
896 BUFFER may be a buffer or the name of an existing buffer.\n\
897 See also `save-excursion' when you want to make a buffer current temporarily.\n\
898 This function does not display the buffer, so its effect ends\n\
899 when the current command terminates.\n\
900 Use `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);
906 if (NILP (buffer))
907 nsberror (bufname);
908 if (NILP (XBUFFER (buffer)->name))
909 error ("Selecting deleted buffer");
910 set_buffer_internal (XBUFFER (buffer));
911 return buffer;
912 }
913 \f
914 DEFUN ("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 {
919 while (!NILP (current_buffer->read_only))
920 Fsignal (Qbuffer_read_only, (Fcons (Fcurrent_buffer (), Qnil)));
921 return Qnil;
922 }
923
924 DEFUN ("bury-buffer", Fbury_buffer, Sbury_buffer, 0, 1, "",
925 "Put BUFFER at the end of the list of all buffers.\n\
926 There it is the least likely candidate for `other-buffer' to return;\n\
927 thus, the least likely buffer for \\[switch-to-buffer] to select by default.\n\
928 BUFFER is also removed from the selected window if it was displayed there.\n\
929 If BUFFER is omitted, the current buffer is buried.")
930 (buf)
931 register Lisp_Object buf;
932 {
933 /* Figure out what buffer we're going to bury. */
934 if (NILP (buf))
935 XSET (buf, Lisp_Buffer, current_buffer);
936 else
937 {
938 Lisp_Object buf1;
939
940 buf1 = Fget_buffer (buf);
941 if (NILP (buf1))
942 nsberror (buf);
943 buf = buf1;
944 }
945
946 /* Remove it from the screen. */
947 if (EQ (buf, XWINDOW (selected_window)->buffer))
948 Fswitch_to_buffer (Fother_buffer (buf, Qnil), Qnil);
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 }
960
961 return Qnil;
962 }
963 \f
964 DEFUN ("erase-buffer", Ferase_buffer, Serase_buffer, 0, 0, 0,
965 "Delete the entire contents of the current buffer.\n\
966 Any clipping restriction in effect (see `narrow-to-buffer') is removed,\n\
967 so 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
980 validate_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
1000 Lisp_Object
1001 list_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)
1021 && (tem = Ffboundp (tail), !NILP (tem)))
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
1030 for (tail = Vbuffer_alist; !NILP (tail); tail = Fcdr (tail))
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. */
1038 if (!NILP (files) && NILP (b->filename))
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);
1046 write_string (NILP (b->read_only) ? " " : "% ", -1);
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
1055 if (!NILP (b->filename))
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);
1063 if (!NILP (tem))
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
1085 DEFUN ("list-buffers", Flist_buffers, Slist_buffers, 0, 1, "P",
1086 "Display a list of names of existing buffers.\n\
1087 The list is displayed in a buffer named `*Buffer List*'.\n\
1088 Note that buffers with names starting with spaces are omitted.\n\
1089 Non-null optional arg FILES-ONLY means mention only file buffers.\n\
1090 \n\
1091 The M column contains a * for buffers that are modified.\n\
1092 The 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
1101 DEFUN ("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\
1104 Most local variable bindings are eliminated so that the default values\n\
1105 become effective once more. Also, the syntax table is set from\n\
1106 `standard-syntax-table', the local keymap is set to nil,\n\
1107 and the abbrev table from `fundamental-mode-abbrev-table'.\n\
1108 This function also forces redisplay of the mode line.\n\
1109 \n\
1110 Every function to select a new major mode starts by\n\
1111 calling this function.\n\n\
1112 As a special exception, local variables whose names have\n\
1113 a 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
1123 for (alist = oalist; !NILP (alist); alist = XCONS (alist)->cdr)
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
1153 for (alist = oalist; !NILP (alist); alist = XCONS (alist)->cdr)
1154 {
1155 sym = XCONS (XCONS (alist)->car)->car;
1156 tem = Fget (sym, Qpermanent_local);
1157 if (! NILP (tem))
1158 {
1159 Fmake_local_variable (sym);
1160 Fset (sym, XCONS (XCONS (alist)->car)->cdr);
1161 }
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
1171 DEFUN ("region-fields", Fregion_fields, Sregion_fields, 2, 4, "",
1172 "Return list of fields overlapping a given portion of a buffer.\n\
1173 The portion is specified by arguments START, END and BUFFER.\n\
1174 BUFFER defaults to the current buffer.\n\
1175 Optional 4th arg ERROR-CHECK non nil means just report an error\n\
1176 if 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
1184 if (NILP (buffer))
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 {
1212 if (!NILP (error_check))
1213 {
1214 if (!NILP (FIELD_PROTECTED_FLAG (field)))
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
1232 /* Somebody has tried to store NEWVAL into the buffer-local slot with
1233 offset XUINT (valcontents), and NEWVAL has an unacceptable type. */
1234 void
1235 buffer_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
1260 init_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
1356 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
1357 }
1358
1359 init_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 */
1377 syms_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\
1400 This 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\
1405 This 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\
1410 This 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\
1415 This 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\
1420 This 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\
1425 This 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\
1430 This 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\
1435 This is the same as (default-value 'case-fold-search).");
1436
1437 DEFVAR_PER_BUFFER ("mode-line-format", &current_buffer->mode_line_format,
1438 Qnil, 0);
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\
1444 Each buffer has its own value of this variable.\n\
1445 Value may be a string, a symbol or a list or cons cell.\n\
1446 For 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\
1449 For 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\
1452 For a list whose car is a string or list, each element is processed\n\
1453 recursively and the results are effectively concatenated.\n\
1454 For 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\
1457 A 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\
1467 Decimal 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\
1472 nil here means use current buffer's major mode.");
1473
1474 DEFVAR_PER_BUFFER ("major-mode", &current_buffer->major_mode,
1475 make_number (Lisp_Symbol),
1476 "Symbol for current buffer's major mode.");
1477
1478 DEFVAR_PER_BUFFER ("mode-name", &current_buffer->mode_name,
1479 make_number (Lisp_String),
1480 "Pretty name of current buffer's major mode (a string).");
1481
1482 DEFVAR_PER_BUFFER ("abbrev-mode", &current_buffer->abbrev_mode, Qnil,
1483 "Non-nil turns on automatic expansion of abbrevs as they are inserted.\n\
1484 Automatically becomes buffer-local when set in any fashion.");
1485
1486 DEFVAR_PER_BUFFER ("case-fold-search", &current_buffer->case_fold_search,
1487 Qnil,
1488 "*Non-nil if searches should ignore case.\n\
1489 Automatically becomes buffer-local when set in any fashion.");
1490
1491 DEFVAR_PER_BUFFER ("fill-column", &current_buffer->fill_column,
1492 make_number (Lisp_Int),
1493 "*Column beyond which automatic line-wrapping should happen.\n\
1494 Automatically becomes buffer-local when set in any fashion.");
1495
1496 DEFVAR_PER_BUFFER ("left-margin", &current_buffer->left_margin,
1497 make_number (Lisp_Int),
1498 "*Column for the default indent-line-function to indent to.\n\
1499 Linefeed indents to this column in Fundamental mode.\n\
1500 Automatically becomes buffer-local when set in any fashion.");
1501
1502 DEFVAR_PER_BUFFER ("tab-width", &current_buffer->tab_width,
1503 make_number (Lisp_Int),
1504 "*Distance between tab stops (for display of tab characters), in columns.\n\
1505 Automatically becomes buffer-local when set in any fashion.");
1506
1507 DEFVAR_PER_BUFFER ("ctl-arrow", &current_buffer->ctl_arrow, Qnil,
1508 "*Non-nil means display control chars with uparrow.\n\
1509 Nil means use backslash and octal digits.\n\
1510 Automatically becomes buffer-local when set in any fashion.\n\
1511 This variable does not apply to characters whose display is specified\n\
1512 in the current display table (if there is one).");
1513
1514 DEFVAR_PER_BUFFER ("truncate-lines", &current_buffer->truncate_lines, Qnil,
1515 "*Non-nil means do not display continuation lines;\n\
1516 give each line of text one screen line.\n\
1517 Automatically becomes buffer-local when set in any fashion.\n\
1518 \n\
1519 Note that this is overridden by the variable\n\
1520 `truncate-partial-width-windows' if that variable is non-nil\n\
1521 and this buffer is not full-frame width.");
1522
1523 DEFVAR_PER_BUFFER ("default-directory", &current_buffer->directory,
1524 make_number (Lisp_String),
1525 "Name of default directory of current buffer. Should end with slash.\n\
1526 Each buffer has its own value of this variable.");
1527
1528 DEFVAR_PER_BUFFER ("auto-fill-function", &current_buffer->auto_fill_function,
1529 Qnil,
1530 "Function called (if non-nil) to perform auto-fill.\n\
1531 It is called after self-inserting a space at a column beyond `fill-column'.\n\
1532 Each buffer has its own value of this variable.\n\
1533 NOTE: This variable is not an ordinary hook;\n\
1534 It may not be a list of functions.");
1535
1536 DEFVAR_PER_BUFFER ("buffer-file-name", &current_buffer->filename,
1537 make_number (Lisp_String),
1538 "Name of file visited in current buffer, or nil if not visiting a file.\n\
1539 Each buffer has its own value of this variable.");
1540
1541 DEFVAR_PER_BUFFER ("buffer-auto-save-file-name",
1542 &current_buffer->auto_save_file_name,
1543 make_number (Lisp_String),
1544 "Name of file for auto-saving current buffer,\n\
1545 or nil if buffer should not be auto-saved.\n\
1546 Each buffer has its own value of this variable.");
1547
1548 DEFVAR_PER_BUFFER ("buffer-read-only", &current_buffer->read_only, Qnil,
1549 "Non-nil if this buffer is read-only.\n\
1550 Each buffer has its own value of this variable.");
1551
1552 DEFVAR_PER_BUFFER ("buffer-backed-up", &current_buffer->backed_up, Qnil,
1553 "Non-nil if this buffer's file has been backed up.\n\
1554 Backing up is done before the first time the file is saved.\n\
1555 Each buffer has its own value of this variable.");
1556
1557 DEFVAR_PER_BUFFER ("buffer-saved-size", &current_buffer->save_length,
1558 make_number (Lisp_Int),
1559 "Length of current buffer when last read in, saved or auto-saved.\n\
1560 0 initially.\n\
1561 Each buffer has its own value of this variable.");
1562
1563 DEFVAR_PER_BUFFER ("selective-display", &current_buffer->selective_display,
1564 Qnil,
1565 "Non-nil enables selective display:\n\
1566 Integer N as value means display only lines\n\
1567 that start with less than n columns of space.\n\
1568 A 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\
1570 Automatically 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,
1575 Qnil,
1576 "t means display ... on previous line when a line is invisible.\n\
1577 Automatically becomes buffer-local when set in any fashion.");
1578 #endif
1579
1580 DEFVAR_PER_BUFFER ("overwrite-mode", &current_buffer->overwrite_mode, Qnil,
1581 "Non-nil if self-insertion should replace existing text.\n\
1582 Automatically becomes buffer-local when set in any fashion.");
1583
1584 DEFVAR_PER_BUFFER ("buffer-display-table", &current_buffer->display_table,
1585 Qnil,
1586 "Display table that controls display of the contents of current buffer.\n\
1587 Automatically becomes buffer-local when set in any fashion.\n\
1588 The display table is a vector created with `make-display-table'.\n\
1589 The first 256 elements control how to display each possible text character.\n\
1590 The value should be a \"rope\" (see `make-rope') or nil;\n\
1591 nil means display the character in the default fashion.\n\
1592 The 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\
1598 If this variable is nil, the value of `standard-display-table' is used.\n\
1599 Each window can have its own, overriding display table.");
1600
1601 DEFVAR_PER_BUFFER ("buffer-field-list", &current_buffer->fieldlist, Qnil,
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\
1606 See `add-field'.");
1607 check_protected_fields = 0;
1608
1609 /*DEFVAR_LISP ("debug-check-symbol", &Vcheck_symbol,
1610 "Don't ask.");
1611 */
1612 DEFVAR_LISP ("before-change-function", &Vbefore_change_function,
1613 "Function to call before each text change.\n\
1614 Two arguments are passed to the function: the positions of\n\
1615 the 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\
1617 No information is given about the length of the text after the change.\n\
1618 position of the change\n\
1619 \n\
1620 While executing the `before-change-function', changes to buffers do not\n\
1621 cause 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\
1626 Three arguments are passed to the function: the positions of\n\
1627 the beginning and end of the range of changed text,\n\
1628 and the length of the pre-change text replaced by that range.\n\
1629 \(For an insertion, the pre-change length is zero;\n\
1630 for a deletion, that length is the number of characters deleted,\n\
1631 and the post-change beginning and end are at the same place.)\n\
1632 \n\
1633 While executing the `after-change-function', changes to buffers do not\n\
1634 cause 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\
1639 The function is called, with no arguments, if it is non-nil.");
1640 Vfirst_change_function = Qnil;
1641
1642 DEFVAR_PER_BUFFER ("buffer-undo-list", &current_buffer->undo_list, Qnil,
1643 "List of undo entries in current buffer.\n\
1644 Recent changes come first; older changes follow newer.\n\
1645 \n\
1646 An entry (START . END) represents an insertion which begins at\n\
1647 position START and ends at position END.\n\
1648 \n\
1649 An entry (TEXT . POSITION) represents the deletion of the string TEXT\n\
1650 from (abs POSITION). If POSITION is positive, point was at the front\n\
1651 of the text being deleted; if negative, point was at the end.\n\
1652 \n\
1653 An entry (t HIGHWORD LOWWORD) indicates that the buffer had been\n\
1654 previously unmodified. HIGHWORD and LOWWORD are the high and low\n\
1655 16-bit words of the buffer's modification count at the time. If the\n\
1656 modification count of the most recent save is different, this entry is\n\
1657 obsolete.\n\
1658 \n\
1659 nil marks undo boundaries. The undo command treats the changes\n\
1660 between two undo boundaries as a single step to be undone.\n\
1661 \n\
1662 If 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);
1669 defsubr (&Sgenerate_new_buffer_name);
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
1694 keys_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 }