]> code.delx.au - gnu-emacs/blob - src/buffer.c
(init_buffer): Init default-directory of minibuffer.
[gnu-emacs] / src / buffer.c
1 /* Buffer manipulation primitives for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993
3 Free Software Foundation, Inc.
4
5 This file is part of GNU Emacs.
6
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
11
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
20
21
22 #include <sys/types.h>
23 #include <sys/stat.h>
24 #include <sys/param.h>
25
26 #ifndef MAXPATHLEN
27 /* in 4.1, param.h fails to define this. */
28 #define MAXPATHLEN 1024
29 #endif /* not MAXPATHLEN */
30
31 #include "config.h"
32 #include "lisp.h"
33 #include "intervals.h"
34 #include "window.h"
35 #include "commands.h"
36 #include "buffer.h"
37 #include "syntax.h"
38 #include "indent.h"
39 #include "blockinput.h"
40
41 struct buffer *current_buffer; /* the current buffer */
42
43 /* First buffer in chain of all buffers (in reverse order of creation).
44 Threaded through ->next. */
45
46 struct buffer *all_buffers;
47
48 /* This structure holds the default values of the buffer-local variables
49 defined with DEFVAR_PER_BUFFER, that have special slots in each buffer.
50 The default value occupies the same slot in this structure
51 as an individual buffer's value occupies in that buffer.
52 Setting the default value also goes through the alist of buffers
53 and stores into each buffer that does not say it has a local value. */
54
55 struct buffer buffer_defaults;
56
57 /* A Lisp_Object pointer to the above, used for staticpro */
58
59 static Lisp_Object Vbuffer_defaults;
60
61 /* This structure marks which slots in a buffer have corresponding
62 default values in buffer_defaults.
63 Each such slot has a nonzero value in this structure.
64 The value has only one nonzero bit.
65
66 When a buffer has its own local value for a slot,
67 the bit for that slot (found in the same slot in this structure)
68 is turned on in the buffer's local_var_flags slot.
69
70 If a slot in this structure is -1, then even though there may
71 be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
72 and the corresponding slot in buffer_defaults is not used.
73
74 If a slot is -2, then there is no DEFVAR_PER_BUFFER for it,
75 but there is a default value which is copied into each buffer.
76
77 If a slot in this structure is negative, then even though there may
78 be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
79 and the corresponding slot in buffer_defaults is not used.
80
81 If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is
82 zero, that is a bug */
83
84 struct buffer buffer_local_flags;
85
86 /* This structure holds the names of symbols whose values may be
87 buffer-local. It is indexed and accessed in the same way as the above. */
88
89 struct buffer buffer_local_symbols;
90 /* A Lisp_Object pointer to the above, used for staticpro */
91 static Lisp_Object Vbuffer_local_symbols;
92
93 /* This structure holds the required types for the values in the
94 buffer-local slots. If a slot contains Qnil, then the
95 corresponding buffer slot may contain a value of any type. If a
96 slot contains an integer, then prospective values' tags must be
97 equal to that integer. When a tag does not match, the function
98 buffer_slot_type_mismatch will signal an error. */
99 struct buffer buffer_local_types;
100
101 Lisp_Object Fset_buffer ();
102 void set_buffer_internal ();
103
104 /* Alist of all buffer names vs the buffers. */
105 /* This used to be a variable, but is no longer,
106 to prevent lossage due to user rplac'ing this alist or its elements. */
107 Lisp_Object Vbuffer_alist;
108
109 /* Functions to call before and after each text change. */
110 Lisp_Object Vbefore_change_function;
111 Lisp_Object Vafter_change_function;
112
113 Lisp_Object Vtransient_mark_mode;
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 Lisp_Object Qoverlayp;
128
129 /* For debugging; temporary. See set_buffer_internal. */
130 /* Lisp_Object Qlisp_mode, Vcheck_symbol; */
131
132 nsberror (spec)
133 Lisp_Object spec;
134 {
135 if (XTYPE (spec) == Lisp_String)
136 error ("No buffer named %s", XSTRING (spec)->data);
137 error ("Invalid buffer argument");
138 }
139 \f
140 DEFUN ("buffer-list", Fbuffer_list, Sbuffer_list, 0, 0, 0,
141 "Return a list of all existing live buffers.")
142 ()
143 {
144 return Fmapcar (Qcdr, Vbuffer_alist);
145 }
146
147 DEFUN ("get-buffer", Fget_buffer, Sget_buffer, 1, 1, 0,
148 "Return the buffer named NAME (a string).\n\
149 If there is no live buffer named NAME, return nil.\n\
150 NAME may also be a buffer; if so, the value is that buffer.")
151 (name)
152 register Lisp_Object name;
153 {
154 if (XTYPE (name) == Lisp_Buffer)
155 return name;
156 CHECK_STRING (name, 0);
157
158 return Fcdr (Fassoc (name, Vbuffer_alist));
159 }
160
161 DEFUN ("get-file-buffer", Fget_file_buffer, Sget_file_buffer, 1, 1, 0,
162 "Return the buffer visiting file FILENAME (a string).\n\
163 If there is no such live buffer, return nil.")
164 (filename)
165 register Lisp_Object filename;
166 {
167 register Lisp_Object tail, buf, tem;
168 CHECK_STRING (filename, 0);
169 filename = Fexpand_file_name (filename, Qnil);
170
171 for (tail = Vbuffer_alist; CONSP (tail); tail = XCONS (tail)->cdr)
172 {
173 buf = Fcdr (XCONS (tail)->car);
174 if (XTYPE (buf) != Lisp_Buffer) continue;
175 if (XTYPE (XBUFFER (buf)->filename) != Lisp_String) continue;
176 tem = Fstring_equal (XBUFFER (buf)->filename, filename);
177 if (!NILP (tem))
178 return buf;
179 }
180 return Qnil;
181 }
182
183 /* Incremented for each buffer created, to assign the buffer number. */
184 int buffer_count;
185
186 DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 1, 0,
187 "Return the buffer named NAME, or create such a buffer and return it.\n\
188 A new buffer is created if there is no live buffer named NAME.\n\
189 If NAME starts with a space, the new buffer does not keep undo information.\n\
190 If NAME is a buffer instead of a string, then it is the value returned.\n\
191 The value is never nil.")
192 (name)
193 register Lisp_Object name;
194 {
195 register Lisp_Object buf, function, tem;
196 int count = specpdl_ptr - specpdl;
197 register struct buffer *b;
198
199 buf = Fget_buffer (name);
200 if (!NILP (buf))
201 return buf;
202
203 b = (struct buffer *) xmalloc (sizeof (struct buffer));
204
205 BUF_GAP_SIZE (b) = 20;
206 BLOCK_INPUT;
207 BUFFER_ALLOC (BUF_BEG_ADDR (b), BUF_GAP_SIZE (b));
208 UNBLOCK_INPUT;
209 if (! BUF_BEG_ADDR (b))
210 memory_full ();
211
212 BUF_PT (b) = 1;
213 BUF_GPT (b) = 1;
214 BUF_BEGV (b) = 1;
215 BUF_ZV (b) = 1;
216 BUF_Z (b) = 1;
217 BUF_MODIFF (b) = 1;
218
219 /* Put this on the chain of all buffers including killed ones. */
220 b->next = all_buffers;
221 all_buffers = b;
222
223 b->mark = Fmake_marker ();
224 /*b->number = make_number (++buffer_count);*/
225 b->name = name;
226 if (XSTRING (name)->data[0] != ' ')
227 b->undo_list = Qnil;
228 else
229 b->undo_list = Qt;
230
231 reset_buffer (b);
232
233 /* Put this in the alist of all live buffers. */
234 XSET (buf, Lisp_Buffer, b);
235 Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));
236
237 b->mark = Fmake_marker ();
238 b->markers = Qnil;
239 b->name = name;
240
241 function = buffer_defaults.major_mode;
242 if (NILP (function))
243 {
244 tem = Fget (current_buffer->major_mode, Qmode_class);
245 if (EQ (tem, Qnil))
246 function = current_buffer->major_mode;
247 }
248
249 if (NILP (function) || EQ (function, Qfundamental_mode))
250 return buf;
251
252 /* To select a nonfundamental mode,
253 select the buffer temporarily and then call the mode function. */
254
255 record_unwind_protect (save_excursion_restore, save_excursion_save ());
256
257 Fset_buffer (buf);
258 call0 (function);
259
260 return unbind_to (count, buf);
261 }
262
263 /* Reinitialize everything about a buffer except its name and contents. */
264
265 void
266 reset_buffer (b)
267 register struct buffer *b;
268 {
269 b->filename = Qnil;
270 b->directory = (current_buffer) ? current_buffer->directory : Qnil;
271 b->modtime = 0;
272 b->save_modified = 1;
273 XFASTINT (b->save_length) = 0;
274 b->last_window_start = 1;
275 b->backed_up = Qnil;
276 b->auto_save_modified = 0;
277 b->auto_save_file_name = Qnil;
278 b->read_only = Qnil;
279 b->overlays_before = Qnil;
280 b->overlays_after = Qnil;
281 XFASTINT (b->overlay_center) = 1;
282 b->mark_active = Qnil;
283
284 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
285 INITIALIZE_INTERVAL (b, NULL_INTERVAL);
286
287 reset_buffer_local_variables(b);
288 }
289
290 reset_buffer_local_variables (b)
291 register struct buffer *b;
292 {
293 register int offset;
294
295 /* Reset the major mode to Fundamental, together with all the
296 things that depend on the major mode.
297 default-major-mode is handled at a higher level.
298 We ignore it here. */
299 b->major_mode = Qfundamental_mode;
300 b->keymap = Qnil;
301 b->abbrev_table = Vfundamental_mode_abbrev_table;
302 b->mode_name = QSFundamental;
303 b->minor_modes = Qnil;
304 b->downcase_table = Vascii_downcase_table;
305 b->upcase_table = Vascii_upcase_table;
306 b->case_canon_table = Vascii_downcase_table;
307 b->case_eqv_table = Vascii_upcase_table;
308 #if 0
309 b->sort_table = XSTRING (Vascii_sort_table);
310 b->folding_sort_table = XSTRING (Vascii_folding_sort_table);
311 #endif /* 0 */
312
313 /* Reset all per-buffer variables to their defaults. */
314 b->local_var_alist = Qnil;
315 b->local_var_flags = 0;
316
317 /* For each slot that has a default value,
318 copy that into the slot. */
319
320 for (offset = (char *)&buffer_local_flags.name - (char *)&buffer_local_flags;
321 offset < sizeof (struct buffer);
322 offset += sizeof (Lisp_Object)) /* sizeof int == sizeof Lisp_Object */
323 if (*(int *)(offset + (char *) &buffer_local_flags) > 0
324 || *(int *)(offset + (char *) &buffer_local_flags) == -2)
325 *(Lisp_Object *)(offset + (char *)b) =
326 *(Lisp_Object *)(offset + (char *)&buffer_defaults);
327 }
328
329 /* We split this away from generate-new-buffer, because rename-buffer
330 and set-visited-file-name ought to be able to use this to really
331 rename the buffer properly. */
332
333 DEFUN ("generate-new-buffer-name", Fgenerate_new_buffer_name, Sgenerate_new_buffer_name,
334 1, 2, 0,
335 "Return a string that is the name of no existing buffer based on NAME.\n\
336 If there is no live buffer named NAME, then return NAME.\n\
337 Otherwise modify name by appending `<NUMBER>', incrementing NUMBER\n\
338 until an unused name is found, and then return that name.\n\
339 Optional second argument IGNORE specifies a name that is okay to use\n\
340 \(if it is in the sequence to be tried)\n\
341 even if a buffer with that name exists.")
342 (name, ignore)
343 register Lisp_Object name, ignore;
344 {
345 register Lisp_Object gentemp, tem;
346 int count;
347 char number[10];
348
349 CHECK_STRING (name, 0);
350
351 tem = Fget_buffer (name);
352 if (NILP (tem))
353 return name;
354
355 count = 1;
356 while (1)
357 {
358 sprintf (number, "<%d>", ++count);
359 gentemp = concat2 (name, build_string (number));
360 tem = Fstring_equal (name, ignore);
361 if (!NILP (tem))
362 return gentemp;
363 tem = Fget_buffer (gentemp);
364 if (NILP (tem))
365 return gentemp;
366 }
367 }
368
369 \f
370 DEFUN ("buffer-name", Fbuffer_name, Sbuffer_name, 0, 1, 0,
371 "Return the name of BUFFER, as a string.\n\
372 With no argument or nil as argument, return the name of the current buffer.")
373 (buffer)
374 register Lisp_Object buffer;
375 {
376 if (NILP (buffer))
377 return current_buffer->name;
378 CHECK_BUFFER (buffer, 0);
379 return XBUFFER (buffer)->name;
380 }
381
382 DEFUN ("buffer-file-name", Fbuffer_file_name, Sbuffer_file_name, 0, 1, 0,
383 "Return name of file BUFFER is visiting, or nil if none.\n\
384 No argument or nil as argument means use the current buffer.")
385 (buffer)
386 register Lisp_Object buffer;
387 {
388 if (NILP (buffer))
389 return current_buffer->filename;
390 CHECK_BUFFER (buffer, 0);
391 return XBUFFER (buffer)->filename;
392 }
393
394 DEFUN ("buffer-local-variables", Fbuffer_local_variables,
395 Sbuffer_local_variables, 0, 1, 0,
396 "Return an alist of variables that are buffer-local in BUFFER.\n\
397 Each element looks like (SYMBOL . VALUE) and describes one variable.\n\
398 Note that storing new VALUEs in these elements doesn't change the variables.\n\
399 No argument or nil as argument means use current buffer as BUFFER.")
400 (buffer)
401 register Lisp_Object buffer;
402 {
403 register struct buffer *buf;
404 register Lisp_Object val;
405
406 if (NILP (buffer))
407 buf = current_buffer;
408 else
409 {
410 CHECK_BUFFER (buffer, 0);
411 buf = XBUFFER (buffer);
412 }
413
414 {
415 /* Reference each variable in the alist in our current buffer.
416 If inquiring about the current buffer, this gets the current values,
417 so store them into the alist so the alist is up to date.
418 If inquiring about some other buffer, this swaps out any values
419 for that buffer, making the alist up to date automatically. */
420 register Lisp_Object tem;
421 for (tem = buf->local_var_alist; CONSP (tem); tem = XCONS (tem)->cdr)
422 {
423 Lisp_Object v1 = Fsymbol_value (XCONS (XCONS (tem)->car)->car);
424 if (buf == current_buffer)
425 XCONS (XCONS (tem)->car)->cdr = v1;
426 }
427 }
428
429 /* Make a copy of the alist, to return it. */
430 val = Fcopy_alist (buf->local_var_alist);
431
432 /* Add on all the variables stored in special slots. */
433 {
434 register int offset, mask;
435
436 for (offset = (char *)&buffer_local_symbols.name - (char *)&buffer_local_symbols;
437 offset < sizeof (struct buffer);
438 offset += (sizeof (int))) /* sizeof int == sizeof Lisp_Object */
439 {
440 mask = *(int *)(offset + (char *) &buffer_local_flags);
441 if (mask == -1 || (buf->local_var_flags & mask))
442 if (XTYPE (*(Lisp_Object *)(offset + (char *)&buffer_local_symbols))
443 == Lisp_Symbol)
444 val = Fcons (Fcons (*(Lisp_Object *)(offset + (char *)&buffer_local_symbols),
445 *(Lisp_Object *)(offset + (char *)buf)),
446 val);
447 }
448 }
449 return (val);
450 }
451
452 \f
453 DEFUN ("buffer-modified-p", Fbuffer_modified_p, Sbuffer_modified_p,
454 0, 1, 0,
455 "Return t if BUFFER was modified since its file was last read or saved.\n\
456 No argument or nil as argument means use current buffer as BUFFER.")
457 (buffer)
458 register Lisp_Object buffer;
459 {
460 register struct buffer *buf;
461 if (NILP (buffer))
462 buf = current_buffer;
463 else
464 {
465 CHECK_BUFFER (buffer, 0);
466 buf = XBUFFER (buffer);
467 }
468
469 return buf->save_modified < BUF_MODIFF (buf) ? Qt : Qnil;
470 }
471
472 DEFUN ("set-buffer-modified-p", Fset_buffer_modified_p, Sset_buffer_modified_p,
473 1, 1, 0,
474 "Mark current buffer as modified or unmodified according to FLAG.\n\
475 A non-nil FLAG means mark the buffer modified.")
476 (flag)
477 register Lisp_Object flag;
478 {
479 register int already;
480 register Lisp_Object fn;
481
482 #ifdef CLASH_DETECTION
483 /* If buffer becoming modified, lock the file.
484 If buffer becoming unmodified, unlock the file. */
485
486 fn = current_buffer->filename;
487 if (!NILP (fn))
488 {
489 already = current_buffer->save_modified < MODIFF;
490 if (!already && !NILP (flag))
491 lock_file (fn);
492 else if (already && NILP (flag))
493 unlock_file (fn);
494 }
495 #endif /* CLASH_DETECTION */
496
497 current_buffer->save_modified = NILP (flag) ? MODIFF : 0;
498 update_mode_lines++;
499 return flag;
500 }
501
502 DEFUN ("buffer-modified-tick", Fbuffer_modified_tick, Sbuffer_modified_tick,
503 0, 1, 0,
504 "Return BUFFER's tick counter, incremented for each change in text.\n\
505 Each buffer has a tick counter which is incremented each time the text in\n\
506 that buffer is changed. It wraps around occasionally.\n\
507 No argument or nil as argument means use current buffer as BUFFER.")
508 (buffer)
509 register Lisp_Object buffer;
510 {
511 register struct buffer *buf;
512 if (NILP (buffer))
513 buf = current_buffer;
514 else
515 {
516 CHECK_BUFFER (buffer, 0);
517 buf = XBUFFER (buffer);
518 }
519
520 return make_number (BUF_MODIFF (buf));
521 }
522 \f
523 DEFUN ("rename-buffer", Frename_buffer, Srename_buffer, 1, 2,
524 "sRename buffer (to new name): \nP",
525 "Change current buffer's name to NEWNAME (a string).\n\
526 If second arg UNIQUE is nil or omitted, it is an error if a\n\
527 buffer named NEWNAME already exists.\n\
528 If UNIQUE is non-nil, come up with a new name using\n\
529 `generate-new-buffer-name'.\n\
530 Interactively, you can set UNIQUE with a prefix argument.\n\
531 We return the name we actually gave the buffer.\n\
532 This does not change the name of the visited file (if any).")
533 (name, unique)
534 register Lisp_Object name, unique;
535 {
536 register Lisp_Object tem, buf;
537
538 CHECK_STRING (name, 0);
539 tem = Fget_buffer (name);
540 if (XBUFFER (tem) == current_buffer)
541 return current_buffer->name;
542 if (!NILP (tem))
543 {
544 if (!NILP (unique))
545 name = Fgenerate_new_buffer_name (name, current_buffer->name);
546 else
547 error ("Buffer name \"%s\" is in use", XSTRING (name)->data);
548 }
549
550 current_buffer->name = name;
551
552 /* Catch redisplay's attention. Unless we do this, the mode lines for
553 any windows displaying current_buffer will stay unchanged. */
554 update_mode_lines++;
555
556 XSET (buf, Lisp_Buffer, current_buffer);
557 Fsetcar (Frassq (buf, Vbuffer_alist), name);
558 if (NILP (current_buffer->filename) && !NILP (current_buffer->auto_save_file_name))
559 call0 (intern ("rename-auto-save-file"));
560 return name;
561 }
562
563 DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 2, 0,
564 "Return most recently selected buffer other than BUFFER.\n\
565 Buffers not visible in windows are preferred to visible buffers,\n\
566 unless optional second argument VISIBLE-OK is non-nil.\n\
567 If no other buffer exists, the buffer `*scratch*' is returned.\n\
568 If BUFFER is omitted or nil, some interesting buffer is returned.")
569 (buffer, visible_ok)
570 register Lisp_Object buffer, visible_ok;
571 {
572 register Lisp_Object tail, buf, notsogood, tem;
573 notsogood = Qnil;
574
575 for (tail = Vbuffer_alist; !NILP (tail); tail = Fcdr (tail))
576 {
577 buf = Fcdr (Fcar (tail));
578 if (EQ (buf, buffer))
579 continue;
580 if (XSTRING (XBUFFER (buf)->name)->data[0] == ' ')
581 continue;
582 if (NILP (visible_ok))
583 tem = Fget_buffer_window (buf, Qnil);
584 else
585 tem = Qnil;
586 if (NILP (tem))
587 return buf;
588 if (NILP (notsogood))
589 notsogood = buf;
590 }
591 if (!NILP (notsogood))
592 return notsogood;
593 return Fget_buffer_create (build_string ("*scratch*"));
594 }
595 \f
596 DEFUN ("buffer-disable-undo", Fbuffer_disable_undo, Sbuffer_disable_undo, 1,1,
597 0,
598 "Make BUFFER stop keeping undo information.")
599 (buffer)
600 register Lisp_Object buffer;
601 {
602 Lisp_Object real_buffer;
603
604 if (NILP (buffer))
605 XSET (real_buffer, Lisp_Buffer, current_buffer);
606 else
607 {
608 real_buffer = Fget_buffer (buffer);
609 if (NILP (real_buffer))
610 nsberror (buffer);
611 }
612
613 XBUFFER (real_buffer)->undo_list = Qt;
614
615 return Qnil;
616 }
617
618 DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, Sbuffer_enable_undo,
619 0, 1, "",
620 "Start keeping undo information for buffer BUFFER.\n\
621 No argument or nil as argument means do this for the current buffer.")
622 (buffer)
623 register Lisp_Object buffer;
624 {
625 Lisp_Object real_buffer;
626
627 if (NILP (buffer))
628 XSET (real_buffer, Lisp_Buffer, current_buffer);
629 else
630 {
631 real_buffer = Fget_buffer (buffer);
632 if (NILP (real_buffer))
633 nsberror (buffer);
634 }
635
636 if (EQ (XBUFFER (real_buffer)->undo_list, Qt))
637 XBUFFER (real_buffer)->undo_list = Qnil;
638
639 return Qnil;
640 }
641
642 /*
643 DEFVAR_LISP ("kill-buffer-hook", no_cell, "\
644 Hook to be run (by `run-hooks', which see) when a buffer is killed.\n\
645 The buffer being killed will be current while the hook is running.\n\
646 See `kill-buffer'."
647 */
648 DEFUN ("kill-buffer", Fkill_buffer, Skill_buffer, 1, 1, "bKill buffer: ",
649 "Kill the buffer BUFFER.\n\
650 The argument may be a buffer or may be the name of a buffer.\n\
651 An argument of nil means kill the current buffer.\n\n\
652 Value is t if the buffer is actually killed, nil if user says no.\n\n\
653 The value of `kill-buffer-hook' (which may be local to that buffer),\n\
654 if not void, is a list of functions to be called, with no arguments,\n\
655 before the buffer is actually killed. The buffer to be killed is current\n\
656 when the hook functions are called.\n\n\
657 Any processes that have this buffer as the `process-buffer' are killed\n\
658 with `delete-process'.")
659 (bufname)
660 Lisp_Object bufname;
661 {
662 Lisp_Object buf;
663 register struct buffer *b;
664 register Lisp_Object tem;
665 register struct Lisp_Marker *m;
666 struct gcpro gcpro1, gcpro2;
667
668 if (NILP (bufname))
669 buf = Fcurrent_buffer ();
670 else
671 buf = Fget_buffer (bufname);
672 if (NILP (buf))
673 nsberror (bufname);
674
675 b = XBUFFER (buf);
676
677 /* Query if the buffer is still modified. */
678 if (INTERACTIVE && !NILP (b->filename)
679 && BUF_MODIFF (b) > b->save_modified)
680 {
681 GCPRO2 (buf, bufname);
682 tem = do_yes_or_no_p (format1 ("Buffer %s modified; kill anyway? ",
683 XSTRING (b->name)->data));
684 UNGCPRO;
685 if (NILP (tem))
686 return Qnil;
687 }
688
689 /* Run kill-buffer hook with the buffer to be killed the current buffer. */
690 {
691 register Lisp_Object val;
692 int count = specpdl_ptr - specpdl;
693
694 record_unwind_protect (save_excursion_restore, save_excursion_save ());
695 set_buffer_internal (b);
696 call1 (Vrun_hooks, Qkill_buffer_hook);
697 unbind_to (count, Qnil);
698 }
699
700 /* We have no more questions to ask. Verify that it is valid
701 to kill the buffer. This must be done after the questions
702 since anything can happen within do_yes_or_no_p. */
703
704 /* Don't kill the minibuffer now current. */
705 if (EQ (buf, XWINDOW (minibuf_window)->buffer))
706 return Qnil;
707
708 if (NILP (b->name))
709 return Qnil;
710
711 /* Make this buffer not be current.
712 In the process, notice if this is the sole visible buffer
713 and give up if so. */
714 if (b == current_buffer)
715 {
716 tem = Fother_buffer (buf, Qnil);
717 Fset_buffer (tem);
718 if (b == current_buffer)
719 return Qnil;
720 }
721
722 /* Now there is no question: we can kill the buffer. */
723
724 #ifdef CLASH_DETECTION
725 /* Unlock this buffer's file, if it is locked. */
726 unlock_buffer (b);
727 #endif /* CLASH_DETECTION */
728
729 kill_buffer_processes (buf);
730
731 tem = Vinhibit_quit;
732 Vinhibit_quit = Qt;
733 Vbuffer_alist = Fdelq (Frassq (buf, Vbuffer_alist), Vbuffer_alist);
734 Freplace_buffer_in_windows (buf);
735 Vinhibit_quit = tem;
736
737 /* Delete any auto-save file. */
738 if (XTYPE (b->auto_save_file_name) == Lisp_String)
739 {
740 Lisp_Object tem;
741 tem = Fsymbol_value (intern ("delete-auto-save-files"));
742 if (! NILP (tem))
743 unlink (XSTRING (b->auto_save_file_name)->data);
744 }
745
746 /* Unchain all markers of this buffer
747 and leave them pointing nowhere. */
748 for (tem = b->markers; !EQ (tem, Qnil); )
749 {
750 m = XMARKER (tem);
751 m->buffer = 0;
752 tem = m->chain;
753 m->chain = Qnil;
754 }
755 b->markers = Qnil;
756
757 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
758 INITIALIZE_INTERVAL (b, NULL_INTERVAL);
759 /* Perhaps we should explicitly free the interval tree here... */
760
761 b->name = Qnil;
762 BLOCK_INPUT;
763 BUFFER_FREE (BUF_BEG_ADDR (b));
764 UNBLOCK_INPUT;
765 b->undo_list = Qnil;
766
767 return Qt;
768 }
769 \f
770 /* Move the assoc for buffer BUF to the front of buffer-alist. Since
771 we do this each time BUF is selected visibly, the more recently
772 selected buffers are always closer to the front of the list. This
773 means that other_buffer is more likely to choose a relevant buffer. */
774
775 record_buffer (buf)
776 Lisp_Object buf;
777 {
778 register Lisp_Object link, prev;
779
780 prev = Qnil;
781 for (link = Vbuffer_alist; CONSP (link); link = XCONS (link)->cdr)
782 {
783 if (EQ (XCONS (XCONS (link)->car)->cdr, buf))
784 break;
785 prev = link;
786 }
787
788 /* Effectively do Vbuffer_alist = Fdelq (link, Vbuffer_alist);
789 we cannot use Fdelq itself here because it allows quitting. */
790
791 if (NILP (prev))
792 Vbuffer_alist = XCONS (Vbuffer_alist)->cdr;
793 else
794 XCONS (prev)->cdr = XCONS (XCONS (prev)->cdr)->cdr;
795
796 XCONS(link)->cdr = Vbuffer_alist;
797 Vbuffer_alist = link;
798 }
799
800 DEFUN ("switch-to-buffer", Fswitch_to_buffer, Sswitch_to_buffer, 1, 2, "BSwitch to buffer: ",
801 "Select buffer BUFFER in the current window.\n\
802 BUFFER may be a buffer or a buffer name.\n\
803 Optional second arg NORECORD non-nil means\n\
804 do not put this buffer at the front of the list of recently selected ones.\n\
805 \n\
806 WARNING: This is NOT the way to work on another buffer temporarily\n\
807 within a Lisp program! Use `set-buffer' instead. That avoids messing with\n\
808 the window-buffer correspondences.")
809 (bufname, norecord)
810 Lisp_Object bufname, norecord;
811 {
812 register Lisp_Object buf;
813 Lisp_Object tem;
814
815 if (EQ (minibuf_window, selected_window))
816 error ("Cannot switch buffers in minibuffer window");
817 tem = Fwindow_dedicated_p (selected_window);
818 if (!NILP (tem))
819 error ("Cannot switch buffers in a dedicated window");
820
821 if (NILP (bufname))
822 buf = Fother_buffer (Fcurrent_buffer (), Qnil);
823 else
824 buf = Fget_buffer_create (bufname);
825 Fset_buffer (buf);
826 if (NILP (norecord))
827 record_buffer (buf);
828
829 Fset_window_buffer (EQ (selected_window, minibuf_window)
830 ? Fnext_window (minibuf_window, Qnil, Qnil)
831 : selected_window,
832 buf);
833
834 return buf;
835 }
836
837 DEFUN ("pop-to-buffer", Fpop_to_buffer, Spop_to_buffer, 1, 2, 0,
838 "Select buffer BUFFER in some window, preferably a different one.\n\
839 If BUFFER is nil, then some other buffer is chosen.\n\
840 If `pop-up-windows' is non-nil, windows can be split to do this.\n\
841 If optional second arg OTHER-WINDOW is non-nil, insist on finding another\n\
842 window even if BUFFER is already visible in the selected window.")
843 (bufname, other)
844 Lisp_Object bufname, other;
845 {
846 register Lisp_Object buf;
847 if (NILP (bufname))
848 buf = Fother_buffer (Fcurrent_buffer (), Qnil);
849 else
850 buf = Fget_buffer_create (bufname);
851 Fset_buffer (buf);
852 record_buffer (buf);
853 Fselect_window (Fdisplay_buffer (buf, other));
854 return buf;
855 }
856
857 DEFUN ("current-buffer", Fcurrent_buffer, Scurrent_buffer, 0, 0, 0,
858 "Return the current buffer as a Lisp object.")
859 ()
860 {
861 register Lisp_Object buf;
862 XSET (buf, Lisp_Buffer, current_buffer);
863 return buf;
864 }
865 \f
866 /* Set the current buffer to b */
867
868 void
869 set_buffer_internal (b)
870 register struct buffer *b;
871 {
872 register struct buffer *old_buf;
873 register Lisp_Object tail, valcontents;
874 enum Lisp_Type tem;
875
876 if (current_buffer == b)
877 return;
878
879 windows_or_buffers_changed = 1;
880 old_buf = current_buffer;
881 current_buffer = b;
882 last_known_column_point = -1; /* invalidate indentation cache */
883
884 /* Look down buffer's list of local Lisp variables
885 to find and update any that forward into C variables. */
886
887 for (tail = b->local_var_alist; !NILP (tail); tail = XCONS (tail)->cdr)
888 {
889 valcontents = XSYMBOL (XCONS (XCONS (tail)->car)->car)->value;
890 if ((XTYPE (valcontents) == Lisp_Buffer_Local_Value
891 || XTYPE (valcontents) == Lisp_Some_Buffer_Local_Value)
892 && (tem = XTYPE (XCONS (valcontents)->car),
893 (tem == Lisp_Boolfwd || tem == Lisp_Intfwd
894 || tem == Lisp_Objfwd)))
895 /* Just reference the variable
896 to cause it to become set for this buffer. */
897 Fsymbol_value (XCONS (XCONS (tail)->car)->car);
898 }
899
900 /* Do the same with any others that were local to the previous buffer */
901
902 if (old_buf)
903 for (tail = old_buf->local_var_alist; !NILP (tail); tail = XCONS (tail)->cdr)
904 {
905 valcontents = XSYMBOL (XCONS (XCONS (tail)->car)->car)->value;
906 if ((XTYPE (valcontents) == Lisp_Buffer_Local_Value
907 || XTYPE (valcontents) == Lisp_Some_Buffer_Local_Value)
908 && (tem = XTYPE (XCONS (valcontents)->car),
909 (tem == Lisp_Boolfwd || tem == Lisp_Intfwd
910 || tem == Lisp_Objfwd)))
911 /* Just reference the variable
912 to cause it to become set for this buffer. */
913 Fsymbol_value (XCONS (XCONS (tail)->car)->car);
914 }
915 }
916
917 DEFUN ("set-buffer", Fset_buffer, Sset_buffer, 1, 1, 0,
918 "Make the buffer BUFFER current for editing operations.\n\
919 BUFFER may be a buffer or the name of an existing buffer.\n\
920 See also `save-excursion' when you want to make a buffer current temporarily.\n\
921 This function does not display the buffer, so its effect ends\n\
922 when the current command terminates.\n\
923 Use `switch-to-buffer' or `pop-to-buffer' to switch buffers permanently.")
924 (bufname)
925 register Lisp_Object bufname;
926 {
927 register Lisp_Object buffer;
928 buffer = Fget_buffer (bufname);
929 if (NILP (buffer))
930 nsberror (bufname);
931 if (NILP (XBUFFER (buffer)->name))
932 error ("Selecting deleted buffer");
933 set_buffer_internal (XBUFFER (buffer));
934 return buffer;
935 }
936 \f
937 DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only,
938 Sbarf_if_buffer_read_only, 0, 0, 0,
939 "Signal a `buffer-read-only' error if the current buffer is read-only.")
940 ()
941 {
942 while (!NILP (current_buffer->read_only))
943 Fsignal (Qbuffer_read_only, (Fcons (Fcurrent_buffer (), Qnil)));
944 return Qnil;
945 }
946
947 DEFUN ("bury-buffer", Fbury_buffer, Sbury_buffer, 0, 1, "",
948 "Put BUFFER at the end of the list of all buffers.\n\
949 There it is the least likely candidate for `other-buffer' to return;\n\
950 thus, the least likely buffer for \\[switch-to-buffer] to select by default.\n\
951 If BUFFER is nil or omitted, bury the current buffer.\n\
952 Also, if BUFFER is nil or omitted, remove the current buffer from the\n\
953 selected window if it is displayed there.")
954 (buf)
955 register Lisp_Object buf;
956 {
957 /* Figure out what buffer we're going to bury. */
958 if (NILP (buf))
959 {
960 XSET (buf, Lisp_Buffer, current_buffer);
961
962 /* If we're burying the current buffer, unshow it. */
963 Fswitch_to_buffer (Fother_buffer (buf, Qnil), Qnil);
964 }
965 else
966 {
967 Lisp_Object buf1;
968
969 buf1 = Fget_buffer (buf);
970 if (NILP (buf1))
971 nsberror (buf);
972 buf = buf1;
973 }
974
975 /* Move buf to the end of the buffer list. */
976 {
977 register Lisp_Object aelt, link;
978
979 aelt = Frassq (buf, Vbuffer_alist);
980 link = Fmemq (aelt, Vbuffer_alist);
981 Vbuffer_alist = Fdelq (aelt, Vbuffer_alist);
982 XCONS (link)->cdr = Qnil;
983 Vbuffer_alist = nconc2 (Vbuffer_alist, link);
984 }
985
986 return Qnil;
987 }
988 \f
989 DEFUN ("erase-buffer", Ferase_buffer, Serase_buffer, 0, 0, "*",
990 "Delete the entire contents of the current buffer.\n\
991 Any clipping restriction in effect (see `narrow-to-region') is removed,\n\
992 so the buffer is truly empty after this.")
993 ()
994 {
995 Fwiden ();
996 del_range (BEG, Z);
997 current_buffer->last_window_start = 1;
998 /* Prevent warnings, or suspension of auto saving, that would happen
999 if future size is less than past size. Use of erase-buffer
1000 implies that the future text is not really related to the past text. */
1001 XFASTINT (current_buffer->save_length) = 0;
1002 return Qnil;
1003 }
1004
1005 validate_region (b, e)
1006 register Lisp_Object *b, *e;
1007 {
1008 register int i;
1009
1010 CHECK_NUMBER_COERCE_MARKER (*b, 0);
1011 CHECK_NUMBER_COERCE_MARKER (*e, 1);
1012
1013 if (XINT (*b) > XINT (*e))
1014 {
1015 i = XFASTINT (*b); /* This is legit even if *b is < 0 */
1016 *b = *e;
1017 XFASTINT (*e) = i; /* because this is all we do with i. */
1018 }
1019
1020 if (!(BEGV <= XINT (*b) && XINT (*b) <= XINT (*e)
1021 && XINT (*e) <= ZV))
1022 args_out_of_range (*b, *e);
1023 }
1024 \f
1025 Lisp_Object
1026 list_buffers_1 (files)
1027 Lisp_Object files;
1028 {
1029 register Lisp_Object tail, tem, buf;
1030 Lisp_Object col1, col2, col3, minspace;
1031 register struct buffer *old = current_buffer, *b;
1032 int desired_point = 0;
1033 Lisp_Object other_file_symbol;
1034
1035 other_file_symbol = intern ("list-buffers-directory");
1036
1037 XFASTINT (col1) = 19;
1038 XFASTINT (col2) = 25;
1039 XFASTINT (col3) = 40;
1040 XFASTINT (minspace) = 1;
1041
1042 Fset_buffer (Vstandard_output);
1043
1044 tail = intern ("Buffer-menu-mode");
1045 if (!EQ (tail, current_buffer->major_mode)
1046 && (tem = Ffboundp (tail), !NILP (tem)))
1047 call0 (tail);
1048 Fbuffer_disable_undo (Vstandard_output);
1049 current_buffer->read_only = Qnil;
1050
1051 write_string ("\
1052 MR Buffer Size Mode File\n\
1053 -- ------ ---- ---- ----\n", -1);
1054
1055 for (tail = Vbuffer_alist; !NILP (tail); tail = Fcdr (tail))
1056 {
1057 buf = Fcdr (Fcar (tail));
1058 b = XBUFFER (buf);
1059 /* Don't mention the minibuffers. */
1060 if (XSTRING (b->name)->data[0] == ' ')
1061 continue;
1062 /* Optionally don't mention buffers that lack files. */
1063 if (!NILP (files) && NILP (b->filename))
1064 continue;
1065 /* Identify the current buffer. */
1066 if (b == old)
1067 desired_point = point;
1068 write_string (b == old ? "." : " ", -1);
1069 /* Identify modified buffers */
1070 write_string (BUF_MODIFF (b) > b->save_modified ? "*" : " ", -1);
1071 write_string (NILP (b->read_only) ? " " : "% ", -1);
1072 Fprinc (b->name, Qnil);
1073 Findent_to (col1, make_number (2));
1074 XFASTINT (tem) = BUF_Z (b) - BUF_BEG (b);
1075 Fprin1 (tem, Qnil);
1076 Findent_to (col2, minspace);
1077 Fprinc (b->mode_name, Qnil);
1078 Findent_to (col3, minspace);
1079
1080 if (!NILP (b->filename))
1081 Fprinc (b->filename, Qnil);
1082 else
1083 {
1084 /* No visited file; check local value of list-buffers-directory. */
1085 Lisp_Object tem;
1086 set_buffer_internal (b);
1087 tem = Fboundp (other_file_symbol);
1088 if (!NILP (tem))
1089 {
1090 tem = Fsymbol_value (other_file_symbol);
1091 Fset_buffer (Vstandard_output);
1092 if (XTYPE (tem) == Lisp_String)
1093 Fprinc (tem, Qnil);
1094 }
1095 else
1096 Fset_buffer (Vstandard_output);
1097 }
1098 write_string ("\n", -1);
1099 }
1100
1101 current_buffer->read_only = Qt;
1102 set_buffer_internal (old);
1103 /* Foo. This doesn't work since temp_output_buffer_show sets point to 1
1104 if (desired_point)
1105 XBUFFER (Vstandard_output)->text.pointloc = desired_point;
1106 */
1107 return Qnil;
1108 }
1109
1110 DEFUN ("list-buffers", Flist_buffers, Slist_buffers, 0, 1, "P",
1111 "Display a list of names of existing buffers.\n\
1112 The list is displayed in a buffer named `*Buffer List*'.\n\
1113 Note that buffers with names starting with spaces are omitted.\n\
1114 Non-null optional arg FILES-ONLY means mention only file buffers.\n\
1115 \n\
1116 The M column contains a * for buffers that are modified.\n\
1117 The R column contains a % for buffers that are read-only.")
1118 (files)
1119 Lisp_Object files;
1120 {
1121 internal_with_output_to_temp_buffer ("*Buffer List*",
1122 list_buffers_1, files);
1123 return Qnil;
1124 }
1125
1126 DEFUN ("kill-all-local-variables", Fkill_all_local_variables, Skill_all_local_variables,
1127 0, 0, 0,
1128 "Switch to Fundamental mode by killing current buffer's local variables.\n\
1129 Most local variable bindings are eliminated so that the default values\n\
1130 become effective once more. Also, the syntax table is set from\n\
1131 `standard-syntax-table', the local keymap is set to nil,\n\
1132 and the abbrev table from `fundamental-mode-abbrev-table'.\n\
1133 This function also forces redisplay of the mode line.\n\
1134 \n\
1135 Every function to select a new major mode starts by\n\
1136 calling this function.\n\n\
1137 As a special exception, local variables whose names have\n\
1138 a non-nil `permanent-local' property are not eliminated by this function.")
1139 ()
1140 {
1141 register Lisp_Object alist, sym, tem;
1142 Lisp_Object oalist;
1143 oalist = current_buffer->local_var_alist;
1144
1145 /* Make sure no local variables remain set up with this buffer
1146 for their current values. */
1147
1148 for (alist = oalist; !NILP (alist); alist = XCONS (alist)->cdr)
1149 {
1150 sym = XCONS (XCONS (alist)->car)->car;
1151
1152 /* Need not do anything if some other buffer's binding is now encached. */
1153 tem = XCONS (XCONS (XSYMBOL (sym)->value)->cdr)->car;
1154 if (XBUFFER (tem) == current_buffer)
1155 {
1156 /* Symbol is set up for this buffer's old local value.
1157 Set it up for the current buffer with the default value. */
1158
1159 tem = XCONS (XCONS (XSYMBOL (sym)->value)->cdr)->cdr;
1160 /* Store the symbol's current value into the alist entry
1161 it is currently set up for. This is so that, if the
1162 local is marked permanent, and we make it local again below,
1163 we don't lose the value. */
1164 XCONS (XCONS (tem)->car)->cdr = XCONS (XSYMBOL (sym)->value)->car;
1165 /* Switch to the symbol's default-value alist entry. */
1166 XCONS (tem)->car = tem;
1167 /* Mark it as current for the current buffer. */
1168 XCONS (XCONS (XSYMBOL (sym)->value)->cdr)->car = Fcurrent_buffer ();
1169 /* Store the current value into any forwarding in the symbol. */
1170 store_symval_forwarding (sym, XCONS (XSYMBOL (sym)->value)->car,
1171 XCONS (tem)->cdr);
1172 }
1173 }
1174
1175 /* Actually eliminate all local bindings of this buffer. */
1176
1177 reset_buffer_local_variables (current_buffer);
1178
1179 /* Redisplay mode lines; we are changing major mode. */
1180
1181 update_mode_lines++;
1182
1183 /* Any which are supposed to be permanent,
1184 make local again, with the same values they had. */
1185
1186 for (alist = oalist; !NILP (alist); alist = XCONS (alist)->cdr)
1187 {
1188 sym = XCONS (XCONS (alist)->car)->car;
1189 tem = Fget (sym, Qpermanent_local);
1190 if (! NILP (tem))
1191 {
1192 Fmake_local_variable (sym);
1193 Fset (sym, XCONS (XCONS (alist)->car)->cdr);
1194 }
1195 }
1196
1197 /* Force mode-line redisplay. Useful here because all major mode
1198 commands call this function. */
1199 update_mode_lines++;
1200
1201 return Qnil;
1202 }
1203 \f
1204 /* Find all the overlays in the current buffer that contain position POS.
1205 Return the number found, and store them in a vector in *VEC_PTR.
1206 Store in *LEN_PTR the size allocated for the vector.
1207 Store in *NEXT_PTR the next position after POS where an overlay starts,
1208 or ZV if there are no more overlays.
1209
1210 *VEC_PTR and *LEN_PTR should contain a valid vector and size
1211 when this function is called.
1212
1213 If EXTEND is non-zero, we make the vector bigger if necessary.
1214 If EXTEND is zero, we never extend the vector,
1215 and we store only as many overlays as will fit.
1216 But we still return the total number of overlays. */
1217
1218 int
1219 overlays_at (pos, extend, vec_ptr, len_ptr, next_ptr)
1220 int pos;
1221 int extend;
1222 Lisp_Object **vec_ptr;
1223 int *len_ptr;
1224 int *next_ptr;
1225 {
1226 Lisp_Object tail, overlay, start, end, result;
1227 int idx = 0;
1228 int len = *len_ptr;
1229 Lisp_Object *vec = *vec_ptr;
1230 int next = ZV;
1231 int inhibit_storing = 0;
1232
1233 for (tail = current_buffer->overlays_before;
1234 CONSP (tail);
1235 tail = XCONS (tail)->cdr)
1236 {
1237 int startpos;
1238
1239 overlay = XCONS (tail)->car;
1240 if (! OVERLAY_VALID (overlay))
1241 abort ();
1242
1243 start = OVERLAY_START (overlay);
1244 end = OVERLAY_END (overlay);
1245 if (OVERLAY_POSITION (end) <= pos)
1246 break;
1247 startpos = OVERLAY_POSITION (start);
1248 if (startpos <= pos)
1249 {
1250 if (idx == len)
1251 {
1252 /* The supplied vector is full.
1253 Either make it bigger, or don't store any more in it. */
1254 if (extend)
1255 {
1256 *len_ptr = len *= 2;
1257 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
1258 *vec_ptr = vec;
1259 }
1260 else
1261 inhibit_storing = 1;
1262 }
1263
1264 if (!inhibit_storing)
1265 vec[idx] = overlay;
1266 /* Keep counting overlays even if we can't return them all. */
1267 idx++;
1268 }
1269 else if (startpos < next)
1270 next = startpos;
1271 }
1272
1273 for (tail = current_buffer->overlays_after;
1274 CONSP (tail);
1275 tail = XCONS (tail)->cdr)
1276 {
1277 int startpos;
1278
1279 overlay = XCONS (tail)->car;
1280 if (! OVERLAY_VALID (overlay))
1281 abort ();
1282
1283 start = OVERLAY_START (overlay);
1284 end = OVERLAY_END (overlay);
1285 startpos = OVERLAY_POSITION (start);
1286 if (pos < startpos)
1287 {
1288 if (startpos < next)
1289 next = startpos;
1290 break;
1291 }
1292 if (pos < OVERLAY_POSITION (end))
1293 {
1294 if (idx == len)
1295 {
1296 if (extend)
1297 {
1298 *len_ptr = len *= 2;
1299 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
1300 *vec_ptr = vec;
1301 }
1302 else
1303 inhibit_storing = 1;
1304 }
1305
1306 if (!inhibit_storing)
1307 vec[idx] = overlay;
1308 idx++;
1309 }
1310 }
1311
1312 *next_ptr = next;
1313 return idx;
1314 }
1315 \f
1316 /* Shift overlays in BUF's overlay lists, to center the lists at POS. */
1317
1318 void
1319 recenter_overlay_lists (buf, pos)
1320 struct buffer *buf;
1321 int pos;
1322 {
1323 Lisp_Object overlay, tail, next, prev, beg, end;
1324
1325 /* See if anything in overlays_before should move to overlays_after. */
1326
1327 /* We don't strictly need prev in this loop; it should always be nil.
1328 But we use it for symmetry and in case that should cease to be true
1329 with some future change. */
1330 prev = Qnil;
1331 for (tail = buf->overlays_before;
1332 CONSP (tail);
1333 prev = tail, tail = next)
1334 {
1335 next = XCONS (tail)->cdr;
1336 overlay = XCONS (tail)->car;
1337
1338 /* If the overlay is not valid, get rid of it. */
1339 if (!OVERLAY_VALID (overlay))
1340 #if 1
1341 abort ();
1342 #else
1343 {
1344 /* Splice the cons cell TAIL out of overlays_before. */
1345 if (!NILP (prev))
1346 XCONS (prev)->cdr = next;
1347 else
1348 buf->overlays_before = next;
1349 tail = prev;
1350 continue;
1351 }
1352 #endif
1353
1354 beg = OVERLAY_START (overlay);
1355 end = OVERLAY_END (overlay);
1356
1357 if (OVERLAY_POSITION (end) > pos)
1358 {
1359 /* OVERLAY needs to be moved. */
1360 int where = OVERLAY_POSITION (beg);
1361 Lisp_Object other, other_prev;
1362
1363 /* Splice the cons cell TAIL out of overlays_before. */
1364 if (!NILP (prev))
1365 XCONS (prev)->cdr = next;
1366 else
1367 buf->overlays_before = next;
1368
1369 /* Search thru overlays_after for where to put it. */
1370 other_prev = Qnil;
1371 for (other = buf->overlays_after;
1372 CONSP (other);
1373 other_prev = other, other = XCONS (other)->cdr)
1374 {
1375 Lisp_Object otherbeg, otheroverlay, follower;
1376 int win;
1377
1378 otheroverlay = XCONS (other)->car;
1379 if (! OVERLAY_VALID (otheroverlay))
1380 abort ();
1381
1382 otherbeg = OVERLAY_START (otheroverlay);
1383 if (OVERLAY_POSITION (otherbeg) >= where)
1384 break;
1385 }
1386
1387 /* Add TAIL to overlays_after before OTHER. */
1388 XCONS (tail)->cdr = other;
1389 if (!NILP (other_prev))
1390 XCONS (other_prev)->cdr = tail;
1391 else
1392 buf->overlays_after = tail;
1393 tail = prev;
1394 }
1395 else
1396 /* We've reached the things that should stay in overlays_before.
1397 All the rest of overlays_before must end even earlier,
1398 so stop now. */
1399 break;
1400 }
1401
1402 /* See if anything in overlays_after should be in overlays_before. */
1403 prev = Qnil;
1404 for (tail = buf->overlays_after;
1405 CONSP (tail);
1406 prev = tail, tail = next)
1407 {
1408 next = XCONS (tail)->cdr;
1409 overlay = XCONS (tail)->car;
1410
1411 /* If the overlay is not valid, get rid of it. */
1412 if (!OVERLAY_VALID (overlay))
1413 #if 1
1414 abort ();
1415 #else
1416 {
1417 /* Splice the cons cell TAIL out of overlays_after. */
1418 if (!NILP (prev))
1419 XCONS (prev)->cdr = next;
1420 else
1421 buf->overlays_after = next;
1422 tail = prev;
1423 continue;
1424 }
1425 #endif
1426
1427 beg = OVERLAY_START (overlay);
1428 end = OVERLAY_END (overlay);
1429
1430 /* Stop looking, when we know that nothing further
1431 can possibly end before POS. */
1432 if (OVERLAY_POSITION (beg) > pos)
1433 break;
1434
1435 if (OVERLAY_POSITION (end) <= pos)
1436 {
1437 /* OVERLAY needs to be moved. */
1438 int where = OVERLAY_POSITION (end);
1439 Lisp_Object other, other_prev;
1440
1441 /* Splice the cons cell TAIL out of overlays_after. */
1442 if (!NILP (prev))
1443 XCONS (prev)->cdr = next;
1444 else
1445 buf->overlays_after = next;
1446
1447 /* Search thru overlays_before for where to put it. */
1448 other_prev = Qnil;
1449 for (other = buf->overlays_before;
1450 CONSP (other);
1451 other_prev = other, other = XCONS (other)->cdr)
1452 {
1453 Lisp_Object otherend, otheroverlay;
1454 int win;
1455
1456 otheroverlay = XCONS (other)->car;
1457 if (! OVERLAY_VALID (otheroverlay))
1458 abort ();
1459
1460 otherend = OVERLAY_END (otheroverlay);
1461 if (OVERLAY_POSITION (otherend) <= where)
1462 break;
1463 }
1464
1465 /* Add TAIL to overlays_before before OTHER. */
1466 XCONS (tail)->cdr = other;
1467 if (!NILP (other_prev))
1468 XCONS (other_prev)->cdr = tail;
1469 else
1470 buf->overlays_before = tail;
1471 tail = prev;
1472 }
1473 }
1474
1475 XFASTINT (buf->overlay_center) = pos;
1476 }
1477 \f
1478 DEFUN ("overlayp", Foverlayp, Soverlayp, 1, 1, 0,
1479 "Return t if OBJECT is an overlay.")
1480 (object)
1481 Lisp_Object object;
1482 {
1483 return (OVERLAYP (object) ? Qt : Qnil);
1484 }
1485
1486 DEFUN ("make-overlay", Fmake_overlay, Smake_overlay, 2, 3, 0,
1487 "Create a new overlay with range BEG to END in BUFFER.\n\
1488 If omitted, BUFFER defaults to the current buffer.\n\
1489 BEG and END may be integers or markers.")
1490 (beg, end, buffer)
1491 Lisp_Object beg, end, buffer;
1492 {
1493 Lisp_Object overlay;
1494 struct buffer *b;
1495
1496 if (NILP (buffer))
1497 XSET (buffer, Lisp_Buffer, current_buffer);
1498 else
1499 CHECK_BUFFER (buffer, 2);
1500 if (MARKERP (beg)
1501 && ! EQ (Fmarker_buffer (beg), buffer))
1502 error ("Marker points into wrong buffer");
1503 if (MARKERP (end)
1504 && ! EQ (Fmarker_buffer (end), buffer))
1505 error ("Marker points into wrong buffer");
1506
1507 CHECK_NUMBER_COERCE_MARKER (beg, 1);
1508 CHECK_NUMBER_COERCE_MARKER (end, 1);
1509
1510 if (XINT (beg) > XINT (end))
1511 {
1512 Lisp_Object temp = beg;
1513 beg = end; end = temp;
1514 }
1515
1516 b = XBUFFER (buffer);
1517
1518 beg = Fset_marker (Fmake_marker (), beg, buffer);
1519 end = Fset_marker (Fmake_marker (), end, buffer);
1520
1521 overlay = Fcons (Fcons (beg, end), Qnil);
1522 XSETTYPE (overlay, Lisp_Overlay);
1523
1524 /* Put the new overlay on the wrong list. */
1525 end = OVERLAY_END (overlay);
1526 if (OVERLAY_POSITION (end) < XINT (b->overlay_center))
1527 b->overlays_after = Fcons (overlay, b->overlays_after);
1528 else
1529 b->overlays_before = Fcons (overlay, b->overlays_before);
1530
1531 /* This puts it in the right list, and in the right order. */
1532 recenter_overlay_lists (b, XINT (b->overlay_center));
1533
1534 /* We don't need to redisplay the region covered by the overlay, because
1535 the overlay has no properties at the moment. */
1536
1537 return overlay;
1538 }
1539
1540 DEFUN ("move-overlay", Fmove_overlay, Smove_overlay, 3, 4, 0,
1541 "Set the endpoints of OVERLAY to BEG and END in BUFFER.\n\
1542 If BUFFER is omitted, leave OVERLAY in the same buffer it inhabits now.\n\
1543 If BUFFER is omitted, and OVERLAY is in no buffer, put it in the current\n\
1544 buffer.")
1545 (overlay, beg, end, buffer)
1546 Lisp_Object overlay, beg, end, buffer;
1547 {
1548 struct buffer *b;
1549
1550 CHECK_OVERLAY (overlay, 0);
1551 if (NILP (buffer))
1552 buffer = Fmarker_buffer (OVERLAY_START (overlay));
1553 if (NILP (buffer))
1554 XSET (buffer, Lisp_Buffer, current_buffer);
1555 CHECK_BUFFER (buffer, 3);
1556
1557 if (MARKERP (beg)
1558 && ! EQ (Fmarker_buffer (beg), buffer))
1559 error ("Marker points into wrong buffer");
1560 if (MARKERP (end)
1561 && ! EQ (Fmarker_buffer (end), buffer))
1562 error ("Marker points into wrong buffer");
1563
1564 CHECK_NUMBER_COERCE_MARKER (beg, 1);
1565 CHECK_NUMBER_COERCE_MARKER (end, 1);
1566
1567 if (XINT (beg) > XINT (end))
1568 {
1569 Lisp_Object temp = beg;
1570 beg = end; end = temp;
1571 }
1572
1573 b = XBUFFER (buffer);
1574
1575 /* If the overlay has changed buffers, do a thorough redisplay. */
1576 if (b != XMARKER (OVERLAY_START (overlay))->buffer)
1577 windows_or_buffers_changed = 1;
1578 else
1579 /* Redisplay the area the overlay has just left, or just enclosed. */
1580 {
1581 Lisp_Object o_beg = OVERLAY_START (overlay);
1582 Lisp_Object o_end = OVERLAY_END (overlay);
1583 int change_beg, change_end;
1584
1585 o_beg = OVERLAY_POSITION (o_beg);
1586 o_end = OVERLAY_POSITION (o_end);
1587
1588 if (XINT (o_beg) == XINT (beg))
1589 redisplay_region (b, XINT (o_end), XINT (end));
1590 else if (XINT (o_end) == XINT (end))
1591 redisplay_region (b, XINT (o_beg), XINT (beg));
1592 else
1593 {
1594 if (XINT (beg) < XINT (o_beg)) o_beg = beg;
1595 if (XINT (end) > XINT (o_end)) o_end = end;
1596 redisplay_region (b, XINT (o_beg), XINT (o_end));
1597 }
1598 }
1599
1600 b->overlays_before = Fdelq (overlay, b->overlays_before);
1601 b->overlays_after = Fdelq (overlay, b->overlays_after);
1602
1603 Fset_marker (OVERLAY_START (overlay), beg, buffer);
1604 Fset_marker (OVERLAY_END (overlay), end, buffer);
1605
1606 /* Put the overlay on the wrong list. */
1607 end = OVERLAY_END (overlay);
1608 if (OVERLAY_POSITION (end) < XINT (b->overlay_center))
1609 b->overlays_after = Fcons (overlay, b->overlays_after);
1610 else
1611 b->overlays_before = Fcons (overlay, b->overlays_before);
1612
1613 /* This puts it in the right list, and in the right order. */
1614 recenter_overlay_lists (b, XINT (b->overlay_center));
1615
1616 return overlay;
1617 }
1618
1619 DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0,
1620 "Delete the overlay OVERLAY from its buffer.")
1621 (overlay)
1622 Lisp_Object overlay;
1623 {
1624 struct buffer *b;
1625
1626 CHECK_OVERLAY (overlay, 0);
1627
1628 b = XBUFFER (Fmarker_buffer (OVERLAY_START (overlay)));
1629
1630 b->overlays_before = Fdelq (overlay, b->overlays_before);
1631 b->overlays_after = Fdelq (overlay, b->overlays_after);
1632
1633 redisplay_region (b,
1634 OVERLAY_POSITION (OVERLAY_START (overlay)),
1635 OVERLAY_POSITION (OVERLAY_END (overlay)));
1636
1637 Fset_marker (OVERLAY_START (overlay), Qnil, Qnil);
1638 Fset_marker (OVERLAY_END (overlay), Qnil, Qnil);
1639
1640 return Qnil;
1641 }
1642 \f
1643 /* Overlay dissection functions. */
1644
1645 DEFUN ("overlay-start", Foverlay_start, Soverlay_start, 1, 1, 0,
1646 "Return the position at which OVERLAY starts.")
1647 (overlay)
1648 Lisp_Object overlay;
1649 {
1650 CHECK_OVERLAY (overlay, 0);
1651
1652 return (Fmarker_position (OVERLAY_START (overlay)));
1653 }
1654
1655 DEFUN ("overlay-end", Foverlay_end, Soverlay_end, 1, 1, 0,
1656 "Return the position at which OVERLAY ends.")
1657 (overlay)
1658 Lisp_Object overlay;
1659 {
1660 CHECK_OVERLAY (overlay, 0);
1661
1662 return (Fmarker_position (OVERLAY_END (overlay)));
1663 }
1664
1665 DEFUN ("overlay-buffer", Foverlay_buffer, Soverlay_buffer, 1, 1, 0,
1666 "Return the buffer OVERLAY belongs to.")
1667 (overlay)
1668 Lisp_Object overlay;
1669 {
1670 CHECK_OVERLAY (overlay, 0);
1671
1672 return Fmarker_buffer (OVERLAY_START (overlay));
1673 }
1674
1675 DEFUN ("overlay-properties", Foverlay_properties, Soverlay_properties, 1, 1, 0,
1676 "Return a list of the properties on OVERLAY.\n\
1677 This is a copy of OVERLAY's plist; modifying its conses has no effect on\n\
1678 OVERLAY.")
1679 (overlay)
1680 Lisp_Object overlay;
1681 {
1682 CHECK_OVERLAY (overlay, 0);
1683
1684 return Fcopy_sequence (Fcdr_safe (XCONS (overlay)->cdr));
1685 }
1686
1687 \f
1688 DEFUN ("overlays-at", Foverlays_at, Soverlays_at, 1, 1, 0,
1689 "Return a list of the overays that contain position POS.")
1690 (pos)
1691 Lisp_Object pos;
1692 {
1693 int noverlays;
1694 int endpos;
1695 Lisp_Object *overlay_vec;
1696 int len;
1697 Lisp_Object result;
1698
1699 CHECK_NUMBER_COERCE_MARKER (pos, 0);
1700
1701 len = 10;
1702 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
1703
1704 /* Put all the overlays we want in a vector in overlay_vec.
1705 Store the length in len. */
1706 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len, &endpos);
1707
1708 /* Make a list of them all. */
1709 result = Flist (noverlays, overlay_vec);
1710
1711 xfree (overlay_vec);
1712 return result;
1713 }
1714
1715 DEFUN ("next-overlay-change", Fnext_overlay_change, Snext_overlay_change,
1716 1, 1, 0,
1717 "Return the next position after POS where an overlay starts or ends.")
1718 (pos)
1719 Lisp_Object pos;
1720 {
1721 int noverlays;
1722 int endpos;
1723 Lisp_Object *overlay_vec;
1724 int len;
1725 Lisp_Object result;
1726 int i;
1727
1728 CHECK_NUMBER_COERCE_MARKER (pos, 0);
1729
1730 len = 10;
1731 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
1732
1733 /* Put all the overlays we want in a vector in overlay_vec.
1734 Store the length in len.
1735 endpos gets the position where the next overlay starts. */
1736 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len, &endpos);
1737
1738 /* If any of these overlays ends before endpos,
1739 use its ending point instead. */
1740 for (i = 0; i < noverlays; i++)
1741 {
1742 Lisp_Object oend;
1743 int oendpos;
1744
1745 oend = OVERLAY_END (overlay_vec[i]);
1746 oendpos = OVERLAY_POSITION (oend);
1747 if (oendpos < endpos)
1748 endpos = oendpos;
1749 }
1750
1751 xfree (overlay_vec);
1752 return make_number (endpos);
1753 }
1754 \f
1755 /* These functions are for debugging overlays. */
1756
1757 DEFUN ("overlay-lists", Foverlay_lists, Soverlay_lists, 0, 0, 0,
1758 "Return a pair of lists giving all the overlays of the current buffer.\n\
1759 The car has all the overlays before the overlay center;\n\
1760 the cdr has all the overlays before the overlay center.\n\
1761 Recentering overlays moves overlays between these lists.\n\
1762 The lists you get are copies, so that changing them has no effect.\n\
1763 However, the overlays you get are the real objects that the buffer uses.")
1764 ()
1765 {
1766 Lisp_Object before, after;
1767 before = current_buffer->overlays_before;
1768 if (CONSP (before))
1769 before = Fcopy_sequence (before);
1770 after = current_buffer->overlays_after;
1771 if (CONSP (after))
1772 after = Fcopy_sequence (after);
1773
1774 return Fcons (before, after);
1775 }
1776
1777 DEFUN ("overlay-recenter", Foverlay_recenter, Soverlay_recenter, 1, 1, 0,
1778 "Recenter the overlays of the current buffer around position POS.")
1779 (pos)
1780 Lisp_Object pos;
1781 {
1782 CHECK_NUMBER_COERCE_MARKER (pos, 0);
1783
1784 recenter_overlay_lists (current_buffer, XINT (pos));
1785 return Qnil;
1786 }
1787 \f
1788 DEFUN ("overlay-get", Foverlay_get, Soverlay_get, 2, 2, 0,
1789 "Get the property of overlay OVERLAY with property name NAME.")
1790 (overlay, prop)
1791 Lisp_Object overlay, prop;
1792 {
1793 Lisp_Object plist;
1794
1795 CHECK_OVERLAY (overlay, 0);
1796
1797 for (plist = Fcdr_safe (XCONS (overlay)->cdr);
1798 CONSP (plist) && CONSP (XCONS (plist)->cdr);
1799 plist = XCONS (XCONS (plist)->cdr)->cdr)
1800 {
1801 if (EQ (XCONS (plist)->car, prop))
1802 return XCONS (XCONS (plist)->cdr)->car;
1803 }
1804
1805 return Qnil;
1806 }
1807
1808 DEFUN ("overlay-put", Foverlay_put, Soverlay_put, 3, 3, 0,
1809 "Set one property of overlay OVERLAY: give property PROP value VALUE.")
1810 (overlay, prop, value)
1811 Lisp_Object overlay, prop, value;
1812 {
1813 Lisp_Object plist, tail;
1814
1815 CHECK_OVERLAY (overlay, 0);
1816
1817 redisplay_region (XMARKER (OVERLAY_START (overlay))->buffer,
1818 OVERLAY_POSITION (OVERLAY_START (overlay)),
1819 OVERLAY_POSITION (OVERLAY_END (overlay)));
1820
1821 plist = Fcdr_safe (XCONS (overlay)->cdr);
1822
1823 for (tail = plist;
1824 CONSP (tail) && CONSP (XCONS (tail)->cdr);
1825 tail = XCONS (XCONS (tail)->cdr)->cdr)
1826 {
1827 if (EQ (XCONS (tail)->car, prop))
1828 return XCONS (XCONS (tail)->cdr)->car = value;
1829 }
1830
1831 if (! CONSP (XCONS (overlay)->cdr))
1832 XCONS (overlay)->cdr = Fcons (Qnil, Qnil);
1833
1834 XCONS (XCONS (overlay)->cdr)->cdr
1835 = Fcons (prop, Fcons (value, plist));
1836
1837 return value;
1838 }
1839 \f
1840 /* Somebody has tried to store NEWVAL into the buffer-local slot with
1841 offset XUINT (valcontents), and NEWVAL has an unacceptable type. */
1842 void
1843 buffer_slot_type_mismatch (valcontents, newval)
1844 Lisp_Object valcontents, newval;
1845 {
1846 unsigned int offset = XUINT (valcontents);
1847 unsigned char *symbol_name =
1848 (XSYMBOL (*(Lisp_Object *)(offset + (char *)&buffer_local_symbols))
1849 ->name->data);
1850 char *type_name;
1851
1852 switch (XINT (*(Lisp_Object *)(offset + (char *)&buffer_local_types)))
1853 {
1854 case Lisp_Int: type_name = "integers"; break;
1855 case Lisp_String: type_name = "strings"; break;
1856 case Lisp_Marker: type_name = "markers"; break;
1857 case Lisp_Symbol: type_name = "symbols"; break;
1858 case Lisp_Cons: type_name = "lists"; break;
1859 case Lisp_Vector: type_name = "vectors"; break;
1860 default:
1861 abort ();
1862 }
1863
1864 error ("only %s should be stored in the buffer-local variable %s",
1865 type_name, symbol_name);
1866 }
1867 \f
1868 init_buffer_once ()
1869 {
1870 register Lisp_Object tem;
1871
1872 /* Make sure all markable slots in buffer_defaults
1873 are initialized reasonably, so mark_buffer won't choke. */
1874 reset_buffer (&buffer_defaults);
1875 reset_buffer (&buffer_local_symbols);
1876 XSET (Vbuffer_defaults, Lisp_Buffer, &buffer_defaults);
1877 XSET (Vbuffer_local_symbols, Lisp_Buffer, &buffer_local_symbols);
1878
1879 /* Set up the default values of various buffer slots. */
1880 /* Must do these before making the first buffer! */
1881
1882 /* real setup is done in loaddefs.el */
1883 buffer_defaults.mode_line_format = build_string ("%-");
1884 buffer_defaults.abbrev_mode = Qnil;
1885 buffer_defaults.overwrite_mode = Qnil;
1886 buffer_defaults.case_fold_search = Qt;
1887 buffer_defaults.auto_fill_function = Qnil;
1888 buffer_defaults.selective_display = Qnil;
1889 #ifndef old
1890 buffer_defaults.selective_display_ellipses = Qt;
1891 #endif
1892 buffer_defaults.abbrev_table = Qnil;
1893 buffer_defaults.display_table = Qnil;
1894 buffer_defaults.undo_list = Qnil;
1895 buffer_defaults.mark_active = Qnil;
1896 buffer_defaults.overlays_before = Qnil;
1897 buffer_defaults.overlays_after = Qnil;
1898 XFASTINT (buffer_defaults.overlay_center) = 1;
1899
1900 XFASTINT (buffer_defaults.tab_width) = 8;
1901 buffer_defaults.truncate_lines = Qnil;
1902 buffer_defaults.ctl_arrow = Qt;
1903
1904 XFASTINT (buffer_defaults.fill_column) = 70;
1905 XFASTINT (buffer_defaults.left_margin) = 0;
1906
1907 /* Assign the local-flags to the slots that have default values.
1908 The local flag is a bit that is used in the buffer
1909 to say that it has its own local value for the slot.
1910 The local flag bits are in the local_var_flags slot of the buffer. */
1911
1912 /* Nothing can work if this isn't true */
1913 if (sizeof (int) != sizeof (Lisp_Object)) abort ();
1914
1915 /* 0 means not a lisp var, -1 means always local, else mask */
1916 bzero (&buffer_local_flags, sizeof buffer_local_flags);
1917 XFASTINT (buffer_local_flags.filename) = -1;
1918 XFASTINT (buffer_local_flags.directory) = -1;
1919 XFASTINT (buffer_local_flags.backed_up) = -1;
1920 XFASTINT (buffer_local_flags.save_length) = -1;
1921 XFASTINT (buffer_local_flags.auto_save_file_name) = -1;
1922 XFASTINT (buffer_local_flags.read_only) = -1;
1923 XFASTINT (buffer_local_flags.major_mode) = -1;
1924 XFASTINT (buffer_local_flags.mode_name) = -1;
1925 XFASTINT (buffer_local_flags.undo_list) = -1;
1926 XFASTINT (buffer_local_flags.mark_active) = -1;
1927
1928 XFASTINT (buffer_local_flags.mode_line_format) = 1;
1929 XFASTINT (buffer_local_flags.abbrev_mode) = 2;
1930 XFASTINT (buffer_local_flags.overwrite_mode) = 4;
1931 XFASTINT (buffer_local_flags.case_fold_search) = 8;
1932 XFASTINT (buffer_local_flags.auto_fill_function) = 0x10;
1933 XFASTINT (buffer_local_flags.selective_display) = 0x20;
1934 #ifndef old
1935 XFASTINT (buffer_local_flags.selective_display_ellipses) = 0x40;
1936 #endif
1937 XFASTINT (buffer_local_flags.tab_width) = 0x80;
1938 XFASTINT (buffer_local_flags.truncate_lines) = 0x100;
1939 XFASTINT (buffer_local_flags.ctl_arrow) = 0x200;
1940 XFASTINT (buffer_local_flags.fill_column) = 0x400;
1941 XFASTINT (buffer_local_flags.left_margin) = 0x800;
1942 XFASTINT (buffer_local_flags.abbrev_table) = 0x1000;
1943 XFASTINT (buffer_local_flags.display_table) = 0x2000;
1944 XFASTINT (buffer_local_flags.syntax_table) = 0x8000;
1945
1946 Vbuffer_alist = Qnil;
1947 current_buffer = 0;
1948 all_buffers = 0;
1949
1950 QSFundamental = build_string ("Fundamental");
1951
1952 Qfundamental_mode = intern ("fundamental-mode");
1953 buffer_defaults.major_mode = Qfundamental_mode;
1954
1955 Qmode_class = intern ("mode-class");
1956
1957 Qprotected_field = intern ("protected-field");
1958
1959 Qpermanent_local = intern ("permanent-local");
1960
1961 Qkill_buffer_hook = intern ("kill-buffer-hook");
1962
1963 Vprin1_to_string_buffer = Fget_buffer_create (build_string (" prin1"));
1964 /* super-magic invisible buffer */
1965 Vbuffer_alist = Qnil;
1966
1967 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
1968 }
1969
1970 init_buffer ()
1971 {
1972 char buf[MAXPATHLEN+1];
1973 char *pwd;
1974 struct stat dotstat, pwdstat;
1975 Lisp_Object temp;
1976
1977 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
1978
1979 /* If PWD is accurate, use it instead of calling getwd. This is faster
1980 when PWD is right, and may avoid a fatal error. */
1981 if ((pwd = getenv ("PWD")) != 0 && *pwd == '/'
1982 && stat (pwd, &pwdstat) == 0
1983 && stat (".", &dotstat) == 0
1984 && dotstat.st_ino == pwdstat.st_ino
1985 && dotstat.st_dev == pwdstat.st_dev
1986 && strlen (pwd) < MAXPATHLEN)
1987 strcpy (buf, pwd);
1988 else if (getwd (buf) == 0)
1989 fatal ("`getwd' failed: %s.\n", buf);
1990
1991 #ifndef VMS
1992 /* Maybe this should really use some standard subroutine
1993 whose definition is filename syntax dependent. */
1994 if (buf[strlen (buf) - 1] != '/')
1995 strcat (buf, "/");
1996 #endif /* not VMS */
1997 current_buffer->directory = build_string (buf);
1998
1999 temp = get_minibuffer (0);
2000 XBUFFER (temp)->directory = current_buffer->directory;
2001 }
2002
2003 /* initialize the buffer routines */
2004 syms_of_buffer ()
2005 {
2006 extern Lisp_Object Qdisabled;
2007
2008 staticpro (&Vbuffer_defaults);
2009 staticpro (&Vbuffer_local_symbols);
2010 staticpro (&Qfundamental_mode);
2011 staticpro (&Qmode_class);
2012 staticpro (&QSFundamental);
2013 staticpro (&Vbuffer_alist);
2014 staticpro (&Qprotected_field);
2015 staticpro (&Qpermanent_local);
2016 staticpro (&Qkill_buffer_hook);
2017 staticpro (&Qoverlayp);
2018
2019 Qoverlayp = intern ("overlayp");
2020
2021 Fput (Qprotected_field, Qerror_conditions,
2022 Fcons (Qprotected_field, Fcons (Qerror, Qnil)));
2023 Fput (Qprotected_field, Qerror_message,
2024 build_string ("Attempt to modify a protected field"));
2025
2026 Fput (intern ("erase-buffer"), Qdisabled, Qt);
2027
2028 /* All these use DEFVAR_LISP_NOPRO because the slots in
2029 buffer_defaults will all be marked via Vbuffer_defaults. */
2030
2031 DEFVAR_LISP_NOPRO ("default-mode-line-format",
2032 &buffer_defaults.mode_line_format,
2033 "Default value of `mode-line-format' for buffers that don't override it.\n\
2034 This is the same as (default-value 'mode-line-format).");
2035
2036 DEFVAR_LISP_NOPRO ("default-abbrev-mode",
2037 &buffer_defaults.abbrev_mode,
2038 "Default value of `abbrev-mode' for buffers that do not override it.\n\
2039 This is the same as (default-value 'abbrev-mode).");
2040
2041 DEFVAR_LISP_NOPRO ("default-ctl-arrow",
2042 &buffer_defaults.ctl_arrow,
2043 "Default value of `ctl-arrow' for buffers that do not override it.\n\
2044 This is the same as (default-value 'ctl-arrow).");
2045
2046 DEFVAR_LISP_NOPRO ("default-truncate-lines",
2047 &buffer_defaults.truncate_lines,
2048 "Default value of `truncate-lines' for buffers that do not override it.\n\
2049 This is the same as (default-value 'truncate-lines).");
2050
2051 DEFVAR_LISP_NOPRO ("default-fill-column",
2052 &buffer_defaults.fill_column,
2053 "Default value of `fill-column' for buffers that do not override it.\n\
2054 This is the same as (default-value 'fill-column).");
2055
2056 DEFVAR_LISP_NOPRO ("default-left-margin",
2057 &buffer_defaults.left_margin,
2058 "Default value of `left-margin' for buffers that do not override it.\n\
2059 This is the same as (default-value 'left-margin).");
2060
2061 DEFVAR_LISP_NOPRO ("default-tab-width",
2062 &buffer_defaults.tab_width,
2063 "Default value of `tab-width' for buffers that do not override it.\n\
2064 This is the same as (default-value 'tab-width).");
2065
2066 DEFVAR_LISP_NOPRO ("default-case-fold-search",
2067 &buffer_defaults.case_fold_search,
2068 "Default value of `case-fold-search' for buffers that don't override it.\n\
2069 This is the same as (default-value 'case-fold-search).");
2070
2071 DEFVAR_PER_BUFFER ("mode-line-format", &current_buffer->mode_line_format,
2072 Qnil, 0);
2073
2074 /* This doc string is too long for cpp; cpp dies if it isn't in a comment.
2075 But make-docfile finds it!
2076 DEFVAR_PER_BUFFER ("mode-line-format", &current_buffer->mode_line_format,
2077 Qnil,
2078 "Template for displaying mode line for current buffer.\n\
2079 Each buffer has its own value of this variable.\n\
2080 Value may be a string, a symbol or a list or cons cell.\n\
2081 For a symbol, its value is used (but it is ignored if t or nil).\n\
2082 A string appearing directly as the value of a symbol is processed verbatim\n\
2083 in that the %-constructs below are not recognized.\n\
2084 For a list whose car is a symbol, the symbol's value is taken,\n\
2085 and if that is non-nil, the cadr of the list is processed recursively.\n\
2086 Otherwise, the caddr of the list (if there is one) is processed.\n\
2087 For a list whose car is a string or list, each element is processed\n\
2088 recursively and the results are effectively concatenated.\n\
2089 For a list whose car is an integer, the cdr of the list is processed\n\
2090 and padded (if the number is positive) or truncated (if negative)\n\
2091 to the width specified by that number.\n\
2092 A string is printed verbatim in the mode line except for %-constructs:\n\
2093 (%-constructs are allowed when the string is the entire mode-line-format\n\
2094 or when it is found in a cons-cell or a list)\n\
2095 %b -- print buffer name. %f -- print visited file name.\n\
2096 %* -- print *, % or hyphen. %m -- print value of mode-name (obsolete).\n\
2097 %s -- print process status. %l -- print the current line number.\n\
2098 %p -- print percent of buffer above top of window, or top, bot or all.\n\
2099 %n -- print Narrow if appropriate.\n\
2100 %[ -- print one [ for each recursive editing level. %] similar.\n\
2101 %% -- print %. %- -- print infinitely many dashes.\n\
2102 Decimal digits after the % specify field width to which to pad.");
2103 */
2104
2105 DEFVAR_LISP_NOPRO ("default-major-mode", &buffer_defaults.major_mode,
2106 "*Major mode for new buffers. Defaults to `fundamental-mode'.\n\
2107 nil here means use current buffer's major mode.");
2108
2109 DEFVAR_PER_BUFFER ("major-mode", &current_buffer->major_mode,
2110 make_number (Lisp_Symbol),
2111 "Symbol for current buffer's major mode.");
2112
2113 DEFVAR_PER_BUFFER ("mode-name", &current_buffer->mode_name,
2114 make_number (Lisp_String),
2115 "Pretty name of current buffer's major mode (a string).");
2116
2117 DEFVAR_PER_BUFFER ("abbrev-mode", &current_buffer->abbrev_mode, Qnil,
2118 "Non-nil turns on automatic expansion of abbrevs as they are inserted.\n\
2119 Automatically becomes buffer-local when set in any fashion.");
2120
2121 DEFVAR_PER_BUFFER ("case-fold-search", &current_buffer->case_fold_search,
2122 Qnil,
2123 "*Non-nil if searches should ignore case.\n\
2124 Automatically becomes buffer-local when set in any fashion.");
2125
2126 DEFVAR_PER_BUFFER ("fill-column", &current_buffer->fill_column,
2127 make_number (Lisp_Int),
2128 "*Column beyond which automatic line-wrapping should happen.\n\
2129 Automatically becomes buffer-local when set in any fashion.");
2130
2131 DEFVAR_PER_BUFFER ("left-margin", &current_buffer->left_margin,
2132 make_number (Lisp_Int),
2133 "*Column for the default indent-line-function to indent to.\n\
2134 Linefeed indents to this column in Fundamental mode.\n\
2135 Automatically becomes buffer-local when set in any fashion.");
2136
2137 DEFVAR_PER_BUFFER ("tab-width", &current_buffer->tab_width,
2138 make_number (Lisp_Int),
2139 "*Distance between tab stops (for display of tab characters), in columns.\n\
2140 Automatically becomes buffer-local when set in any fashion.");
2141
2142 DEFVAR_PER_BUFFER ("ctl-arrow", &current_buffer->ctl_arrow, Qnil,
2143 "*Non-nil means display control chars with uparrow.\n\
2144 Nil means use backslash and octal digits.\n\
2145 Automatically becomes buffer-local when set in any fashion.\n\
2146 This variable does not apply to characters whose display is specified\n\
2147 in the current display table (if there is one).");
2148
2149 DEFVAR_PER_BUFFER ("truncate-lines", &current_buffer->truncate_lines, Qnil,
2150 "*Non-nil means do not display continuation lines;\n\
2151 give each line of text one screen line.\n\
2152 Automatically becomes buffer-local when set in any fashion.\n\
2153 \n\
2154 Note that this is overridden by the variable\n\
2155 `truncate-partial-width-windows' if that variable is non-nil\n\
2156 and this buffer is not full-frame width.");
2157
2158 DEFVAR_PER_BUFFER ("default-directory", &current_buffer->directory,
2159 make_number (Lisp_String),
2160 "Name of default directory of current buffer. Should end with slash.\n\
2161 Each buffer has its own value of this variable.");
2162
2163 DEFVAR_PER_BUFFER ("auto-fill-function", &current_buffer->auto_fill_function,
2164 Qnil,
2165 "Function called (if non-nil) to perform auto-fill.\n\
2166 It is called after self-inserting a space at a column beyond `fill-column'.\n\
2167 Each buffer has its own value of this variable.\n\
2168 NOTE: This variable is not an ordinary hook;\n\
2169 It may not be a list of functions.");
2170
2171 DEFVAR_PER_BUFFER ("buffer-file-name", &current_buffer->filename,
2172 make_number (Lisp_String),
2173 "Name of file visited in current buffer, or nil if not visiting a file.\n\
2174 Each buffer has its own value of this variable.");
2175
2176 DEFVAR_PER_BUFFER ("buffer-auto-save-file-name",
2177 &current_buffer->auto_save_file_name,
2178 make_number (Lisp_String),
2179 "Name of file for auto-saving current buffer,\n\
2180 or nil if buffer should not be auto-saved.\n\
2181 Each buffer has its own value of this variable.");
2182
2183 DEFVAR_PER_BUFFER ("buffer-read-only", &current_buffer->read_only, Qnil,
2184 "Non-nil if this buffer is read-only.\n\
2185 Each buffer has its own value of this variable.");
2186
2187 DEFVAR_PER_BUFFER ("buffer-backed-up", &current_buffer->backed_up, Qnil,
2188 "Non-nil if this buffer's file has been backed up.\n\
2189 Backing up is done before the first time the file is saved.\n\
2190 Each buffer has its own value of this variable.");
2191
2192 DEFVAR_PER_BUFFER ("buffer-saved-size", &current_buffer->save_length,
2193 make_number (Lisp_Int),
2194 "Length of current buffer when last read in, saved or auto-saved.\n\
2195 0 initially.\n\
2196 Each buffer has its own value of this variable.");
2197
2198 DEFVAR_PER_BUFFER ("selective-display", &current_buffer->selective_display,
2199 Qnil,
2200 "Non-nil enables selective display:\n\
2201 Integer N as value means display only lines\n\
2202 that start with less than n columns of space.\n\
2203 A value of t means, after a ^M, all the rest of the line is invisible.\n\
2204 Then ^M's in the file are written into files as newlines.\n\n\
2205 Automatically becomes buffer-local when set in any fashion.");
2206
2207 #ifndef old
2208 DEFVAR_PER_BUFFER ("selective-display-ellipses",
2209 &current_buffer->selective_display_ellipses,
2210 Qnil,
2211 "t means display ... on previous line when a line is invisible.\n\
2212 Automatically becomes buffer-local when set in any fashion.");
2213 #endif
2214
2215 DEFVAR_PER_BUFFER ("overwrite-mode", &current_buffer->overwrite_mode, Qnil,
2216 "Non-nil if self-insertion should replace existing text.\n\
2217 If non-nil and not `overwrite-mode-binary', self-insertion still\n\
2218 inserts at the end of a line, and inserts when point is before a tab,\n\
2219 until the tab is filled in.\n\
2220 If `overwrite-mode-binary', self-insertion replaces newlines and tabs too.\n\
2221 Automatically becomes buffer-local when set in any fashion.");
2222
2223 DEFVAR_PER_BUFFER ("buffer-display-table", &current_buffer->display_table,
2224 Qnil,
2225 "Display table that controls display of the contents of current buffer.\n\
2226 Automatically becomes buffer-local when set in any fashion.\n\
2227 The display table is a vector created with `make-display-table'.\n\
2228 The first 256 elements control how to display each possible text character.\n\
2229 Each value should be a vector of characters or nil;\n\
2230 nil means display the character in the default fashion.\n\
2231 The remaining five elements control the display of\n\
2232 the end of a truncated screen line (element 256, a single character);\n\
2233 the end of a continued line (element 257, a single character);\n\
2234 the escape character used to display character codes in octal\n\
2235 (element 258, a single character);\n\
2236 the character used as an arrow for control characters (element 259,\n\
2237 a single character);\n\
2238 the decoration indicating the presence of invisible lines (element 260,\n\
2239 a vector of characters).\n\
2240 If this variable is nil, the value of `standard-display-table' is used.\n\
2241 Each window can have its own, overriding display table.");
2242
2243 /*DEFVAR_LISP ("debug-check-symbol", &Vcheck_symbol,
2244 "Don't ask.");
2245 */
2246 DEFVAR_LISP ("before-change-function", &Vbefore_change_function,
2247 "Function to call before each text change.\n\
2248 Two arguments are passed to the function: the positions of\n\
2249 the beginning and end of the range of old text to be changed.\n\
2250 \(For an insertion, the beginning and end are at the same place.)\n\
2251 No information is given about the length of the text after the change.\n\
2252 position of the change\n\
2253 \n\
2254 While executing the `before-change-function', changes to buffers do not\n\
2255 cause calls to any `before-change-function' or `after-change-function'.");
2256 Vbefore_change_function = Qnil;
2257
2258 DEFVAR_LISP ("after-change-function", &Vafter_change_function,
2259 "Function to call after each text change.\n\
2260 Three arguments are passed to the function: the positions of\n\
2261 the beginning and end of the range of changed text,\n\
2262 and the length of the pre-change text replaced by that range.\n\
2263 \(For an insertion, the pre-change length is zero;\n\
2264 for a deletion, that length is the number of characters deleted,\n\
2265 and the post-change beginning and end are at the same place.)\n\
2266 \n\
2267 While executing the `after-change-function', changes to buffers do not\n\
2268 cause calls to any `before-change-function' or `after-change-function'.");
2269 Vafter_change_function = Qnil;
2270
2271 DEFVAR_LISP ("first-change-hook", &Vfirst_change_hook,
2272 "A list of functions to call before changing a buffer which is unmodified.\n\
2273 The functions are run using the `run-hooks' function.");
2274 Vfirst_change_hook = Qnil;
2275 Qfirst_change_hook = intern ("first-change-hook");
2276 staticpro (&Qfirst_change_hook);
2277
2278 DEFVAR_PER_BUFFER ("buffer-undo-list", &current_buffer->undo_list, Qnil,
2279 "List of undo entries in current buffer.\n\
2280 Recent changes come first; older changes follow newer.\n\
2281 \n\
2282 An entry (START . END) represents an insertion which begins at\n\
2283 position START and ends at position END.\n\
2284 \n\
2285 An entry (TEXT . POSITION) represents the deletion of the string TEXT\n\
2286 from (abs POSITION). If POSITION is positive, point was at the front\n\
2287 of the text being deleted; if negative, point was at the end.\n\
2288 \n\
2289 An entry (t HIGHWORD LOWWORD) indicates that the buffer had been\n\
2290 previously unmodified. HIGHWORD and LOWWORD are the high and low\n\
2291 16-bit words of the buffer's modification count at the time. If the\n\
2292 modification count of the most recent save is different, this entry is\n\
2293 obsolete.\n\
2294 \n\
2295 An entry (nil PROP VAL BEG . END) indicates that a text property\n\
2296 was modified between BEG and END. PROP is the property name,\n\
2297 and VAL is the old value.\n\
2298 \n\
2299 An entry of the form POSITION indicates that point was at the buffer\n\
2300 location given by the integer. Undoing an entry of this form places\n\
2301 point at POSITION.\n\
2302 \n\
2303 nil marks undo boundaries. The undo command treats the changes\n\
2304 between two undo boundaries as a single step to be undone.\n\
2305 \n\
2306 If the value of the variable is t, undo information is not recorded.");
2307
2308 DEFVAR_PER_BUFFER ("mark-active", &current_buffer->mark_active, Qnil,
2309 "Non-nil means the mark and region are currently active in this buffer.\n\
2310 Automatically local in all buffers.");
2311
2312 DEFVAR_LISP ("transient-mark-mode", &Vtransient_mark_mode,
2313 "*Non-nil means deactivate the mark when the buffer contents change.");
2314 Vtransient_mark_mode = Qnil;
2315
2316 defsubr (&Sbuffer_list);
2317 defsubr (&Sget_buffer);
2318 defsubr (&Sget_file_buffer);
2319 defsubr (&Sget_buffer_create);
2320 defsubr (&Sgenerate_new_buffer_name);
2321 defsubr (&Sbuffer_name);
2322 /*defsubr (&Sbuffer_number);*/
2323 defsubr (&Sbuffer_file_name);
2324 defsubr (&Sbuffer_local_variables);
2325 defsubr (&Sbuffer_modified_p);
2326 defsubr (&Sset_buffer_modified_p);
2327 defsubr (&Sbuffer_modified_tick);
2328 defsubr (&Srename_buffer);
2329 defsubr (&Sother_buffer);
2330 defsubr (&Sbuffer_disable_undo);
2331 defsubr (&Sbuffer_enable_undo);
2332 defsubr (&Skill_buffer);
2333 defsubr (&Serase_buffer);
2334 defsubr (&Sswitch_to_buffer);
2335 defsubr (&Spop_to_buffer);
2336 defsubr (&Scurrent_buffer);
2337 defsubr (&Sset_buffer);
2338 defsubr (&Sbarf_if_buffer_read_only);
2339 defsubr (&Sbury_buffer);
2340 defsubr (&Slist_buffers);
2341 defsubr (&Skill_all_local_variables);
2342
2343 defsubr (&Soverlayp);
2344 defsubr (&Smake_overlay);
2345 defsubr (&Sdelete_overlay);
2346 defsubr (&Smove_overlay);
2347 defsubr (&Soverlay_start);
2348 defsubr (&Soverlay_end);
2349 defsubr (&Soverlay_buffer);
2350 defsubr (&Soverlay_properties);
2351 defsubr (&Soverlays_at);
2352 defsubr (&Snext_overlay_change);
2353 defsubr (&Soverlay_recenter);
2354 defsubr (&Soverlay_lists);
2355 defsubr (&Soverlay_get);
2356 defsubr (&Soverlay_put);
2357 }
2358
2359 keys_of_buffer ()
2360 {
2361 initial_define_key (control_x_map, 'b', "switch-to-buffer");
2362 initial_define_key (control_x_map, 'k', "kill-buffer");
2363 initial_define_key (control_x_map, Ctl ('B'), "list-buffers");
2364 }