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