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