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