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