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