]> code.delx.au - gnu-emacs/blob - src/buffer.c
*** empty log message ***
[gnu-emacs] / src / buffer.c
1 /* Buffer manipulation primitives for GNU Emacs.
2 Copyright (C) 1985,86,87,88,89,93,94,95,97,98, 1999
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, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
21
22 #include <config.h>
23
24 #include <sys/types.h>
25 #include <sys/stat.h>
26 #include <sys/param.h>
27 #include <errno.h>
28
29 extern int errno;
30
31 #ifndef MAXPATHLEN
32 /* in 4.1, param.h fails to define this. */
33 #define MAXPATHLEN 1024
34 #endif /* not MAXPATHLEN */
35
36 #ifdef HAVE_UNISTD_H
37 #include <unistd.h>
38 #endif
39 #include "lisp.h"
40 #include "intervals.h"
41 #include "window.h"
42 #include "commands.h"
43 #include "buffer.h"
44 #include "charset.h"
45 #include "region-cache.h"
46 #include "indent.h"
47 #include "blockinput.h"
48 #include "frame.h"
49
50 struct buffer *current_buffer; /* the current buffer */
51
52 /* First buffer in chain of all buffers (in reverse order of creation).
53 Threaded through ->next. */
54
55 struct buffer *all_buffers;
56
57 /* This structure holds the default values of the buffer-local variables
58 defined with DEFVAR_PER_BUFFER, that have special slots in each buffer.
59 The default value occupies the same slot in this structure
60 as an individual buffer's value occupies in that buffer.
61 Setting the default value also goes through the alist of buffers
62 and stores into each buffer that does not say it has a local value. */
63
64 struct buffer buffer_defaults;
65
66 /* A Lisp_Object pointer to the above, used for staticpro */
67
68 static Lisp_Object Vbuffer_defaults;
69
70 /* This structure marks which slots in a buffer have corresponding
71 default values in buffer_defaults.
72 Each such slot has a nonzero value in this structure.
73 The value has only one nonzero bit.
74
75 When a buffer has its own local value for a slot,
76 the bit for that slot (found in the same slot in this structure)
77 is turned on in the buffer's local_var_flags slot.
78
79 If a slot in this structure is -1, then even though there may
80 be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
81 and the corresponding slot in buffer_defaults is not used.
82
83 If a slot is -2, then there is no DEFVAR_PER_BUFFER for it,
84 but there is a default value which is copied into each buffer.
85
86 If a slot in this structure is negative, then even though there may
87 be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
88 and the corresponding slot in buffer_defaults is not used.
89
90 If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is
91 zero, that is a bug */
92
93 struct buffer buffer_local_flags;
94
95 /* This structure holds the names of symbols whose values may be
96 buffer-local. It is indexed and accessed in the same way as the above. */
97
98 struct buffer buffer_local_symbols;
99 /* A Lisp_Object pointer to the above, used for staticpro */
100 static Lisp_Object Vbuffer_local_symbols;
101
102 /* This structure holds the required types for the values in the
103 buffer-local slots. If a slot contains Qnil, then the
104 corresponding buffer slot may contain a value of any type. If a
105 slot contains an integer, then prospective values' tags must be
106 equal to that integer (except nil is always allowed).
107 When a tag does not match, the function
108 buffer_slot_type_mismatch will signal an error.
109
110 If a slot here contains -1, the corresponding variable is read-only. */
111 struct buffer buffer_local_types;
112
113 /* Flags indicating which built-in buffer-local variables
114 are permanent locals. */
115 static int buffer_permanent_local_flags;
116
117 Lisp_Object Fset_buffer ();
118 void set_buffer_internal ();
119 void set_buffer_internal_1 ();
120 static void call_overlay_mod_hooks ();
121 static void swap_out_buffer_local_variables ();
122 static void reset_buffer_local_variables ();
123
124 /* Alist of all buffer names vs the buffers. */
125 /* This used to be a variable, but is no longer,
126 to prevent lossage due to user rplac'ing this alist or its elements. */
127 Lisp_Object Vbuffer_alist;
128
129 /* Functions to call before and after each text change. */
130 Lisp_Object Vbefore_change_function;
131 Lisp_Object Vafter_change_function;
132 Lisp_Object Vbefore_change_functions;
133 Lisp_Object Vafter_change_functions;
134
135 Lisp_Object Vtransient_mark_mode;
136
137 /* t means ignore all read-only text properties.
138 A list means ignore such a property if its value is a member of the list.
139 Any non-nil value means ignore buffer-read-only. */
140 Lisp_Object Vinhibit_read_only;
141
142 /* List of functions to call that can query about killing a buffer.
143 If any of these functions returns nil, we don't kill it. */
144 Lisp_Object Vkill_buffer_query_functions;
145
146 /* List of functions to call before changing an unmodified buffer. */
147 Lisp_Object Vfirst_change_hook;
148
149 Lisp_Object Qfirst_change_hook;
150 Lisp_Object Qbefore_change_functions;
151 Lisp_Object Qafter_change_functions;
152
153 /* If nonzero, all modification hooks are suppressed. */
154 int inhibit_modification_hooks;
155
156 Lisp_Object Qfundamental_mode, Qmode_class, Qpermanent_local;
157
158 Lisp_Object Qprotected_field;
159
160 Lisp_Object QSFundamental; /* A string "Fundamental" */
161
162 Lisp_Object Qkill_buffer_hook;
163
164 Lisp_Object Qget_file_buffer;
165
166 Lisp_Object Qoverlayp;
167
168 Lisp_Object Qpriority, Qwindow, Qevaporate, Qbefore_string, Qafter_string;
169
170 Lisp_Object Qmodification_hooks;
171 Lisp_Object Qinsert_in_front_hooks;
172 Lisp_Object Qinsert_behind_hooks;
173
174 /* For debugging; temporary. See set_buffer_internal. */
175 /* Lisp_Object Qlisp_mode, Vcheck_symbol; */
176
177 void
178 nsberror (spec)
179 Lisp_Object spec;
180 {
181 if (STRINGP (spec))
182 error ("No buffer named %s", XSTRING (spec)->data);
183 error ("Invalid buffer argument");
184 }
185 \f
186 DEFUN ("buffer-live-p", Fbuffer_live_p, Sbuffer_live_p, 1, 1, 0,
187 "Return non-nil if OBJECT is a buffer which has not been killed.\n\
188 Value is nil if OBJECT is not a buffer or if it has been killed.")
189 (object)
190 Lisp_Object object;
191 {
192 return ((BUFFERP (object) && ! NILP (XBUFFER (object)->name))
193 ? Qt : Qnil);
194 }
195
196 DEFUN ("buffer-list", Fbuffer_list, Sbuffer_list, 0, 1, 0,
197 "Return a list of all existing live buffers.\n\
198 If the optional arg FRAME is a frame, we return that frame's buffer list.")
199 (frame)
200 Lisp_Object frame;
201 {
202 Lisp_Object framelist, general;
203 general = Fmapcar (Qcdr, Vbuffer_alist);
204
205 if (FRAMEP (frame))
206 {
207 Lisp_Object tail;
208
209 CHECK_FRAME (frame, 1);
210
211 framelist = Fcopy_sequence (XFRAME (frame)->buffer_list);
212
213 /* Remove from GENERAL any buffer that duplicates one in FRAMELIST. */
214 tail = framelist;
215 while (! NILP (tail))
216 {
217 general = Fdelq (XCAR (tail), general);
218 tail = XCDR (tail);
219 }
220 return nconc2 (framelist, general);
221 }
222
223 return general;
224 }
225
226 /* Like Fassoc, but use Fstring_equal to compare
227 (which ignores text properties),
228 and don't ever QUIT. */
229
230 static Lisp_Object
231 assoc_ignore_text_properties (key, list)
232 register Lisp_Object key;
233 Lisp_Object list;
234 {
235 register Lisp_Object tail;
236 for (tail = list; !NILP (tail); tail = Fcdr (tail))
237 {
238 register Lisp_Object elt, tem;
239 elt = Fcar (tail);
240 tem = Fstring_equal (Fcar (elt), key);
241 if (!NILP (tem))
242 return elt;
243 }
244 return Qnil;
245 }
246
247 DEFUN ("get-buffer", Fget_buffer, Sget_buffer, 1, 1, 0,
248 "Return the buffer named NAME (a string).\n\
249 If there is no live buffer named NAME, return nil.\n\
250 NAME may also be a buffer; if so, the value is that buffer.")
251 (name)
252 register Lisp_Object name;
253 {
254 if (BUFFERP (name))
255 return name;
256 CHECK_STRING (name, 0);
257
258 return Fcdr (assoc_ignore_text_properties (name, Vbuffer_alist));
259 }
260
261 DEFUN ("get-file-buffer", Fget_file_buffer, Sget_file_buffer, 1, 1, 0,
262 "Return the buffer visiting file FILENAME (a string).\n\
263 The buffer's `buffer-file-name' must match exactly the expansion of FILENAME.\n\
264 If there is no such live buffer, return nil.\n\
265 See also `find-buffer-visiting'.")
266 (filename)
267 register Lisp_Object filename;
268 {
269 register Lisp_Object tail, buf, tem;
270 Lisp_Object handler;
271
272 CHECK_STRING (filename, 0);
273 filename = Fexpand_file_name (filename, Qnil);
274
275 /* If the file name has special constructs in it,
276 call the corresponding file handler. */
277 handler = Ffind_file_name_handler (filename, Qget_file_buffer);
278 if (!NILP (handler))
279 return call2 (handler, Qget_file_buffer, filename);
280
281 for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
282 {
283 buf = Fcdr (XCAR (tail));
284 if (!BUFFERP (buf)) continue;
285 if (!STRINGP (XBUFFER (buf)->filename)) continue;
286 tem = Fstring_equal (XBUFFER (buf)->filename, filename);
287 if (!NILP (tem))
288 return buf;
289 }
290 return Qnil;
291 }
292
293 Lisp_Object
294 get_truename_buffer (filename)
295 register Lisp_Object filename;
296 {
297 register Lisp_Object tail, buf, tem;
298
299 for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
300 {
301 buf = Fcdr (XCAR (tail));
302 if (!BUFFERP (buf)) continue;
303 if (!STRINGP (XBUFFER (buf)->file_truename)) continue;
304 tem = Fstring_equal (XBUFFER (buf)->file_truename, filename);
305 if (!NILP (tem))
306 return buf;
307 }
308 return Qnil;
309 }
310
311 /* Incremented for each buffer created, to assign the buffer number. */
312 int buffer_count;
313
314 DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 1, 0,
315 "Return the buffer named NAME, or create such a buffer and return it.\n\
316 A new buffer is created if there is no live buffer named NAME.\n\
317 If NAME starts with a space, the new buffer does not keep undo information.\n\
318 If NAME is a buffer instead of a string, then it is the value returned.\n\
319 The value is never nil.")
320 (name)
321 register Lisp_Object name;
322 {
323 register Lisp_Object buf;
324 register struct buffer *b;
325
326 buf = Fget_buffer (name);
327 if (!NILP (buf))
328 return buf;
329
330 if (XSTRING (name)->size == 0)
331 error ("Empty string for buffer name is not allowed");
332
333 b = (struct buffer *) allocate_buffer ();
334
335 b->size = sizeof (struct buffer) / sizeof (EMACS_INT);
336
337 /* An ordinary buffer uses its own struct buffer_text. */
338 b->text = &b->own_text;
339 b->base_buffer = 0;
340
341 BUF_GAP_SIZE (b) = 20;
342 BLOCK_INPUT;
343 /* We allocate extra 1-byte at the tail and keep it always '\0' for
344 anchoring a search. */
345 BUFFER_ALLOC (BUF_BEG_ADDR (b), (BUF_GAP_SIZE (b) + 1));
346 UNBLOCK_INPUT;
347 if (! BUF_BEG_ADDR (b))
348 buffer_memory_full ();
349
350 BUF_PT (b) = 1;
351 BUF_GPT (b) = 1;
352 BUF_BEGV (b) = 1;
353 BUF_ZV (b) = 1;
354 BUF_Z (b) = 1;
355 BUF_PT_BYTE (b) = 1;
356 BUF_GPT_BYTE (b) = 1;
357 BUF_BEGV_BYTE (b) = 1;
358 BUF_ZV_BYTE (b) = 1;
359 BUF_Z_BYTE (b) = 1;
360 BUF_MODIFF (b) = 1;
361 BUF_OVERLAY_MODIFF (b) = 1;
362 BUF_SAVE_MODIFF (b) = 1;
363 BUF_INTERVALS (b) = 0;
364 BUF_UNCHANGED_MODIFIED (b) = 1;
365 BUF_OVERLAY_UNCHANGED_MODIFIED (b) = 1;
366 BUF_END_UNCHANGED (b) = 0;
367 BUF_BEG_UNCHANGED (b) = 0;
368 *(BUF_GPT_ADDR (b)) = *(BUF_Z_ADDR (b)) = 0; /* Put an anchor '\0'. */
369
370 b->newline_cache = 0;
371 b->width_run_cache = 0;
372 b->width_table = Qnil;
373 b->prevent_redisplay_optimizations_p = 1;
374
375 /* Put this on the chain of all buffers including killed ones. */
376 b->next = all_buffers;
377 all_buffers = b;
378
379 /* An ordinary buffer normally doesn't need markers
380 to handle BEGV and ZV. */
381 b->pt_marker = Qnil;
382 b->begv_marker = Qnil;
383 b->zv_marker = Qnil;
384
385 name = Fcopy_sequence (name);
386 INITIALIZE_INTERVAL (XSTRING (name), NULL_INTERVAL);
387 b->name = name;
388
389 if (XSTRING (name)->data[0] != ' ')
390 b->undo_list = Qnil;
391 else
392 b->undo_list = Qt;
393
394 reset_buffer (b);
395 reset_buffer_local_variables (b, 1);
396
397 /* Put this in the alist of all live buffers. */
398 XSETBUFFER (buf, b);
399 Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));
400
401 b->mark = Fmake_marker ();
402 BUF_MARKERS (b) = Qnil;
403 b->name = name;
404 return buf;
405 }
406
407 DEFUN ("make-indirect-buffer", Fmake_indirect_buffer, Smake_indirect_buffer, 2, 2,
408 "bMake indirect buffer (to buffer): \nBName of indirect buffer: ",
409 "Create and return an indirect buffer for buffer BASE-BUFFER, named NAME.\n\
410 BASE-BUFFER should be an existing buffer (or buffer name).\n\
411 NAME should be a string which is not the name of an existing buffer.")
412 (base_buffer, name)
413 register Lisp_Object base_buffer, name;
414 {
415 register Lisp_Object buf;
416 register struct buffer *b;
417
418 buf = Fget_buffer (name);
419 if (!NILP (buf))
420 error ("Buffer name `%s' is in use", XSTRING (name)->data);
421
422 base_buffer = Fget_buffer (base_buffer);
423 if (NILP (base_buffer))
424 error ("No such buffer: `%s'",
425 XSTRING (XBUFFER (base_buffer)->name)->data);
426
427 if (XSTRING (name)->size == 0)
428 error ("Empty string for buffer name is not allowed");
429
430 b = (struct buffer *) allocate_buffer ();
431 b->size = sizeof (struct buffer) / sizeof (EMACS_INT);
432
433 if (XBUFFER (base_buffer)->base_buffer)
434 b->base_buffer = XBUFFER (base_buffer)->base_buffer;
435 else
436 b->base_buffer = XBUFFER (base_buffer);
437
438 /* Use the base buffer's text object. */
439 b->text = b->base_buffer->text;
440
441 BUF_BEGV (b) = BUF_BEGV (b->base_buffer);
442 BUF_ZV (b) = BUF_ZV (b->base_buffer);
443 BUF_PT (b) = BUF_PT (b->base_buffer);
444 BUF_BEGV_BYTE (b) = BUF_BEGV_BYTE (b->base_buffer);
445 BUF_ZV_BYTE (b) = BUF_ZV_BYTE (b->base_buffer);
446 BUF_PT_BYTE (b) = BUF_PT_BYTE (b->base_buffer);
447
448 b->newline_cache = 0;
449 b->width_run_cache = 0;
450 b->width_table = Qnil;
451
452 /* Put this on the chain of all buffers including killed ones. */
453 b->next = all_buffers;
454 all_buffers = b;
455
456 name = Fcopy_sequence (name);
457 INITIALIZE_INTERVAL (XSTRING (name), NULL_INTERVAL);
458 b->name = name;
459
460 reset_buffer (b);
461 reset_buffer_local_variables (b, 1);
462
463 /* Put this in the alist of all live buffers. */
464 XSETBUFFER (buf, b);
465 Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));
466
467 b->mark = Fmake_marker ();
468 b->name = name;
469
470 /* The multibyte status belongs to the base buffer. */
471 b->enable_multibyte_characters = b->base_buffer->enable_multibyte_characters;
472
473 /* Make sure the base buffer has markers for its narrowing. */
474 if (NILP (b->base_buffer->pt_marker))
475 {
476 b->base_buffer->pt_marker = Fmake_marker ();
477 set_marker_both (b->base_buffer->pt_marker, base_buffer,
478 BUF_PT (b->base_buffer),
479 BUF_PT_BYTE (b->base_buffer));
480 }
481 if (NILP (b->base_buffer->begv_marker))
482 {
483 b->base_buffer->begv_marker = Fmake_marker ();
484 set_marker_both (b->base_buffer->begv_marker, base_buffer,
485 BUF_BEGV (b->base_buffer),
486 BUF_BEGV_BYTE (b->base_buffer));
487 }
488 if (NILP (b->base_buffer->zv_marker))
489 {
490 b->base_buffer->zv_marker = Fmake_marker ();
491 set_marker_both (b->base_buffer->zv_marker, base_buffer,
492 BUF_ZV (b->base_buffer),
493 BUF_ZV_BYTE (b->base_buffer));
494 XMARKER (b->base_buffer->zv_marker)->insertion_type = 1;
495 }
496
497 /* Give the indirect buffer markers for its narrowing. */
498 b->pt_marker = Fmake_marker ();
499 set_marker_both (b->pt_marker, buf, BUF_PT (b), BUF_PT_BYTE (b));
500 b->begv_marker = Fmake_marker ();
501 set_marker_both (b->begv_marker, buf, BUF_BEGV (b), BUF_BEGV_BYTE (b));
502 b->zv_marker = Fmake_marker ();
503 set_marker_both (b->zv_marker, buf, BUF_ZV (b), BUF_ZV_BYTE (b));
504 XMARKER (b->zv_marker)->insertion_type = 1;
505
506 return buf;
507 }
508
509 /* Reinitialize everything about a buffer except its name and contents
510 and local variables. */
511
512 void
513 reset_buffer (b)
514 register struct buffer *b;
515 {
516 b->filename = Qnil;
517 b->file_truename = Qnil;
518 b->directory = (current_buffer) ? current_buffer->directory : Qnil;
519 b->modtime = 0;
520 XSETFASTINT (b->save_length, 0);
521 b->last_window_start = 1;
522 /* It is more conservative to start out "changed" than "unchanged". */
523 b->clip_changed = 0;
524 b->prevent_redisplay_optimizations_p = 1;
525 b->backed_up = Qnil;
526 b->auto_save_modified = 0;
527 b->auto_save_failure_time = -1;
528 b->auto_save_file_name = Qnil;
529 b->read_only = Qnil;
530 b->overlays_before = Qnil;
531 b->overlays_after = Qnil;
532 XSETFASTINT (b->overlay_center, 1);
533 b->mark_active = Qnil;
534 b->point_before_scroll = Qnil;
535 b->file_format = Qnil;
536 b->last_selected_window = Qnil;
537 XSETINT (b->display_count, 0);
538 b->display_time = Qnil;
539 b->extra2 = Qnil;
540 b->extra3 = Qnil;
541 b->enable_multibyte_characters = buffer_defaults.enable_multibyte_characters;
542 }
543
544 /* Reset buffer B's local variables info.
545 Don't use this on a buffer that has already been in use;
546 it does not treat permanent locals consistently.
547 Instead, use Fkill_all_local_variables.
548
549 If PERMANENT_TOO is 1, then we reset permanent built-in
550 buffer-local variables. If PERMANENT_TOO is 0,
551 we preserve those. */
552
553 static void
554 reset_buffer_local_variables (b, permanent_too)
555 register struct buffer *b;
556 int permanent_too;
557 {
558 register int offset;
559 int dont_reset;
560
561 /* Decide which built-in local variables to reset. */
562 if (permanent_too)
563 dont_reset = 0;
564 else
565 dont_reset = buffer_permanent_local_flags;
566
567 /* Reset the major mode to Fundamental, together with all the
568 things that depend on the major mode.
569 default-major-mode is handled at a higher level.
570 We ignore it here. */
571 b->major_mode = Qfundamental_mode;
572 b->keymap = Qnil;
573 b->abbrev_table = Vfundamental_mode_abbrev_table;
574 b->mode_name = QSFundamental;
575 b->minor_modes = Qnil;
576
577 /* If the standard case table has been altered and invalidated,
578 fix up its insides first. */
579 if (! (CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[0])
580 && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[1])
581 && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[2])))
582 Fset_standard_case_table (Vascii_downcase_table);
583
584 b->downcase_table = Vascii_downcase_table;
585 b->upcase_table = XCHAR_TABLE (Vascii_downcase_table)->extras[0];
586 b->case_canon_table = XCHAR_TABLE (Vascii_downcase_table)->extras[1];
587 b->case_eqv_table = XCHAR_TABLE (Vascii_downcase_table)->extras[2];
588 b->invisibility_spec = Qt;
589 #ifndef DOS_NT
590 b->buffer_file_type = Qnil;
591 #endif
592
593 #if 0
594 b->sort_table = XSTRING (Vascii_sort_table);
595 b->folding_sort_table = XSTRING (Vascii_folding_sort_table);
596 #endif /* 0 */
597
598 /* Reset all (or most) per-buffer variables to their defaults. */
599 b->local_var_alist = Qnil;
600 b->local_var_flags &= dont_reset;
601
602 /* For each slot that has a default value,
603 copy that into the slot. */
604
605 for (offset = (char *)&buffer_local_flags.name - (char *)&buffer_local_flags;
606 offset < sizeof (struct buffer);
607 offset += sizeof (Lisp_Object)) /* sizeof EMACS_INT == sizeof Lisp_Object */
608 {
609 int flag = XINT (*(Lisp_Object *)(offset + (char *)&buffer_local_flags));
610 if ((flag > 0
611 /* Don't reset a permanent local. */
612 && ! (dont_reset & flag))
613 || flag == -2)
614 *(Lisp_Object *)(offset + (char *)b)
615 = *(Lisp_Object *)(offset + (char *)&buffer_defaults);
616 }
617 }
618
619 /* We split this away from generate-new-buffer, because rename-buffer
620 and set-visited-file-name ought to be able to use this to really
621 rename the buffer properly. */
622
623 DEFUN ("generate-new-buffer-name", Fgenerate_new_buffer_name, Sgenerate_new_buffer_name,
624 1, 2, 0,
625 "Return a string that is the name of no existing buffer based on NAME.\n\
626 If there is no live buffer named NAME, then return NAME.\n\
627 Otherwise modify name by appending `<NUMBER>', incrementing NUMBER\n\
628 until an unused name is found, and then return that name.\n\
629 Optional second argument IGNORE specifies a name that is okay to use\n\
630 \(if it is in the sequence to be tried)\n\
631 even if a buffer with that name exists.")
632 (name, ignore)
633 register Lisp_Object name, ignore;
634 {
635 register Lisp_Object gentemp, tem;
636 int count;
637 char number[10];
638
639 CHECK_STRING (name, 0);
640
641 tem = Fget_buffer (name);
642 if (NILP (tem))
643 return name;
644
645 count = 1;
646 while (1)
647 {
648 sprintf (number, "<%d>", ++count);
649 gentemp = concat2 (name, build_string (number));
650 tem = Fstring_equal (gentemp, ignore);
651 if (!NILP (tem))
652 return gentemp;
653 tem = Fget_buffer (gentemp);
654 if (NILP (tem))
655 return gentemp;
656 }
657 }
658
659 \f
660 DEFUN ("buffer-name", Fbuffer_name, Sbuffer_name, 0, 1, 0,
661 "Return the name of BUFFER, as a string.\n\
662 With no argument or nil as argument, return the name of the current buffer.")
663 (buffer)
664 register Lisp_Object buffer;
665 {
666 if (NILP (buffer))
667 return current_buffer->name;
668 CHECK_BUFFER (buffer, 0);
669 return XBUFFER (buffer)->name;
670 }
671
672 DEFUN ("buffer-file-name", Fbuffer_file_name, Sbuffer_file_name, 0, 1, 0,
673 "Return name of file BUFFER is visiting, or nil if none.\n\
674 No argument or nil as argument means use the current buffer.")
675 (buffer)
676 register Lisp_Object buffer;
677 {
678 if (NILP (buffer))
679 return current_buffer->filename;
680 CHECK_BUFFER (buffer, 0);
681 return XBUFFER (buffer)->filename;
682 }
683
684 DEFUN ("buffer-base-buffer", Fbuffer_base_buffer, Sbuffer_base_buffer,
685 0, 1, 0,
686 "Return the base buffer of indirect buffer BUFFER.\n\
687 If BUFFER is not indirect, return nil.")
688 (buffer)
689 register Lisp_Object buffer;
690 {
691 struct buffer *base;
692 Lisp_Object base_buffer;
693
694 if (NILP (buffer))
695 base = current_buffer->base_buffer;
696 else
697 {
698 CHECK_BUFFER (buffer, 0);
699 base = XBUFFER (buffer)->base_buffer;
700 }
701
702 if (! base)
703 return Qnil;
704 XSETBUFFER (base_buffer, base);
705 return base_buffer;
706 }
707
708 DEFUN ("buffer-local-variables", Fbuffer_local_variables,
709 Sbuffer_local_variables, 0, 1, 0,
710 "Return an alist of variables that are buffer-local in BUFFER.\n\
711 Most elements look like (SYMBOL . VALUE), describing one variable.\n\
712 For a symbol that is locally unbound, just the symbol appears in the value.\n\
713 Note that storing new VALUEs in these elements doesn't change the variables.\n\
714 No argument or nil as argument means use current buffer as BUFFER.")
715 (buffer)
716 register Lisp_Object buffer;
717 {
718 register struct buffer *buf;
719 register Lisp_Object result;
720
721 if (NILP (buffer))
722 buf = current_buffer;
723 else
724 {
725 CHECK_BUFFER (buffer, 0);
726 buf = XBUFFER (buffer);
727 }
728
729 result = Qnil;
730
731 {
732 register Lisp_Object tail;
733 for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail))
734 {
735 Lisp_Object val, elt;
736
737 elt = XCAR (tail);
738
739 /* Reference each variable in the alist in buf.
740 If inquiring about the current buffer, this gets the current values,
741 so store them into the alist so the alist is up to date.
742 If inquiring about some other buffer, this swaps out any values
743 for that buffer, making the alist up to date automatically. */
744 val = find_symbol_value (XCAR (elt));
745 /* Use the current buffer value only if buf is the current buffer. */
746 if (buf != current_buffer)
747 val = XCDR (elt);
748
749 /* If symbol is unbound, put just the symbol in the list. */
750 if (EQ (val, Qunbound))
751 result = Fcons (XCAR (elt), result);
752 /* Otherwise, put (symbol . value) in the list. */
753 else
754 result = Fcons (Fcons (XCAR (elt), val), result);
755 }
756 }
757
758 /* Add on all the variables stored in special slots. */
759 {
760 register int offset, mask;
761
762 for (offset = (char *)&buffer_local_symbols.name - (char *)&buffer_local_symbols;
763 offset < sizeof (struct buffer);
764 offset += (sizeof (EMACS_INT))) /* sizeof EMACS_INT == sizeof Lisp_Object */
765 {
766 mask = XINT (*(Lisp_Object *)(offset + (char *)&buffer_local_flags));
767 if (mask == -1 || (buf->local_var_flags & mask))
768 if (SYMBOLP (*(Lisp_Object *)(offset
769 + (char *)&buffer_local_symbols)))
770 result = Fcons (Fcons (*((Lisp_Object *)
771 (offset + (char *)&buffer_local_symbols)),
772 *(Lisp_Object *)(offset + (char *)buf)),
773 result);
774 }
775 }
776
777 return result;
778 }
779
780 \f
781 DEFUN ("buffer-modified-p", Fbuffer_modified_p, Sbuffer_modified_p,
782 0, 1, 0,
783 "Return t if BUFFER was modified since its file was last read or saved.\n\
784 No argument or nil as argument means use current buffer as BUFFER.")
785 (buffer)
786 register Lisp_Object buffer;
787 {
788 register struct buffer *buf;
789 if (NILP (buffer))
790 buf = current_buffer;
791 else
792 {
793 CHECK_BUFFER (buffer, 0);
794 buf = XBUFFER (buffer);
795 }
796
797 return BUF_SAVE_MODIFF (buf) < BUF_MODIFF (buf) ? Qt : Qnil;
798 }
799
800 DEFUN ("set-buffer-modified-p", Fset_buffer_modified_p, Sset_buffer_modified_p,
801 1, 1, 0,
802 "Mark current buffer as modified or unmodified according to FLAG.\n\
803 A non-nil FLAG means mark the buffer modified.")
804 (flag)
805 register Lisp_Object flag;
806 {
807 register int already;
808 register Lisp_Object fn;
809
810 #ifdef CLASH_DETECTION
811 /* If buffer becoming modified, lock the file.
812 If buffer becoming unmodified, unlock the file. */
813
814 fn = current_buffer->file_truename;
815 /* Test buffer-file-name so that binding it to nil is effective. */
816 if (!NILP (fn) && ! NILP (current_buffer->filename))
817 {
818 already = SAVE_MODIFF < MODIFF;
819 if (!already && !NILP (flag))
820 lock_file (fn);
821 else if (already && NILP (flag))
822 unlock_file (fn);
823 }
824 #endif /* CLASH_DETECTION */
825
826 SAVE_MODIFF = NILP (flag) ? MODIFF : 0;
827 update_mode_lines++;
828 return flag;
829 }
830
831 DEFUN ("buffer-modified-tick", Fbuffer_modified_tick, Sbuffer_modified_tick,
832 0, 1, 0,
833 "Return BUFFER's tick counter, incremented for each change in text.\n\
834 Each buffer has a tick counter which is incremented each time the text in\n\
835 that buffer is changed. It wraps around occasionally.\n\
836 No argument or nil as argument means use current buffer as BUFFER.")
837 (buffer)
838 register Lisp_Object buffer;
839 {
840 register struct buffer *buf;
841 if (NILP (buffer))
842 buf = current_buffer;
843 else
844 {
845 CHECK_BUFFER (buffer, 0);
846 buf = XBUFFER (buffer);
847 }
848
849 return make_number (BUF_MODIFF (buf));
850 }
851 \f
852 DEFUN ("rename-buffer", Frename_buffer, Srename_buffer, 1, 2,
853 "sRename buffer (to new name): \nP",
854 "Change current buffer's name to NEWNAME (a string).\n\
855 If second arg UNIQUE is nil or omitted, it is an error if a\n\
856 buffer named NEWNAME already exists.\n\
857 If UNIQUE is non-nil, come up with a new name using\n\
858 `generate-new-buffer-name'.\n\
859 Interactively, you can set UNIQUE with a prefix argument.\n\
860 We return the name we actually gave the buffer.\n\
861 This does not change the name of the visited file (if any).")
862 (newname, unique)
863 register Lisp_Object newname, unique;
864 {
865 register Lisp_Object tem, buf;
866
867 CHECK_STRING (newname, 0);
868
869 if (XSTRING (newname)->size == 0)
870 error ("Empty string is invalid as a buffer name");
871
872 tem = Fget_buffer (newname);
873 /* Don't short-circuit if UNIQUE is t. That is a useful way to rename
874 the buffer automatically so you can create another with the original name.
875 It makes UNIQUE equivalent to
876 (rename-buffer (generate-new-buffer-name NEWNAME)). */
877 if (NILP (unique) && XBUFFER (tem) == current_buffer)
878 return current_buffer->name;
879 if (!NILP (tem))
880 {
881 if (!NILP (unique))
882 newname = Fgenerate_new_buffer_name (newname, current_buffer->name);
883 else
884 error ("Buffer name `%s' is in use", XSTRING (newname)->data);
885 }
886
887 current_buffer->name = newname;
888
889 /* Catch redisplay's attention. Unless we do this, the mode lines for
890 any windows displaying current_buffer will stay unchanged. */
891 update_mode_lines++;
892
893 XSETBUFFER (buf, current_buffer);
894 Fsetcar (Frassq (buf, Vbuffer_alist), newname);
895 if (NILP (current_buffer->filename)
896 && !NILP (current_buffer->auto_save_file_name))
897 call0 (intern ("rename-auto-save-file"));
898 /* Refetch since that last call may have done GC. */
899 return current_buffer->name;
900 }
901
902 DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 3, 0,
903 "Return most recently selected buffer other than BUFFER.\n\
904 Buffers not visible in windows are preferred to visible buffers,\n\
905 unless optional second argument VISIBLE-OK is non-nil.\n\
906 If the optional third argument FRAME is non-nil, use that frame's\n\
907 buffer list instead of the selected frame's buffer list.\n\
908 If no other buffer exists, the buffer `*scratch*' is returned.\n\
909 If BUFFER is omitted or nil, some interesting buffer is returned.")
910 (buffer, visible_ok, frame)
911 register Lisp_Object buffer, visible_ok, frame;
912 {
913 Lisp_Object Fset_buffer_major_mode ();
914 register Lisp_Object tail, buf, notsogood, tem, pred, add_ons;
915 notsogood = Qnil;
916
917 if (NILP (frame))
918 frame = selected_frame;
919
920 tail = Vbuffer_alist;
921 pred = frame_buffer_predicate (frame);
922
923 /* Consider buffers that have been seen in the selected frame
924 before other buffers. */
925
926 tem = frame_buffer_list (frame);
927 add_ons = Qnil;
928 while (CONSP (tem))
929 {
930 if (BUFFERP (XCAR (tem)))
931 add_ons = Fcons (Fcons (Qnil, XCAR (tem)), add_ons);
932 tem = XCDR (tem);
933 }
934 tail = nconc2 (Fnreverse (add_ons), tail);
935
936 for (; !NILP (tail); tail = Fcdr (tail))
937 {
938 buf = Fcdr (Fcar (tail));
939 if (EQ (buf, buffer))
940 continue;
941 if (XSTRING (XBUFFER (buf)->name)->data[0] == ' ')
942 continue;
943 /* If the selected frame has a buffer_predicate,
944 disregard buffers that don't fit the predicate. */
945 if (!NILP (pred))
946 {
947 tem = call1 (pred, buf);
948 if (NILP (tem))
949 continue;
950 }
951
952 if (NILP (visible_ok))
953 tem = Fget_buffer_window (buf, Qt);
954 else
955 tem = Qnil;
956 if (NILP (tem))
957 return buf;
958 if (NILP (notsogood))
959 notsogood = buf;
960 }
961 if (!NILP (notsogood))
962 return notsogood;
963 buf = Fget_buffer (build_string ("*scratch*"));
964 if (NILP (buf))
965 {
966 buf = Fget_buffer_create (build_string ("*scratch*"));
967 Fset_buffer_major_mode (buf);
968 }
969 return buf;
970 }
971 \f
972 DEFUN ("buffer-disable-undo", Fbuffer_disable_undo, Sbuffer_disable_undo,
973 0, 1, "",
974 "Make BUFFER stop keeping undo information.\n\
975 No argument or nil as argument means do this for the current buffer.")
976 (buffer)
977 register Lisp_Object buffer;
978 {
979 Lisp_Object real_buffer;
980
981 if (NILP (buffer))
982 XSETBUFFER (real_buffer, current_buffer);
983 else
984 {
985 real_buffer = Fget_buffer (buffer);
986 if (NILP (real_buffer))
987 nsberror (buffer);
988 }
989
990 XBUFFER (real_buffer)->undo_list = Qt;
991
992 return Qnil;
993 }
994
995 DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, Sbuffer_enable_undo,
996 0, 1, "",
997 "Start keeping undo information for buffer BUFFER.\n\
998 No argument or nil as argument means do this for the current buffer.")
999 (buffer)
1000 register Lisp_Object buffer;
1001 {
1002 Lisp_Object real_buffer;
1003
1004 if (NILP (buffer))
1005 XSETBUFFER (real_buffer, current_buffer);
1006 else
1007 {
1008 real_buffer = Fget_buffer (buffer);
1009 if (NILP (real_buffer))
1010 nsberror (buffer);
1011 }
1012
1013 if (EQ (XBUFFER (real_buffer)->undo_list, Qt))
1014 XBUFFER (real_buffer)->undo_list = Qnil;
1015
1016 return Qnil;
1017 }
1018
1019 /*
1020 DEFVAR_LISP ("kill-buffer-hook", no_cell, "\
1021 Hook to be run (by `run-hooks', which see) when a buffer is killed.\n\
1022 The buffer being killed will be current while the hook is running.\n\
1023 See `kill-buffer'."
1024 */
1025 DEFUN ("kill-buffer", Fkill_buffer, Skill_buffer, 1, 1, "bKill buffer: ",
1026 "Kill the buffer BUFFER.\n\
1027 The argument may be a buffer or may be the name of a buffer.\n\
1028 An argument of nil means kill the current buffer.\n\n\
1029 Value is t if the buffer is actually killed, nil if user says no.\n\n\
1030 The value of `kill-buffer-hook' (which may be local to that buffer),\n\
1031 if not void, is a list of functions to be called, with no arguments,\n\
1032 before the buffer is actually killed. The buffer to be killed is current\n\
1033 when the hook functions are called.\n\n\
1034 Any processes that have this buffer as the `process-buffer' are killed\n\
1035 with SIGHUP.")
1036 (buffer)
1037 Lisp_Object buffer;
1038 {
1039 Lisp_Object buf;
1040 register struct buffer *b;
1041 register Lisp_Object tem;
1042 register struct Lisp_Marker *m;
1043 struct gcpro gcpro1;
1044
1045 if (NILP (buffer))
1046 buf = Fcurrent_buffer ();
1047 else
1048 buf = Fget_buffer (buffer);
1049 if (NILP (buf))
1050 nsberror (buffer);
1051
1052 b = XBUFFER (buf);
1053
1054 /* Avoid trouble for buffer already dead. */
1055 if (NILP (b->name))
1056 return Qnil;
1057
1058 /* Query if the buffer is still modified. */
1059 if (INTERACTIVE && !NILP (b->filename)
1060 && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b))
1061 {
1062 GCPRO1 (buf);
1063 tem = do_yes_or_no_p (format1 ("Buffer %s modified; kill anyway? ",
1064 XSTRING (b->name)->data));
1065 UNGCPRO;
1066 if (NILP (tem))
1067 return Qnil;
1068 }
1069
1070 /* Run hooks with the buffer to be killed the current buffer. */
1071 {
1072 int count = specpdl_ptr - specpdl;
1073 Lisp_Object list;
1074
1075 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1076 set_buffer_internal (b);
1077
1078 /* First run the query functions; if any query is answered no,
1079 don't kill the buffer. */
1080 for (list = Vkill_buffer_query_functions; !NILP (list); list = Fcdr (list))
1081 {
1082 tem = call0 (Fcar (list));
1083 if (NILP (tem))
1084 return unbind_to (count, Qnil);
1085 }
1086
1087 /* Then run the hooks. */
1088 if (!NILP (Vrun_hooks))
1089 call1 (Vrun_hooks, Qkill_buffer_hook);
1090 unbind_to (count, Qnil);
1091 }
1092
1093 /* We have no more questions to ask. Verify that it is valid
1094 to kill the buffer. This must be done after the questions
1095 since anything can happen within do_yes_or_no_p. */
1096
1097 /* Don't kill the minibuffer now current. */
1098 if (EQ (buf, XWINDOW (minibuf_window)->buffer))
1099 return Qnil;
1100
1101 if (NILP (b->name))
1102 return Qnil;
1103
1104 /* When we kill a base buffer, kill all its indirect buffers.
1105 We do it at this stage so nothing terrible happens if they
1106 ask questions or their hooks get errors. */
1107 if (! b->base_buffer)
1108 {
1109 struct buffer *other;
1110
1111 GCPRO1 (buf);
1112
1113 for (other = all_buffers; other; other = other->next)
1114 /* all_buffers contains dead buffers too;
1115 don't re-kill them. */
1116 if (other->base_buffer == b && !NILP (other->name))
1117 {
1118 Lisp_Object buf;
1119 XSETBUFFER (buf, other);
1120 Fkill_buffer (buf);
1121 }
1122
1123 UNGCPRO;
1124 }
1125
1126 /* Make this buffer not be current.
1127 In the process, notice if this is the sole visible buffer
1128 and give up if so. */
1129 if (b == current_buffer)
1130 {
1131 tem = Fother_buffer (buf, Qnil, Qnil);
1132 Fset_buffer (tem);
1133 if (b == current_buffer)
1134 return Qnil;
1135 }
1136
1137 /* Now there is no question: we can kill the buffer. */
1138
1139 #ifdef CLASH_DETECTION
1140 /* Unlock this buffer's file, if it is locked. */
1141 unlock_buffer (b);
1142 #endif /* CLASH_DETECTION */
1143
1144 kill_buffer_processes (buf);
1145
1146 tem = Vinhibit_quit;
1147 Vinhibit_quit = Qt;
1148 replace_buffer_in_all_windows (buf);
1149 Vbuffer_alist = Fdelq (Frassq (buf, Vbuffer_alist), Vbuffer_alist);
1150 frames_discard_buffer (buf);
1151 Vinhibit_quit = tem;
1152
1153 /* Delete any auto-save file, if we saved it in this session. */
1154 if (STRINGP (b->auto_save_file_name)
1155 && b->auto_save_modified != 0
1156 && BUF_SAVE_MODIFF (b) < b->auto_save_modified)
1157 {
1158 Lisp_Object tem;
1159 tem = Fsymbol_value (intern ("delete-auto-save-files"));
1160 if (! NILP (tem))
1161 internal_delete_file (b->auto_save_file_name);
1162 }
1163
1164 if (b->base_buffer)
1165 {
1166 /* Unchain all markers that belong to this indirect buffer.
1167 Don't unchain the markers that belong to the base buffer
1168 or its other indirect buffers. */
1169 for (tem = BUF_MARKERS (b); !NILP (tem); )
1170 {
1171 Lisp_Object next;
1172 m = XMARKER (tem);
1173 next = m->chain;
1174 if (m->buffer == b)
1175 unchain_marker (tem);
1176 tem = next;
1177 }
1178 }
1179 else
1180 {
1181 /* Unchain all markers of this buffer and its indirect buffers.
1182 and leave them pointing nowhere. */
1183 for (tem = BUF_MARKERS (b); !NILP (tem); )
1184 {
1185 m = XMARKER (tem);
1186 m->buffer = 0;
1187 tem = m->chain;
1188 m->chain = Qnil;
1189 }
1190 BUF_MARKERS (b) = Qnil;
1191 BUF_INTERVALS (b) = NULL_INTERVAL;
1192
1193 /* Perhaps we should explicitly free the interval tree here... */
1194 }
1195
1196 /* Reset the local variables, so that this buffer's local values
1197 won't be protected from GC. They would be protected
1198 if they happened to remain encached in their symbols.
1199 This gets rid of them for certain. */
1200 swap_out_buffer_local_variables (b);
1201 reset_buffer_local_variables (b, 1);
1202
1203 b->name = Qnil;
1204
1205 BLOCK_INPUT;
1206 if (! b->base_buffer)
1207 BUFFER_FREE (BUF_BEG_ADDR (b));
1208
1209 if (b->newline_cache)
1210 {
1211 free_region_cache (b->newline_cache);
1212 b->newline_cache = 0;
1213 }
1214 if (b->width_run_cache)
1215 {
1216 free_region_cache (b->width_run_cache);
1217 b->width_run_cache = 0;
1218 }
1219 b->width_table = Qnil;
1220 UNBLOCK_INPUT;
1221 b->undo_list = Qnil;
1222
1223 return Qt;
1224 }
1225 \f
1226 /* Move the assoc for buffer BUF to the front of buffer-alist. Since
1227 we do this each time BUF is selected visibly, the more recently
1228 selected buffers are always closer to the front of the list. This
1229 means that other_buffer is more likely to choose a relevant buffer. */
1230
1231 void
1232 record_buffer (buf)
1233 Lisp_Object buf;
1234 {
1235 register Lisp_Object link, prev;
1236 Lisp_Object frame;
1237 frame = selected_frame;
1238
1239 prev = Qnil;
1240 for (link = Vbuffer_alist; CONSP (link); link = XCDR (link))
1241 {
1242 if (EQ (XCDR (XCAR (link)), buf))
1243 break;
1244 prev = link;
1245 }
1246
1247 /* Effectively do Vbuffer_alist = Fdelq (link, Vbuffer_alist);
1248 we cannot use Fdelq itself here because it allows quitting. */
1249
1250 if (NILP (prev))
1251 Vbuffer_alist = XCDR (Vbuffer_alist);
1252 else
1253 XCDR (prev) = XCDR (XCDR (prev));
1254
1255 XCDR (link) = Vbuffer_alist;
1256 Vbuffer_alist = link;
1257
1258 /* Now move this buffer to the front of frame_buffer_list also. */
1259
1260 prev = Qnil;
1261 for (link = frame_buffer_list (frame); CONSP (link);
1262 link = XCDR (link))
1263 {
1264 if (EQ (XCAR (link), buf))
1265 break;
1266 prev = link;
1267 }
1268
1269 /* Effectively do delq. */
1270
1271 if (CONSP (link))
1272 {
1273 if (NILP (prev))
1274 set_frame_buffer_list (frame,
1275 XCDR (frame_buffer_list (frame)));
1276 else
1277 XCDR (prev) = XCDR (XCDR (prev));
1278
1279 XCDR (link) = frame_buffer_list (frame);
1280 set_frame_buffer_list (frame, link);
1281 }
1282 else
1283 set_frame_buffer_list (frame, Fcons (buf, frame_buffer_list (frame)));
1284 }
1285
1286 DEFUN ("set-buffer-major-mode", Fset_buffer_major_mode, Sset_buffer_major_mode, 1, 1, 0,
1287 "Set an appropriate major mode for BUFFER, according to `default-major-mode'.\n\
1288 Use this function before selecting the buffer, since it may need to inspect\n\
1289 the current buffer's major mode.")
1290 (buffer)
1291 Lisp_Object buffer;
1292 {
1293 int count;
1294 Lisp_Object function;
1295
1296 function = buffer_defaults.major_mode;
1297 if (NILP (function) && NILP (Fget (current_buffer->major_mode, Qmode_class)))
1298 function = current_buffer->major_mode;
1299
1300 if (NILP (function) || EQ (function, Qfundamental_mode))
1301 return Qnil;
1302
1303 count = specpdl_ptr - specpdl;
1304
1305 /* To select a nonfundamental mode,
1306 select the buffer temporarily and then call the mode function. */
1307
1308 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1309
1310 Fset_buffer (buffer);
1311 call0 (function);
1312
1313 return unbind_to (count, Qnil);
1314 }
1315
1316 /* If switching buffers in WINDOW would be an error, return
1317 a C string saying what the error would be. */
1318
1319 char *
1320 no_switch_window (window)
1321 Lisp_Object window;
1322 {
1323 Lisp_Object tem;
1324 if (EQ (minibuf_window, window))
1325 return "Cannot switch buffers in minibuffer window";
1326 tem = Fwindow_dedicated_p (window);
1327 if (!NILP (tem))
1328 return "Cannot switch buffers in a dedicated window";
1329 return NULL;
1330 }
1331
1332 /* Switch to buffer BUFFER in the selected window.
1333 If NORECORD is non-nil, don't call record_buffer. */
1334
1335 Lisp_Object
1336 switch_to_buffer_1 (buffer, norecord)
1337 Lisp_Object buffer, norecord;
1338 {
1339 register Lisp_Object buf;
1340
1341 if (NILP (buffer))
1342 buf = Fother_buffer (Fcurrent_buffer (), Qnil, Qnil);
1343 else
1344 {
1345 buf = Fget_buffer (buffer);
1346 if (NILP (buf))
1347 {
1348 buf = Fget_buffer_create (buffer);
1349 Fset_buffer_major_mode (buf);
1350 }
1351 }
1352 Fset_buffer (buf);
1353 if (NILP (norecord))
1354 record_buffer (buf);
1355
1356 Fset_window_buffer (EQ (selected_window, minibuf_window)
1357 ? Fnext_window (minibuf_window, Qnil, Qnil)
1358 : selected_window,
1359 buf);
1360
1361 return buf;
1362 }
1363
1364 DEFUN ("switch-to-buffer", Fswitch_to_buffer, Sswitch_to_buffer, 1, 2, "BSwitch to buffer: ",
1365 "Select buffer BUFFER in the current window.\n\
1366 BUFFER may be a buffer or a buffer name.\n\
1367 Optional second arg NORECORD non-nil means\n\
1368 do not put this buffer at the front of the list of recently selected ones.\n\
1369 \n\
1370 WARNING: This is NOT the way to work on another buffer temporarily\n\
1371 within a Lisp program! Use `set-buffer' instead. That avoids messing with\n\
1372 the window-buffer correspondences.")
1373 (buffer, norecord)
1374 Lisp_Object buffer, norecord;
1375 {
1376 char *err;
1377
1378 err = no_switch_window (selected_window);
1379 if (err) error (err);
1380
1381 return switch_to_buffer_1 (buffer, norecord);
1382 }
1383
1384 DEFUN ("pop-to-buffer", Fpop_to_buffer, Spop_to_buffer, 1, 3, 0,
1385 "Select buffer BUFFER in some window, preferably a different one.\n\
1386 If BUFFER is nil, then some other buffer is chosen.\n\
1387 If `pop-up-windows' is non-nil, windows can be split to do this.\n\
1388 If optional second arg OTHER-WINDOW is non-nil, insist on finding another\n\
1389 window even if BUFFER is already visible in the selected window.\n\
1390 This uses the function `display-buffer' as a subroutine; see the documentation\n\
1391 of `display-buffer' for additional customization information.\n\
1392 \n\
1393 Optional third arg NORECORD non-nil means\n\
1394 do not put this buffer at the front of the list of recently selected ones.")
1395 (buffer, other_window, norecord)
1396 Lisp_Object buffer, other_window, norecord;
1397 {
1398 register Lisp_Object buf;
1399 if (NILP (buffer))
1400 buf = Fother_buffer (Fcurrent_buffer (), Qnil, Qnil);
1401 else
1402 {
1403 buf = Fget_buffer (buffer);
1404 if (NILP (buf))
1405 {
1406 buf = Fget_buffer_create (buffer);
1407 Fset_buffer_major_mode (buf);
1408 }
1409 }
1410 Fset_buffer (buf);
1411 if (NILP (norecord))
1412 record_buffer (buf);
1413 Fselect_window (Fdisplay_buffer (buf, other_window, Qnil));
1414 return buf;
1415 }
1416
1417 DEFUN ("current-buffer", Fcurrent_buffer, Scurrent_buffer, 0, 0, 0,
1418 "Return the current buffer as a Lisp object.")
1419 ()
1420 {
1421 register Lisp_Object buf;
1422 XSETBUFFER (buf, current_buffer);
1423 return buf;
1424 }
1425 \f
1426 /* Set the current buffer to B.
1427
1428 We previously set windows_or_buffers_changed here to invalidate
1429 global unchanged information in beg_unchanged and end_unchanged.
1430 This is no longer necessary because we now compute unchanged
1431 information on a buffer-basis. Every action affecting other
1432 windows than the selected one requires a select_window at some
1433 time, and that increments windows_or_buffers_changed. */
1434
1435 void
1436 set_buffer_internal (b)
1437 register struct buffer *b;
1438 {
1439 if (current_buffer != b)
1440 set_buffer_internal_1 (b);
1441 }
1442
1443 /* Set the current buffer to B, and do not set windows_or_buffers_changed.
1444 This is used by redisplay. */
1445
1446 void
1447 set_buffer_internal_1 (b)
1448 register struct buffer *b;
1449 {
1450 register struct buffer *old_buf;
1451 register Lisp_Object tail, valcontents;
1452 Lisp_Object tem;
1453
1454 if (current_buffer == b)
1455 return;
1456
1457 old_buf = current_buffer;
1458 current_buffer = b;
1459 last_known_column_point = -1; /* invalidate indentation cache */
1460
1461 if (old_buf)
1462 {
1463 /* Put the undo list back in the base buffer, so that it appears
1464 that an indirect buffer shares the undo list of its base. */
1465 if (old_buf->base_buffer)
1466 old_buf->base_buffer->undo_list = old_buf->undo_list;
1467
1468 /* If the old current buffer has markers to record PT, BEGV and ZV
1469 when it is not current, update them now. */
1470 if (! NILP (old_buf->pt_marker))
1471 {
1472 Lisp_Object obuf;
1473 XSETBUFFER (obuf, old_buf);
1474 set_marker_both (old_buf->pt_marker, obuf,
1475 BUF_PT (old_buf), BUF_PT_BYTE (old_buf));
1476 }
1477 if (! NILP (old_buf->begv_marker))
1478 {
1479 Lisp_Object obuf;
1480 XSETBUFFER (obuf, old_buf);
1481 set_marker_both (old_buf->begv_marker, obuf,
1482 BUF_BEGV (old_buf), BUF_BEGV_BYTE (old_buf));
1483 }
1484 if (! NILP (old_buf->zv_marker))
1485 {
1486 Lisp_Object obuf;
1487 XSETBUFFER (obuf, old_buf);
1488 set_marker_both (old_buf->zv_marker, obuf,
1489 BUF_ZV (old_buf), BUF_ZV_BYTE (old_buf));
1490 }
1491 }
1492
1493 /* Get the undo list from the base buffer, so that it appears
1494 that an indirect buffer shares the undo list of its base. */
1495 if (b->base_buffer)
1496 b->undo_list = b->base_buffer->undo_list;
1497
1498 /* If the new current buffer has markers to record PT, BEGV and ZV
1499 when it is not current, fetch them now. */
1500 if (! NILP (b->pt_marker))
1501 {
1502 BUF_PT (b) = marker_position (b->pt_marker);
1503 BUF_PT_BYTE (b) = marker_byte_position (b->pt_marker);
1504 }
1505 if (! NILP (b->begv_marker))
1506 {
1507 BUF_BEGV (b) = marker_position (b->begv_marker);
1508 BUF_BEGV_BYTE (b) = marker_byte_position (b->begv_marker);
1509 }
1510 if (! NILP (b->zv_marker))
1511 {
1512 BUF_ZV (b) = marker_position (b->zv_marker);
1513 BUF_ZV_BYTE (b) = marker_byte_position (b->zv_marker);
1514 }
1515
1516 /* Look down buffer's list of local Lisp variables
1517 to find and update any that forward into C variables. */
1518
1519 for (tail = b->local_var_alist; !NILP (tail); tail = XCDR (tail))
1520 {
1521 valcontents = XSYMBOL (XCAR (XCAR (tail)))->value;
1522 if ((BUFFER_LOCAL_VALUEP (valcontents)
1523 || SOME_BUFFER_LOCAL_VALUEP (valcontents))
1524 && (tem = XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
1525 (BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem))))
1526 /* Just reference the variable
1527 to cause it to become set for this buffer. */
1528 Fsymbol_value (XCAR (XCAR (tail)));
1529 }
1530
1531 /* Do the same with any others that were local to the previous buffer */
1532
1533 if (old_buf)
1534 for (tail = old_buf->local_var_alist; !NILP (tail); tail = XCDR (tail))
1535 {
1536 valcontents = XSYMBOL (XCAR (XCAR (tail)))->value;
1537 if ((BUFFER_LOCAL_VALUEP (valcontents)
1538 || SOME_BUFFER_LOCAL_VALUEP (valcontents))
1539 && (tem = XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
1540 (BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem))))
1541 /* Just reference the variable
1542 to cause it to become set for this buffer. */
1543 Fsymbol_value (XCAR (XCAR (tail)));
1544 }
1545 }
1546
1547 /* Switch to buffer B temporarily for redisplay purposes.
1548 This avoids certain things that don't need to be done within redisplay. */
1549
1550 void
1551 set_buffer_temp (b)
1552 struct buffer *b;
1553 {
1554 register struct buffer *old_buf;
1555
1556 if (current_buffer == b)
1557 return;
1558
1559 old_buf = current_buffer;
1560 current_buffer = b;
1561
1562 if (old_buf)
1563 {
1564 /* If the old current buffer has markers to record PT, BEGV and ZV
1565 when it is not current, update them now. */
1566 if (! NILP (old_buf->pt_marker))
1567 {
1568 Lisp_Object obuf;
1569 XSETBUFFER (obuf, old_buf);
1570 set_marker_both (old_buf->pt_marker, obuf,
1571 BUF_PT (old_buf), BUF_PT_BYTE (old_buf));
1572 }
1573 if (! NILP (old_buf->begv_marker))
1574 {
1575 Lisp_Object obuf;
1576 XSETBUFFER (obuf, old_buf);
1577 set_marker_both (old_buf->begv_marker, obuf,
1578 BUF_BEGV (old_buf), BUF_BEGV_BYTE (old_buf));
1579 }
1580 if (! NILP (old_buf->zv_marker))
1581 {
1582 Lisp_Object obuf;
1583 XSETBUFFER (obuf, old_buf);
1584 set_marker_both (old_buf->zv_marker, obuf,
1585 BUF_ZV (old_buf), BUF_ZV_BYTE (old_buf));
1586 }
1587 }
1588
1589 /* If the new current buffer has markers to record PT, BEGV and ZV
1590 when it is not current, fetch them now. */
1591 if (! NILP (b->pt_marker))
1592 {
1593 BUF_PT (b) = marker_position (b->pt_marker);
1594 BUF_PT_BYTE (b) = marker_byte_position (b->pt_marker);
1595 }
1596 if (! NILP (b->begv_marker))
1597 {
1598 BUF_BEGV (b) = marker_position (b->begv_marker);
1599 BUF_BEGV_BYTE (b) = marker_byte_position (b->begv_marker);
1600 }
1601 if (! NILP (b->zv_marker))
1602 {
1603 BUF_ZV (b) = marker_position (b->zv_marker);
1604 BUF_ZV_BYTE (b) = marker_byte_position (b->zv_marker);
1605 }
1606 }
1607
1608 DEFUN ("set-buffer", Fset_buffer, Sset_buffer, 1, 1, 0,
1609 "Make the buffer BUFFER current for editing operations.\n\
1610 BUFFER may be a buffer or the name of an existing buffer.\n\
1611 See also `save-excursion' when you want to make a buffer current temporarily.\n\
1612 This function does not display the buffer, so its effect ends\n\
1613 when the current command terminates.\n\
1614 Use `switch-to-buffer' or `pop-to-buffer' to switch buffers permanently.")
1615 (buffer)
1616 register Lisp_Object buffer;
1617 {
1618 register Lisp_Object buf;
1619 buf = Fget_buffer (buffer);
1620 if (NILP (buf))
1621 nsberror (buffer);
1622 if (NILP (XBUFFER (buf)->name))
1623 error ("Selecting deleted buffer");
1624 set_buffer_internal (XBUFFER (buf));
1625 return buf;
1626 }
1627
1628 /* Set the current buffer to BUFFER provided it is alive. */
1629
1630 Lisp_Object
1631 set_buffer_if_live (buffer)
1632 Lisp_Object buffer;
1633 {
1634 if (! NILP (XBUFFER (buffer)->name))
1635 Fset_buffer (buffer);
1636 return Qnil;
1637 }
1638 \f
1639 DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only,
1640 Sbarf_if_buffer_read_only, 0, 0, 0,
1641 "Signal a `buffer-read-only' error if the current buffer is read-only.")
1642 ()
1643 {
1644 if (!NILP (current_buffer->read_only)
1645 && NILP (Vinhibit_read_only))
1646 Fsignal (Qbuffer_read_only, (Fcons (Fcurrent_buffer (), Qnil)));
1647 return Qnil;
1648 }
1649
1650 DEFUN ("bury-buffer", Fbury_buffer, Sbury_buffer, 0, 1, "",
1651 "Put BUFFER at the end of the list of all buffers.\n\
1652 There it is the least likely candidate for `other-buffer' to return;\n\
1653 thus, the least likely buffer for \\[switch-to-buffer] to select by default.\n\
1654 If BUFFER is nil or omitted, bury the current buffer.\n\
1655 Also, if BUFFER is nil or omitted, remove the current buffer from the\n\
1656 selected window if it is displayed there.")
1657 (buffer)
1658 register Lisp_Object buffer;
1659 {
1660 /* Figure out what buffer we're going to bury. */
1661 if (NILP (buffer))
1662 {
1663 XSETBUFFER (buffer, current_buffer);
1664
1665 /* If we're burying the current buffer, unshow it. */
1666 Fswitch_to_buffer (Fother_buffer (buffer, Qnil, Qnil), Qnil);
1667 }
1668 else
1669 {
1670 Lisp_Object buf1;
1671
1672 buf1 = Fget_buffer (buffer);
1673 if (NILP (buf1))
1674 nsberror (buffer);
1675 buffer = buf1;
1676 }
1677
1678 /* Move buffer to the end of the buffer list. */
1679 {
1680 register Lisp_Object aelt, link;
1681
1682 aelt = Frassq (buffer, Vbuffer_alist);
1683 link = Fmemq (aelt, Vbuffer_alist);
1684 Vbuffer_alist = Fdelq (aelt, Vbuffer_alist);
1685 XCDR (link) = Qnil;
1686 Vbuffer_alist = nconc2 (Vbuffer_alist, link);
1687 }
1688
1689 frames_bury_buffer (buffer);
1690
1691 return Qnil;
1692 }
1693 \f
1694 DEFUN ("erase-buffer", Ferase_buffer, Serase_buffer, 0, 0, "*",
1695 "Delete the entire contents of the current buffer.\n\
1696 Any narrowing restriction in effect (see `narrow-to-region') is removed,\n\
1697 so the buffer is truly empty after this.")
1698 ()
1699 {
1700 Fwiden ();
1701
1702 del_range (BEG, Z);
1703
1704 current_buffer->last_window_start = 1;
1705 /* Prevent warnings, or suspension of auto saving, that would happen
1706 if future size is less than past size. Use of erase-buffer
1707 implies that the future text is not really related to the past text. */
1708 XSETFASTINT (current_buffer->save_length, 0);
1709 return Qnil;
1710 }
1711
1712 void
1713 validate_region (b, e)
1714 register Lisp_Object *b, *e;
1715 {
1716 CHECK_NUMBER_COERCE_MARKER (*b, 0);
1717 CHECK_NUMBER_COERCE_MARKER (*e, 1);
1718
1719 if (XINT (*b) > XINT (*e))
1720 {
1721 Lisp_Object tem;
1722 tem = *b; *b = *e; *e = tem;
1723 }
1724
1725 if (!(BEGV <= XINT (*b) && XINT (*b) <= XINT (*e)
1726 && XINT (*e) <= ZV))
1727 args_out_of_range (*b, *e);
1728 }
1729 \f
1730 /* Advance BYTE_POS up to a character boundary
1731 and return the adjusted position. */
1732
1733 static int
1734 advance_to_char_boundary (byte_pos)
1735 int byte_pos;
1736 {
1737 int c;
1738
1739 if (byte_pos == BEG)
1740 /* Beginning of buffer is always a character boundary. */
1741 return 1;
1742
1743 c = FETCH_BYTE (byte_pos);
1744 if (! CHAR_HEAD_P (c))
1745 {
1746 /* We should advance BYTE_POS only when C is a constituent of a
1747 multibyte sequence. */
1748 DEC_POS (byte_pos);
1749 INC_POS (byte_pos);
1750 /* If C is a constituent of a multibyte sequence, BYTE_POS was
1751 surely advance to the correct character boundary. If C is
1752 not, BYTE_POS was unchanged. */
1753 }
1754
1755 return byte_pos;
1756 }
1757
1758 DEFUN ("set-buffer-multibyte", Fset_buffer_multibyte, Sset_buffer_multibyte,
1759 1, 1, 0,
1760 "Set the multibyte flag of the current buffer to FLAG.\n\
1761 If FLAG is t, this makes the buffer a multibyte buffer.\n\
1762 If FLAG is nil, this makes the buffer a single-byte buffer.\n\
1763 The buffer contents remain unchanged as a sequence of bytes\n\
1764 but the contents viewed as characters do change.")
1765 (flag)
1766 Lisp_Object flag;
1767 {
1768 Lisp_Object tail, markers;
1769 struct buffer *other;
1770
1771 if (current_buffer->base_buffer)
1772 error ("Cannot do `set-buffer-multibyte' on an indirect buffer");
1773
1774 /* Do nothing if nothing actually changes. */
1775 if (NILP (flag) == NILP (current_buffer->enable_multibyte_characters))
1776 return flag;
1777
1778 /* It would be better to update the list,
1779 but this is good enough for now. */
1780 if (! EQ (current_buffer->undo_list, Qt))
1781 current_buffer->undo_list = Qnil;
1782
1783 /* If the cached position is for this buffer, clear it out. */
1784 clear_charpos_cache (current_buffer);
1785
1786 if (NILP (flag))
1787 {
1788 /* Do this first, so it can use CHAR_TO_BYTE
1789 to calculate the old correspondences. */
1790 set_intervals_multibyte (0);
1791
1792 current_buffer->enable_multibyte_characters = Qnil;
1793
1794 Z = Z_BYTE;
1795 BEGV = BEGV_BYTE;
1796 ZV = ZV_BYTE;
1797 GPT = GPT_BYTE;
1798 TEMP_SET_PT_BOTH (PT_BYTE, PT_BYTE);
1799
1800 tail = BUF_MARKERS (current_buffer);
1801 while (XSYMBOL (tail) != XSYMBOL (Qnil))
1802 {
1803 XMARKER (tail)->charpos = XMARKER (tail)->bytepos;
1804 tail = XMARKER (tail)->chain;
1805 }
1806 }
1807 else
1808 {
1809 /* Be sure not to have a multibyte sequence striding over the GAP.
1810 Ex: We change this: "...abc\201\241\241 _GAP_ \241\241\241..."
1811 to: "...abc _GAP_ \201\241\241\241\241\241..." */
1812
1813 if (GPT_BYTE > 1 && GPT_BYTE < Z_BYTE
1814 && ! CHAR_HEAD_P (*(GAP_END_ADDR)))
1815 {
1816 unsigned char *p = GPT_ADDR - 1;
1817
1818 while (! CHAR_HEAD_P (*p) && p > BEG_ADDR) p--;
1819 if (BASE_LEADING_CODE_P (*p))
1820 {
1821 int new_gpt = GPT_BYTE - (GPT_ADDR - p);
1822
1823 move_gap_both (new_gpt, new_gpt);
1824 }
1825 }
1826
1827 /* Do this first, so that chars_in_text asks the right question.
1828 set_intervals_multibyte needs it too. */
1829 current_buffer->enable_multibyte_characters = Qt;
1830
1831 GPT_BYTE = advance_to_char_boundary (GPT_BYTE);
1832 GPT = chars_in_text (BEG_ADDR, GPT_BYTE - BEG_BYTE) + BEG;
1833
1834 Z = chars_in_text (GAP_END_ADDR, Z_BYTE - GPT_BYTE) + GPT;
1835
1836 BEGV_BYTE = advance_to_char_boundary (BEGV_BYTE);
1837 if (BEGV_BYTE > GPT_BYTE)
1838 BEGV = chars_in_text (GAP_END_ADDR, BEGV_BYTE - GPT_BYTE) + GPT;
1839 else
1840 BEGV = chars_in_text (BEG_ADDR, BEGV_BYTE - BEG_BYTE) + BEG;
1841
1842 ZV_BYTE = advance_to_char_boundary (ZV_BYTE);
1843 if (ZV_BYTE > GPT_BYTE)
1844 ZV = chars_in_text (GAP_END_ADDR, ZV_BYTE - GPT_BYTE) + GPT;
1845 else
1846 ZV = chars_in_text (BEG_ADDR, ZV_BYTE - BEG_BYTE) + BEG;
1847
1848 {
1849 int pt_byte = advance_to_char_boundary (PT_BYTE);
1850 int pt;
1851
1852 if (pt_byte > GPT_BYTE)
1853 pt = chars_in_text (GAP_END_ADDR, pt_byte - GPT_BYTE) + GPT;
1854 else
1855 pt = chars_in_text (BEG_ADDR, pt_byte - BEG_BYTE) + BEG;
1856 TEMP_SET_PT_BOTH (pt, pt_byte);
1857 }
1858
1859 tail = markers = BUF_MARKERS (current_buffer);
1860
1861 /* This prevents BYTE_TO_CHAR (that is, buf_bytepos_to_charpos) from
1862 getting confused by the markers that have not yet been updated.
1863 It is also a signal that it should never create a marker. */
1864 BUF_MARKERS (current_buffer) = Qnil;
1865
1866 while (XSYMBOL (tail) != XSYMBOL (Qnil))
1867 {
1868 XMARKER (tail)->bytepos
1869 = advance_to_char_boundary (XMARKER (tail)->bytepos);
1870 XMARKER (tail)->charpos = BYTE_TO_CHAR (XMARKER (tail)->bytepos);
1871
1872 tail = XMARKER (tail)->chain;
1873 }
1874
1875 /* Make sure no markers were put on the chain
1876 while the chain value was incorrect. */
1877 if (! EQ (BUF_MARKERS (current_buffer), Qnil))
1878 abort ();
1879
1880 BUF_MARKERS (current_buffer) = markers;
1881
1882 /* Do this last, so it can calculate the new correspondences
1883 between chars and bytes. */
1884 set_intervals_multibyte (1);
1885 }
1886
1887 /* Changing the multibyteness of a buffer means that all windows
1888 showing that buffer must be updated thoroughly. */
1889 current_buffer->prevent_redisplay_optimizations_p = 1;
1890 ++windows_or_buffers_changed;
1891
1892 /* Copy this buffer's new multibyte status
1893 into all of its indirect buffers. */
1894 for (other = all_buffers; other; other = other->next)
1895 if (other->base_buffer == current_buffer && !NILP (other->name))
1896 {
1897 other->enable_multibyte_characters
1898 = current_buffer->enable_multibyte_characters;
1899 other->prevent_redisplay_optimizations_p = 1;
1900 }
1901
1902 return flag;
1903 }
1904 \f
1905 DEFUN ("kill-all-local-variables", Fkill_all_local_variables, Skill_all_local_variables,
1906 0, 0, 0,
1907 "Switch to Fundamental mode by killing current buffer's local variables.\n\
1908 Most local variable bindings are eliminated so that the default values\n\
1909 become effective once more. Also, the syntax table is set from\n\
1910 `standard-syntax-table', the local keymap is set to nil,\n\
1911 and the abbrev table from `fundamental-mode-abbrev-table'.\n\
1912 This function also forces redisplay of the mode line.\n\
1913 \n\
1914 Every function to select a new major mode starts by\n\
1915 calling this function.\n\n\
1916 As a special exception, local variables whose names have\n\
1917 a non-nil `permanent-local' property are not eliminated by this function.\n\
1918 \n\
1919 The first thing this function does is run\n\
1920 the normal hook `change-major-mode-hook'.")
1921 ()
1922 {
1923 register Lisp_Object alist, sym, tem;
1924 Lisp_Object oalist;
1925
1926 if (!NILP (Vrun_hooks))
1927 call1 (Vrun_hooks, intern ("change-major-mode-hook"));
1928 oalist = current_buffer->local_var_alist;
1929
1930 /* Make sure none of the bindings in oalist
1931 remain swapped in, in their symbols. */
1932
1933 swap_out_buffer_local_variables (current_buffer);
1934
1935 /* Actually eliminate all local bindings of this buffer. */
1936
1937 reset_buffer_local_variables (current_buffer, 0);
1938
1939 /* Redisplay mode lines; we are changing major mode. */
1940
1941 update_mode_lines++;
1942
1943 /* Any which are supposed to be permanent,
1944 make local again, with the same values they had. */
1945
1946 for (alist = oalist; !NILP (alist); alist = XCDR (alist))
1947 {
1948 sym = XCAR (XCAR (alist));
1949 tem = Fget (sym, Qpermanent_local);
1950 if (! NILP (tem))
1951 {
1952 Fmake_local_variable (sym);
1953 Fset (sym, XCDR (XCAR (alist)));
1954 }
1955 }
1956
1957 /* Force mode-line redisplay. Useful here because all major mode
1958 commands call this function. */
1959 update_mode_lines++;
1960
1961 return Qnil;
1962 }
1963
1964 /* Make sure no local variables remain set up with buffer B
1965 for their current values. */
1966
1967 static void
1968 swap_out_buffer_local_variables (b)
1969 struct buffer *b;
1970 {
1971 Lisp_Object oalist, alist, sym, tem, buffer;
1972
1973 XSETBUFFER (buffer, b);
1974 oalist = b->local_var_alist;
1975
1976 for (alist = oalist; !NILP (alist); alist = XCDR (alist))
1977 {
1978 sym = XCAR (XCAR (alist));
1979
1980 /* Need not do anything if some other buffer's binding is now encached. */
1981 tem = XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->buffer;
1982 if (XBUFFER (tem) == current_buffer)
1983 {
1984 /* Symbol is set up for this buffer's old local value.
1985 Set it up for the current buffer with the default value. */
1986
1987 tem = XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->cdr;
1988 /* Store the symbol's current value into the alist entry
1989 it is currently set up for. This is so that, if the
1990 local is marked permanent, and we make it local again
1991 later in Fkill_all_local_variables, we don't lose the value. */
1992 XCDR (XCAR (tem))
1993 = do_symval_forwarding (XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->realvalue);
1994 /* Switch to the symbol's default-value alist entry. */
1995 XCAR (tem) = tem;
1996 /* Mark it as current for buffer B. */
1997 XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->buffer = buffer;
1998 /* Store the current value into any forwarding in the symbol. */
1999 store_symval_forwarding (sym,
2000 XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->realvalue,
2001 XCDR (tem));
2002 }
2003 }
2004 }
2005 \f
2006 /* Find all the overlays in the current buffer that contain position POS.
2007 Return the number found, and store them in a vector in *VEC_PTR.
2008 Store in *LEN_PTR the size allocated for the vector.
2009 Store in *NEXT_PTR the next position after POS where an overlay starts,
2010 or ZV if there are no more overlays.
2011 Store in *PREV_PTR the previous position before POS where an overlay ends,
2012 or where an overlay starts which ends at or after POS;
2013 or BEGV if there are no such overlays.
2014 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
2015
2016 *VEC_PTR and *LEN_PTR should contain a valid vector and size
2017 when this function is called.
2018
2019 If EXTEND is non-zero, we make the vector bigger if necessary.
2020 If EXTEND is zero, we never extend the vector,
2021 and we store only as many overlays as will fit.
2022 But we still return the total number of overlays. */
2023
2024 int
2025 overlays_at (pos, extend, vec_ptr, len_ptr, next_ptr, prev_ptr)
2026 int pos;
2027 int extend;
2028 Lisp_Object **vec_ptr;
2029 int *len_ptr;
2030 int *next_ptr;
2031 int *prev_ptr;
2032 {
2033 Lisp_Object tail, overlay, start, end;
2034 int idx = 0;
2035 int len = *len_ptr;
2036 Lisp_Object *vec = *vec_ptr;
2037 int next = ZV;
2038 int prev = BEGV;
2039 int inhibit_storing = 0;
2040
2041 for (tail = current_buffer->overlays_before;
2042 GC_CONSP (tail);
2043 tail = XCDR (tail))
2044 {
2045 int startpos, endpos;
2046
2047 overlay = XCAR (tail);
2048
2049 start = OVERLAY_START (overlay);
2050 end = OVERLAY_END (overlay);
2051 endpos = OVERLAY_POSITION (end);
2052 if (endpos < pos)
2053 {
2054 if (prev < endpos)
2055 prev = endpos;
2056 break;
2057 }
2058 startpos = OVERLAY_POSITION (start);
2059 /* This one ends at or after POS
2060 so its start counts for PREV_PTR if it's before POS. */
2061 if (prev < startpos && startpos < pos)
2062 prev = startpos;
2063 if (endpos == pos)
2064 continue;
2065 if (startpos <= pos)
2066 {
2067 if (idx == len)
2068 {
2069 /* The supplied vector is full.
2070 Either make it bigger, or don't store any more in it. */
2071 if (extend)
2072 {
2073 /* Make it work with an initial len == 0. */
2074 len *= 2;
2075 if (len == 0)
2076 len = 4;
2077 *len_ptr = len;
2078 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2079 *vec_ptr = vec;
2080 }
2081 else
2082 inhibit_storing = 1;
2083 }
2084
2085 if (!inhibit_storing)
2086 vec[idx] = overlay;
2087 /* Keep counting overlays even if we can't return them all. */
2088 idx++;
2089 }
2090 else if (startpos < next)
2091 next = startpos;
2092 }
2093
2094 for (tail = current_buffer->overlays_after;
2095 GC_CONSP (tail);
2096 tail = XCDR (tail))
2097 {
2098 int startpos, endpos;
2099
2100 overlay = XCAR (tail);
2101
2102 start = OVERLAY_START (overlay);
2103 end = OVERLAY_END (overlay);
2104 startpos = OVERLAY_POSITION (start);
2105 if (pos < startpos)
2106 {
2107 if (startpos < next)
2108 next = startpos;
2109 break;
2110 }
2111 endpos = OVERLAY_POSITION (end);
2112 if (pos < endpos)
2113 {
2114 if (idx == len)
2115 {
2116 if (extend)
2117 {
2118 *len_ptr = len *= 2;
2119 if (len == 0)
2120 len = *len_ptr = 4;
2121 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2122 *vec_ptr = vec;
2123 }
2124 else
2125 inhibit_storing = 1;
2126 }
2127
2128 if (!inhibit_storing)
2129 vec[idx] = overlay;
2130 idx++;
2131
2132 if (startpos < pos && startpos > prev)
2133 prev = startpos;
2134 }
2135 else if (endpos < pos && endpos > prev)
2136 prev = endpos;
2137 else if (endpos == pos && startpos > prev)
2138 prev = startpos;
2139 }
2140
2141 if (next_ptr)
2142 *next_ptr = next;
2143 if (prev_ptr)
2144 *prev_ptr = prev;
2145 return idx;
2146 }
2147 \f
2148 /* Find all the overlays in the current buffer that overlap the range BEG-END
2149 or are empty at BEG.
2150
2151 Return the number found, and store them in a vector in *VEC_PTR.
2152 Store in *LEN_PTR the size allocated for the vector.
2153 Store in *NEXT_PTR the next position after POS where an overlay starts,
2154 or ZV if there are no more overlays.
2155 Store in *PREV_PTR the previous position before POS where an overlay ends,
2156 or BEGV if there are no previous overlays.
2157 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
2158
2159 *VEC_PTR and *LEN_PTR should contain a valid vector and size
2160 when this function is called.
2161
2162 If EXTEND is non-zero, we make the vector bigger if necessary.
2163 If EXTEND is zero, we never extend the vector,
2164 and we store only as many overlays as will fit.
2165 But we still return the total number of overlays. */
2166
2167 int
2168 overlays_in (beg, end, extend, vec_ptr, len_ptr, next_ptr, prev_ptr)
2169 int beg, end;
2170 int extend;
2171 Lisp_Object **vec_ptr;
2172 int *len_ptr;
2173 int *next_ptr;
2174 int *prev_ptr;
2175 {
2176 Lisp_Object tail, overlay, ostart, oend;
2177 int idx = 0;
2178 int len = *len_ptr;
2179 Lisp_Object *vec = *vec_ptr;
2180 int next = ZV;
2181 int prev = BEGV;
2182 int inhibit_storing = 0;
2183
2184 for (tail = current_buffer->overlays_before;
2185 GC_CONSP (tail);
2186 tail = XCDR (tail))
2187 {
2188 int startpos, endpos;
2189
2190 overlay = XCAR (tail);
2191
2192 ostart = OVERLAY_START (overlay);
2193 oend = OVERLAY_END (overlay);
2194 endpos = OVERLAY_POSITION (oend);
2195 if (endpos < beg)
2196 {
2197 if (prev < endpos)
2198 prev = endpos;
2199 break;
2200 }
2201 startpos = OVERLAY_POSITION (ostart);
2202 /* Count an interval if it either overlaps the range
2203 or is empty at the start of the range. */
2204 if ((beg < endpos && startpos < end)
2205 || (startpos == endpos && beg == endpos))
2206 {
2207 if (idx == len)
2208 {
2209 /* The supplied vector is full.
2210 Either make it bigger, or don't store any more in it. */
2211 if (extend)
2212 {
2213 *len_ptr = len *= 2;
2214 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2215 *vec_ptr = vec;
2216 }
2217 else
2218 inhibit_storing = 1;
2219 }
2220
2221 if (!inhibit_storing)
2222 vec[idx] = overlay;
2223 /* Keep counting overlays even if we can't return them all. */
2224 idx++;
2225 }
2226 else if (startpos < next)
2227 next = startpos;
2228 }
2229
2230 for (tail = current_buffer->overlays_after;
2231 GC_CONSP (tail);
2232 tail = XCDR (tail))
2233 {
2234 int startpos, endpos;
2235
2236 overlay = XCAR (tail);
2237
2238 ostart = OVERLAY_START (overlay);
2239 oend = OVERLAY_END (overlay);
2240 startpos = OVERLAY_POSITION (ostart);
2241 if (end < startpos)
2242 {
2243 if (startpos < next)
2244 next = startpos;
2245 break;
2246 }
2247 endpos = OVERLAY_POSITION (oend);
2248 /* Count an interval if it either overlaps the range
2249 or is empty at the start of the range. */
2250 if ((beg < endpos && startpos < end)
2251 || (startpos == endpos && beg == endpos))
2252 {
2253 if (idx == len)
2254 {
2255 if (extend)
2256 {
2257 *len_ptr = len *= 2;
2258 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2259 *vec_ptr = vec;
2260 }
2261 else
2262 inhibit_storing = 1;
2263 }
2264
2265 if (!inhibit_storing)
2266 vec[idx] = overlay;
2267 idx++;
2268 }
2269 else if (endpos < beg && endpos > prev)
2270 prev = endpos;
2271 }
2272
2273 if (next_ptr)
2274 *next_ptr = next;
2275 if (prev_ptr)
2276 *prev_ptr = prev;
2277 return idx;
2278 }
2279 \f
2280 /* Fast function to just test if we're at an overlay boundary. */
2281 int
2282 overlay_touches_p (pos)
2283 int pos;
2284 {
2285 Lisp_Object tail, overlay;
2286
2287 for (tail = current_buffer->overlays_before; GC_CONSP (tail);
2288 tail = XCDR (tail))
2289 {
2290 int endpos;
2291
2292 overlay = XCAR (tail);
2293 if (!GC_OVERLAYP (overlay))
2294 abort ();
2295
2296 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2297 if (endpos < pos)
2298 break;
2299 if (endpos == pos || OVERLAY_POSITION (OVERLAY_START (overlay)) == pos)
2300 return 1;
2301 }
2302
2303 for (tail = current_buffer->overlays_after; GC_CONSP (tail);
2304 tail = XCDR (tail))
2305 {
2306 int startpos;
2307
2308 overlay = XCAR (tail);
2309 if (!GC_OVERLAYP (overlay))
2310 abort ();
2311
2312 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2313 if (pos < startpos)
2314 break;
2315 if (startpos == pos || OVERLAY_POSITION (OVERLAY_END (overlay)) == pos)
2316 return 1;
2317 }
2318 return 0;
2319 }
2320 \f
2321 struct sortvec
2322 {
2323 Lisp_Object overlay;
2324 int beg, end;
2325 int priority;
2326 };
2327
2328 static int
2329 compare_overlays (v1, v2)
2330 const void *v1, *v2;
2331 {
2332 const struct sortvec *s1 = (const struct sortvec *) v1;
2333 const struct sortvec *s2 = (const struct sortvec *) v2;
2334 if (s1->priority != s2->priority)
2335 return s1->priority - s2->priority;
2336 if (s1->beg != s2->beg)
2337 return s1->beg - s2->beg;
2338 if (s1->end != s2->end)
2339 return s2->end - s1->end;
2340 return 0;
2341 }
2342
2343 /* Sort an array of overlays by priority. The array is modified in place.
2344 The return value is the new size; this may be smaller than the original
2345 size if some of the overlays were invalid or were window-specific. */
2346 int
2347 sort_overlays (overlay_vec, noverlays, w)
2348 Lisp_Object *overlay_vec;
2349 int noverlays;
2350 struct window *w;
2351 {
2352 int i, j;
2353 struct sortvec *sortvec;
2354 sortvec = (struct sortvec *) alloca (noverlays * sizeof (struct sortvec));
2355
2356 /* Put the valid and relevant overlays into sortvec. */
2357
2358 for (i = 0, j = 0; i < noverlays; i++)
2359 {
2360 Lisp_Object tem;
2361 Lisp_Object overlay;
2362
2363 overlay = overlay_vec[i];
2364 if (OVERLAY_VALID (overlay)
2365 && OVERLAY_POSITION (OVERLAY_START (overlay)) > 0
2366 && OVERLAY_POSITION (OVERLAY_END (overlay)) > 0)
2367 {
2368 /* If we're interested in a specific window, then ignore
2369 overlays that are limited to some other window. */
2370 if (w)
2371 {
2372 Lisp_Object window;
2373
2374 window = Foverlay_get (overlay, Qwindow);
2375 if (WINDOWP (window) && XWINDOW (window) != w)
2376 continue;
2377 }
2378
2379 /* This overlay is good and counts: put it into sortvec. */
2380 sortvec[j].overlay = overlay;
2381 sortvec[j].beg = OVERLAY_POSITION (OVERLAY_START (overlay));
2382 sortvec[j].end = OVERLAY_POSITION (OVERLAY_END (overlay));
2383 tem = Foverlay_get (overlay, Qpriority);
2384 if (INTEGERP (tem))
2385 sortvec[j].priority = XINT (tem);
2386 else
2387 sortvec[j].priority = 0;
2388 j++;
2389 }
2390 }
2391 noverlays = j;
2392
2393 /* Sort the overlays into the proper order: increasing priority. */
2394
2395 if (noverlays > 1)
2396 qsort (sortvec, noverlays, sizeof (struct sortvec), compare_overlays);
2397
2398 for (i = 0; i < noverlays; i++)
2399 overlay_vec[i] = sortvec[i].overlay;
2400 return (noverlays);
2401 }
2402 \f
2403 struct sortstr
2404 {
2405 Lisp_Object string, string2;
2406 int size;
2407 int priority;
2408 };
2409
2410 struct sortstrlist
2411 {
2412 struct sortstr *buf; /* An array that expands as needed; never freed. */
2413 int size; /* Allocated length of that array. */
2414 int used; /* How much of the array is currently in use. */
2415 int bytes; /* Total length of the strings in buf. */
2416 };
2417
2418 /* Buffers for storing information about the overlays touching a given
2419 position. These could be automatic variables in overlay_strings, but
2420 it's more efficient to hold onto the memory instead of repeatedly
2421 allocating and freeing it. */
2422 static struct sortstrlist overlay_heads, overlay_tails;
2423 static unsigned char *overlay_str_buf;
2424
2425 /* Allocated length of overlay_str_buf. */
2426 static int overlay_str_len;
2427
2428 /* A comparison function suitable for passing to qsort. */
2429 static int
2430 cmp_for_strings (as1, as2)
2431 char *as1, *as2;
2432 {
2433 struct sortstr *s1 = (struct sortstr *)as1;
2434 struct sortstr *s2 = (struct sortstr *)as2;
2435 if (s1->size != s2->size)
2436 return s2->size - s1->size;
2437 if (s1->priority != s2->priority)
2438 return s1->priority - s2->priority;
2439 return 0;
2440 }
2441
2442 static void
2443 record_overlay_string (ssl, str, str2, pri, size)
2444 struct sortstrlist *ssl;
2445 Lisp_Object str, str2, pri;
2446 int size;
2447 {
2448 int nbytes;
2449
2450 if (ssl->used == ssl->size)
2451 {
2452 if (ssl->buf)
2453 ssl->size *= 2;
2454 else
2455 ssl->size = 5;
2456 ssl->buf = ((struct sortstr *)
2457 xrealloc (ssl->buf, ssl->size * sizeof (struct sortstr)));
2458 }
2459 ssl->buf[ssl->used].string = str;
2460 ssl->buf[ssl->used].string2 = str2;
2461 ssl->buf[ssl->used].size = size;
2462 ssl->buf[ssl->used].priority = (INTEGERP (pri) ? XINT (pri) : 0);
2463 ssl->used++;
2464
2465 if (NILP (current_buffer->enable_multibyte_characters))
2466 nbytes = XSTRING (str)->size;
2467 else if (! STRING_MULTIBYTE (str))
2468 nbytes = count_size_as_multibyte (XSTRING (str)->data,
2469 STRING_BYTES (XSTRING (str)));
2470 else
2471 nbytes = STRING_BYTES (XSTRING (str));
2472
2473 ssl->bytes += nbytes;
2474
2475 if (STRINGP (str2))
2476 {
2477 if (NILP (current_buffer->enable_multibyte_characters))
2478 nbytes = XSTRING (str2)->size;
2479 else if (! STRING_MULTIBYTE (str2))
2480 nbytes = count_size_as_multibyte (XSTRING (str2)->data,
2481 STRING_BYTES (XSTRING (str2)));
2482 else
2483 nbytes = STRING_BYTES (XSTRING (str2));
2484
2485 ssl->bytes += nbytes;
2486 }
2487 }
2488
2489 /* Return the concatenation of the strings associated with overlays that
2490 begin or end at POS, ignoring overlays that are specific to a window
2491 other than W. The strings are concatenated in the appropriate order:
2492 shorter overlays nest inside longer ones, and higher priority inside
2493 lower. Normally all of the after-strings come first, but zero-sized
2494 overlays have their after-strings ride along with the before-strings
2495 because it would look strange to print them inside-out.
2496
2497 Returns the string length, and stores the contents indirectly through
2498 PSTR, if that variable is non-null. The string may be overwritten by
2499 subsequent calls. */
2500
2501 int
2502 overlay_strings (pos, w, pstr)
2503 int pos;
2504 struct window *w;
2505 unsigned char **pstr;
2506 {
2507 Lisp_Object ov, overlay, window, str;
2508 int startpos, endpos;
2509 int multibyte = ! NILP (current_buffer->enable_multibyte_characters);
2510
2511 overlay_heads.used = overlay_heads.bytes = 0;
2512 overlay_tails.used = overlay_tails.bytes = 0;
2513 for (ov = current_buffer->overlays_before; CONSP (ov); ov = XCDR (ov))
2514 {
2515 overlay = XCAR (ov);
2516 if (!OVERLAYP (overlay))
2517 abort ();
2518
2519 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2520 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2521 if (endpos < pos)
2522 break;
2523 if (endpos != pos && startpos != pos)
2524 continue;
2525 window = Foverlay_get (overlay, Qwindow);
2526 if (WINDOWP (window) && XWINDOW (window) != w)
2527 continue;
2528 if (startpos == pos
2529 && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
2530 record_overlay_string (&overlay_heads, str,
2531 (startpos == endpos
2532 ? Foverlay_get (overlay, Qafter_string)
2533 : Qnil),
2534 Foverlay_get (overlay, Qpriority),
2535 endpos - startpos);
2536 else if (endpos == pos
2537 && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
2538 record_overlay_string (&overlay_tails, str, Qnil,
2539 Foverlay_get (overlay, Qpriority),
2540 endpos - startpos);
2541 }
2542 for (ov = current_buffer->overlays_after; CONSP (ov); ov = XCDR (ov))
2543 {
2544 overlay = XCAR (ov);
2545 if (!OVERLAYP (overlay))
2546 abort ();
2547
2548 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2549 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2550 if (startpos > pos)
2551 break;
2552 if (endpos != pos && startpos != pos)
2553 continue;
2554 window = Foverlay_get (overlay, Qwindow);
2555 if (WINDOWP (window) && XWINDOW (window) != w)
2556 continue;
2557 if (startpos == pos
2558 && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
2559 record_overlay_string (&overlay_heads, str,
2560 (startpos == endpos
2561 ? Foverlay_get (overlay, Qafter_string)
2562 : Qnil),
2563 Foverlay_get (overlay, Qpriority),
2564 endpos - startpos);
2565 else if (endpos == pos
2566 && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
2567 record_overlay_string (&overlay_tails, str, Qnil,
2568 Foverlay_get (overlay, Qpriority),
2569 endpos - startpos);
2570 }
2571 if (overlay_tails.used > 1)
2572 qsort (overlay_tails.buf, overlay_tails.used, sizeof (struct sortstr),
2573 cmp_for_strings);
2574 if (overlay_heads.used > 1)
2575 qsort (overlay_heads.buf, overlay_heads.used, sizeof (struct sortstr),
2576 cmp_for_strings);
2577 if (overlay_heads.bytes || overlay_tails.bytes)
2578 {
2579 Lisp_Object tem;
2580 int i;
2581 unsigned char *p;
2582 int total = overlay_heads.bytes + overlay_tails.bytes;
2583
2584 if (total > overlay_str_len)
2585 {
2586 overlay_str_len = total;
2587 overlay_str_buf = (unsigned char *)xrealloc (overlay_str_buf,
2588 total);
2589 }
2590 p = overlay_str_buf;
2591 for (i = overlay_tails.used; --i >= 0;)
2592 {
2593 int nbytes;
2594 tem = overlay_tails.buf[i].string;
2595 nbytes = copy_text (XSTRING (tem)->data, p,
2596 STRING_BYTES (XSTRING (tem)),
2597 STRING_MULTIBYTE (tem), multibyte);
2598 p += nbytes;
2599 }
2600 for (i = 0; i < overlay_heads.used; ++i)
2601 {
2602 int nbytes;
2603 tem = overlay_heads.buf[i].string;
2604 nbytes = copy_text (XSTRING (tem)->data, p,
2605 STRING_BYTES (XSTRING (tem)),
2606 STRING_MULTIBYTE (tem), multibyte);
2607 p += nbytes;
2608 tem = overlay_heads.buf[i].string2;
2609 if (STRINGP (tem))
2610 {
2611 nbytes = copy_text (XSTRING (tem)->data, p,
2612 STRING_BYTES (XSTRING (tem)),
2613 STRING_MULTIBYTE (tem), multibyte);
2614 p += nbytes;
2615 }
2616 }
2617 if (p != overlay_str_buf + total)
2618 abort ();
2619 if (pstr)
2620 *pstr = overlay_str_buf;
2621 return total;
2622 }
2623 return 0;
2624 }
2625 \f
2626 /* Shift overlays in BUF's overlay lists, to center the lists at POS. */
2627
2628 void
2629 recenter_overlay_lists (buf, pos)
2630 struct buffer *buf;
2631 int pos;
2632 {
2633 Lisp_Object overlay, tail, next, prev, beg, end;
2634
2635 /* See if anything in overlays_before should move to overlays_after. */
2636
2637 /* We don't strictly need prev in this loop; it should always be nil.
2638 But we use it for symmetry and in case that should cease to be true
2639 with some future change. */
2640 prev = Qnil;
2641 for (tail = buf->overlays_before;
2642 CONSP (tail);
2643 prev = tail, tail = next)
2644 {
2645 next = XCDR (tail);
2646 overlay = XCAR (tail);
2647
2648 /* If the overlay is not valid, get rid of it. */
2649 if (!OVERLAY_VALID (overlay))
2650 #if 1
2651 abort ();
2652 #else
2653 {
2654 /* Splice the cons cell TAIL out of overlays_before. */
2655 if (!NILP (prev))
2656 XCDR (prev) = next;
2657 else
2658 buf->overlays_before = next;
2659 tail = prev;
2660 continue;
2661 }
2662 #endif
2663
2664 beg = OVERLAY_START (overlay);
2665 end = OVERLAY_END (overlay);
2666
2667 if (OVERLAY_POSITION (end) > pos)
2668 {
2669 /* OVERLAY needs to be moved. */
2670 int where = OVERLAY_POSITION (beg);
2671 Lisp_Object other, other_prev;
2672
2673 /* Splice the cons cell TAIL out of overlays_before. */
2674 if (!NILP (prev))
2675 XCDR (prev) = next;
2676 else
2677 buf->overlays_before = next;
2678
2679 /* Search thru overlays_after for where to put it. */
2680 other_prev = Qnil;
2681 for (other = buf->overlays_after;
2682 CONSP (other);
2683 other_prev = other, other = XCDR (other))
2684 {
2685 Lisp_Object otherbeg, otheroverlay;
2686
2687 otheroverlay = XCAR (other);
2688 if (! OVERLAY_VALID (otheroverlay))
2689 abort ();
2690
2691 otherbeg = OVERLAY_START (otheroverlay);
2692 if (OVERLAY_POSITION (otherbeg) >= where)
2693 break;
2694 }
2695
2696 /* Add TAIL to overlays_after before OTHER. */
2697 XCDR (tail) = other;
2698 if (!NILP (other_prev))
2699 XCDR (other_prev) = tail;
2700 else
2701 buf->overlays_after = tail;
2702 tail = prev;
2703 }
2704 else
2705 /* We've reached the things that should stay in overlays_before.
2706 All the rest of overlays_before must end even earlier,
2707 so stop now. */
2708 break;
2709 }
2710
2711 /* See if anything in overlays_after should be in overlays_before. */
2712 prev = Qnil;
2713 for (tail = buf->overlays_after;
2714 CONSP (tail);
2715 prev = tail, tail = next)
2716 {
2717 next = XCDR (tail);
2718 overlay = XCAR (tail);
2719
2720 /* If the overlay is not valid, get rid of it. */
2721 if (!OVERLAY_VALID (overlay))
2722 #if 1
2723 abort ();
2724 #else
2725 {
2726 /* Splice the cons cell TAIL out of overlays_after. */
2727 if (!NILP (prev))
2728 XCDR (prev) = next;
2729 else
2730 buf->overlays_after = next;
2731 tail = prev;
2732 continue;
2733 }
2734 #endif
2735
2736 beg = OVERLAY_START (overlay);
2737 end = OVERLAY_END (overlay);
2738
2739 /* Stop looking, when we know that nothing further
2740 can possibly end before POS. */
2741 if (OVERLAY_POSITION (beg) > pos)
2742 break;
2743
2744 if (OVERLAY_POSITION (end) <= pos)
2745 {
2746 /* OVERLAY needs to be moved. */
2747 int where = OVERLAY_POSITION (end);
2748 Lisp_Object other, other_prev;
2749
2750 /* Splice the cons cell TAIL out of overlays_after. */
2751 if (!NILP (prev))
2752 XCDR (prev) = next;
2753 else
2754 buf->overlays_after = next;
2755
2756 /* Search thru overlays_before for where to put it. */
2757 other_prev = Qnil;
2758 for (other = buf->overlays_before;
2759 CONSP (other);
2760 other_prev = other, other = XCDR (other))
2761 {
2762 Lisp_Object otherend, otheroverlay;
2763
2764 otheroverlay = XCAR (other);
2765 if (! OVERLAY_VALID (otheroverlay))
2766 abort ();
2767
2768 otherend = OVERLAY_END (otheroverlay);
2769 if (OVERLAY_POSITION (otherend) <= where)
2770 break;
2771 }
2772
2773 /* Add TAIL to overlays_before before OTHER. */
2774 XCDR (tail) = other;
2775 if (!NILP (other_prev))
2776 XCDR (other_prev) = tail;
2777 else
2778 buf->overlays_before = tail;
2779 tail = prev;
2780 }
2781 }
2782
2783 XSETFASTINT (buf->overlay_center, pos);
2784 }
2785
2786 void
2787 adjust_overlays_for_insert (pos, length)
2788 int pos;
2789 int length;
2790 {
2791 /* After an insertion, the lists are still sorted properly,
2792 but we may need to update the value of the overlay center. */
2793 if (XFASTINT (current_buffer->overlay_center) >= pos)
2794 XSETFASTINT (current_buffer->overlay_center,
2795 XFASTINT (current_buffer->overlay_center) + length);
2796 }
2797
2798 void
2799 adjust_overlays_for_delete (pos, length)
2800 int pos;
2801 int length;
2802 {
2803 if (XFASTINT (current_buffer->overlay_center) < pos)
2804 /* The deletion was to our right. No change needed; the before- and
2805 after-lists are still consistent. */
2806 ;
2807 else if (XFASTINT (current_buffer->overlay_center) > pos + length)
2808 /* The deletion was to our left. We need to adjust the center value
2809 to account for the change in position, but the lists are consistent
2810 given the new value. */
2811 XSETFASTINT (current_buffer->overlay_center,
2812 XFASTINT (current_buffer->overlay_center) - length);
2813 else
2814 /* We're right in the middle. There might be things on the after-list
2815 that now belong on the before-list. Recentering will move them,
2816 and also update the center point. */
2817 recenter_overlay_lists (current_buffer, pos);
2818 }
2819
2820 /* Fix up overlays that were garbled as a result of permuting markers
2821 in the range START through END. Any overlay with at least one
2822 endpoint in this range will need to be unlinked from the overlay
2823 list and reinserted in its proper place.
2824 Such an overlay might even have negative size at this point.
2825 If so, we'll reverse the endpoints. Can you think of anything
2826 better to do in this situation? */
2827 void
2828 fix_overlays_in_range (start, end)
2829 register int start, end;
2830 {
2831 Lisp_Object overlay;
2832 Lisp_Object before_list, after_list;
2833 Lisp_Object *ptail, *pbefore = &before_list, *pafter = &after_list;
2834 int startpos, endpos;
2835
2836 /* This algorithm shifts links around instead of consing and GCing.
2837 The loop invariant is that before_list (resp. after_list) is a
2838 well-formed list except that its last element, the one that
2839 *pbefore (resp. *pafter) points to, is still uninitialized.
2840 So it's not a bug that before_list isn't initialized, although
2841 it may look strange. */
2842 for (ptail = &current_buffer->overlays_before; CONSP (*ptail);)
2843 {
2844 overlay = XCAR (*ptail);
2845 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2846 if (endpos < start)
2847 break;
2848 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2849 if (endpos < end
2850 || (startpos >= start && startpos < end))
2851 {
2852 /* If the overlay is backwards, fix that now. */
2853 if (startpos > endpos)
2854 {
2855 int tem;
2856 Fset_marker (OVERLAY_START (overlay), make_number (endpos),
2857 Qnil);
2858 Fset_marker (OVERLAY_END (overlay), make_number (startpos),
2859 Qnil);
2860 tem = startpos; startpos = endpos; endpos = tem;
2861 }
2862 /* Add it to the end of the wrong list. Later on,
2863 recenter_overlay_lists will move it to the right place. */
2864 if (endpos < XINT (current_buffer->overlay_center))
2865 {
2866 *pafter = *ptail;
2867 pafter = &XCDR (*ptail);
2868 }
2869 else
2870 {
2871 *pbefore = *ptail;
2872 pbefore = &XCDR (*ptail);
2873 }
2874 *ptail = XCDR (*ptail);
2875 }
2876 else
2877 ptail = &XCDR (*ptail);
2878 }
2879 for (ptail = &current_buffer->overlays_after; CONSP (*ptail);)
2880 {
2881 overlay = XCAR (*ptail);
2882 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2883 if (startpos >= end)
2884 break;
2885 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2886 if (startpos >= start
2887 || (endpos >= start && endpos < end))
2888 {
2889 if (startpos > endpos)
2890 {
2891 int tem;
2892 Fset_marker (OVERLAY_START (overlay), make_number (endpos),
2893 Qnil);
2894 Fset_marker (OVERLAY_END (overlay), make_number (startpos),
2895 Qnil);
2896 tem = startpos; startpos = endpos; endpos = tem;
2897 }
2898 if (endpos < XINT (current_buffer->overlay_center))
2899 {
2900 *pafter = *ptail;
2901 pafter = &XCDR (*ptail);
2902 }
2903 else
2904 {
2905 *pbefore = *ptail;
2906 pbefore = &XCDR (*ptail);
2907 }
2908 *ptail = XCDR (*ptail);
2909 }
2910 else
2911 ptail = &XCDR (*ptail);
2912 }
2913
2914 /* Splice the constructed (wrong) lists into the buffer's lists,
2915 and let the recenter function make it sane again. */
2916 *pbefore = current_buffer->overlays_before;
2917 current_buffer->overlays_before = before_list;
2918 recenter_overlay_lists (current_buffer,
2919 XINT (current_buffer->overlay_center));
2920
2921 *pafter = current_buffer->overlays_after;
2922 current_buffer->overlays_after = after_list;
2923 recenter_overlay_lists (current_buffer,
2924 XINT (current_buffer->overlay_center));
2925 }
2926
2927 /* We have two types of overlay: the one whose ending marker is
2928 after-insertion-marker (this is the usual case) and the one whose
2929 ending marker is before-insertion-marker. When `overlays_before'
2930 contains overlays of the latter type and the former type in this
2931 order and both overlays end at inserting position, inserting a text
2932 increases only the ending marker of the latter type, which results
2933 in incorrect ordering of `overlays_before'.
2934
2935 This function fixes ordering of overlays in the slot
2936 `overlays_before' of the buffer *BP. Before the insertion, `point'
2937 was at PREV, and now is at POS. */
2938
2939 void
2940 fix_overlays_before (bp, prev, pos)
2941 struct buffer *bp;
2942 int prev, pos;
2943 {
2944 Lisp_Object *tailp = &bp->overlays_before;
2945 Lisp_Object *right_place;
2946 int end;
2947
2948 /* After the insertion, the several overlays may be in incorrect
2949 order. The possibility is that, in the list `overlays_before',
2950 an overlay which ends at POS appears after an overlay which ends
2951 at PREV. Since POS is greater than PREV, we must fix the
2952 ordering of these overlays, by moving overlays ends at POS before
2953 the overlays ends at PREV. */
2954
2955 /* At first, find a place where disordered overlays should be linked
2956 in. It is where an overlay which end before POS exists. (i.e. an
2957 overlay whose ending marker is after-insertion-marker if disorder
2958 exists). */
2959 while (!NILP (*tailp)
2960 && ((end = OVERLAY_POSITION (OVERLAY_END (XCAR (*tailp))))
2961 >= pos))
2962 tailp = &XCDR (*tailp);
2963
2964 /* If we don't find such an overlay,
2965 or the found one ends before PREV,
2966 or the found one is the last one in the list,
2967 we don't have to fix anything. */
2968 if (NILP (*tailp)
2969 || end < prev
2970 || NILP (XCDR (*tailp)))
2971 return;
2972
2973 right_place = tailp;
2974 tailp = &XCDR (*tailp);
2975
2976 /* Now, end position of overlays in the list *TAILP should be before
2977 or equal to PREV. In the loop, an overlay which ends at POS is
2978 moved ahead to the place pointed by RIGHT_PLACE. If we found an
2979 overlay which ends before PREV, the remaining overlays are in
2980 correct order. */
2981 while (!NILP (*tailp))
2982 {
2983 end = OVERLAY_POSITION (OVERLAY_END (XCAR (*tailp)));
2984
2985 if (end == pos)
2986 { /* This overlay is disordered. */
2987 Lisp_Object found = *tailp;
2988
2989 /* Unlink the found overlay. */
2990 *tailp = XCDR (found);
2991 /* Move an overlay at RIGHT_PLACE to the next of the found one. */
2992 XCDR (found) = *right_place;
2993 /* Link it into the right place. */
2994 *right_place = found;
2995 }
2996 else if (end == prev)
2997 tailp = &XCDR (*tailp);
2998 else /* No more disordered overlay. */
2999 break;
3000 }
3001 }
3002 \f
3003 DEFUN ("overlayp", Foverlayp, Soverlayp, 1, 1, 0,
3004 "Return t if OBJECT is an overlay.")
3005 (object)
3006 Lisp_Object object;
3007 {
3008 return (OVERLAYP (object) ? Qt : Qnil);
3009 }
3010
3011 DEFUN ("make-overlay", Fmake_overlay, Smake_overlay, 2, 5, 0,
3012 "Create a new overlay with range BEG to END in BUFFER.\n\
3013 If omitted, BUFFER defaults to the current buffer.\n\
3014 BEG and END may be integers or markers.\n\
3015 The fourth arg FRONT-ADVANCE, if non-nil, makes the\n\
3016 front delimiter advance when text is inserted there.\n\
3017 The fifth arg REAR-ADVANCE, if non-nil, makes the\n\
3018 rear delimiter advance when text is inserted there.")
3019 (beg, end, buffer, front_advance, rear_advance)
3020 Lisp_Object beg, end, buffer;
3021 Lisp_Object front_advance, rear_advance;
3022 {
3023 Lisp_Object overlay;
3024 struct buffer *b;
3025
3026 if (NILP (buffer))
3027 XSETBUFFER (buffer, current_buffer);
3028 else
3029 CHECK_BUFFER (buffer, 2);
3030 if (MARKERP (beg)
3031 && ! EQ (Fmarker_buffer (beg), buffer))
3032 error ("Marker points into wrong buffer");
3033 if (MARKERP (end)
3034 && ! EQ (Fmarker_buffer (end), buffer))
3035 error ("Marker points into wrong buffer");
3036
3037 CHECK_NUMBER_COERCE_MARKER (beg, 1);
3038 CHECK_NUMBER_COERCE_MARKER (end, 1);
3039
3040 if (XINT (beg) > XINT (end))
3041 {
3042 Lisp_Object temp;
3043 temp = beg; beg = end; end = temp;
3044 }
3045
3046 b = XBUFFER (buffer);
3047
3048 beg = Fset_marker (Fmake_marker (), beg, buffer);
3049 end = Fset_marker (Fmake_marker (), end, buffer);
3050
3051 if (!NILP (front_advance))
3052 XMARKER (beg)->insertion_type = 1;
3053 if (!NILP (rear_advance))
3054 XMARKER (end)->insertion_type = 1;
3055
3056 overlay = allocate_misc ();
3057 XMISCTYPE (overlay) = Lisp_Misc_Overlay;
3058 XOVERLAY (overlay)->start = beg;
3059 XOVERLAY (overlay)->end = end;
3060 XOVERLAY (overlay)->plist = Qnil;
3061
3062 /* Put the new overlay on the wrong list. */
3063 end = OVERLAY_END (overlay);
3064 if (OVERLAY_POSITION (end) < XINT (b->overlay_center))
3065 b->overlays_after = Fcons (overlay, b->overlays_after);
3066 else
3067 b->overlays_before = Fcons (overlay, b->overlays_before);
3068
3069 /* This puts it in the right list, and in the right order. */
3070 recenter_overlay_lists (b, XINT (b->overlay_center));
3071
3072 /* We don't need to redisplay the region covered by the overlay, because
3073 the overlay has no properties at the moment. */
3074
3075 return overlay;
3076 }
3077 \f
3078 /* Mark a section of BUF as needing redisplay because of overlays changes. */
3079
3080 static void
3081 modify_overlay (buf, start, end)
3082 struct buffer *buf;
3083 int start, end;
3084 {
3085 if (start == end)
3086 return;
3087
3088 if (start > end)
3089 {
3090 int temp = start;
3091 start = end; end = temp;
3092 }
3093
3094 BUF_COMPUTE_UNCHANGED (buf, start, end);
3095
3096 /* If this is a buffer not in the selected window,
3097 we must do other windows. */
3098 if (buf != XBUFFER (XWINDOW (selected_window)->buffer))
3099 windows_or_buffers_changed = 1;
3100 /* If multiple windows show this buffer, we must do other windows. */
3101 else if (buffer_shared > 1)
3102 windows_or_buffers_changed = 1;
3103
3104 ++BUF_OVERLAY_MODIFF (buf);
3105 }
3106
3107 \f\f
3108 Lisp_Object Fdelete_overlay ();
3109
3110 DEFUN ("move-overlay", Fmove_overlay, Smove_overlay, 3, 4, 0,
3111 "Set the endpoints of OVERLAY to BEG and END in BUFFER.\n\
3112 If BUFFER is omitted, leave OVERLAY in the same buffer it inhabits now.\n\
3113 If BUFFER is omitted, and OVERLAY is in no buffer, put it in the current\n\
3114 buffer.")
3115 (overlay, beg, end, buffer)
3116 Lisp_Object overlay, beg, end, buffer;
3117 {
3118 struct buffer *b, *ob;
3119 Lisp_Object obuffer;
3120 int count = specpdl_ptr - specpdl;
3121
3122 CHECK_OVERLAY (overlay, 0);
3123 if (NILP (buffer))
3124 buffer = Fmarker_buffer (OVERLAY_START (overlay));
3125 if (NILP (buffer))
3126 XSETBUFFER (buffer, current_buffer);
3127 CHECK_BUFFER (buffer, 3);
3128
3129 if (MARKERP (beg)
3130 && ! EQ (Fmarker_buffer (beg), buffer))
3131 error ("Marker points into wrong buffer");
3132 if (MARKERP (end)
3133 && ! EQ (Fmarker_buffer (end), buffer))
3134 error ("Marker points into wrong buffer");
3135
3136 CHECK_NUMBER_COERCE_MARKER (beg, 1);
3137 CHECK_NUMBER_COERCE_MARKER (end, 1);
3138
3139 if (XINT (beg) == XINT (end) && ! NILP (Foverlay_get (overlay, Qevaporate)))
3140 return Fdelete_overlay (overlay);
3141
3142 if (XINT (beg) > XINT (end))
3143 {
3144 Lisp_Object temp;
3145 temp = beg; beg = end; end = temp;
3146 }
3147
3148 specbind (Qinhibit_quit, Qt);
3149
3150 obuffer = Fmarker_buffer (OVERLAY_START (overlay));
3151 b = XBUFFER (buffer);
3152 ob = XBUFFER (obuffer);
3153
3154 /* If the overlay has changed buffers, do a thorough redisplay. */
3155 if (!EQ (buffer, obuffer))
3156 {
3157 /* Redisplay where the overlay was. */
3158 if (!NILP (obuffer))
3159 {
3160 int o_beg;
3161 int o_end;
3162
3163 o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
3164 o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
3165
3166 modify_overlay (ob, o_beg, o_end);
3167 }
3168
3169 /* Redisplay where the overlay is going to be. */
3170 modify_overlay (b, XINT (beg), XINT (end));
3171 }
3172 else
3173 /* Redisplay the area the overlay has just left, or just enclosed. */
3174 {
3175 int o_beg, o_end;
3176
3177 o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
3178 o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
3179
3180 if (o_beg == XINT (beg))
3181 modify_overlay (b, o_end, XINT (end));
3182 else if (o_end == XINT (end))
3183 modify_overlay (b, o_beg, XINT (beg));
3184 else
3185 {
3186 if (XINT (beg) < o_beg) o_beg = XINT (beg);
3187 if (XINT (end) > o_end) o_end = XINT (end);
3188 modify_overlay (b, o_beg, o_end);
3189 }
3190 }
3191
3192 if (!NILP (obuffer))
3193 {
3194 ob->overlays_before = Fdelq (overlay, ob->overlays_before);
3195 ob->overlays_after = Fdelq (overlay, ob->overlays_after);
3196 }
3197
3198 Fset_marker (OVERLAY_START (overlay), beg, buffer);
3199 Fset_marker (OVERLAY_END (overlay), end, buffer);
3200
3201 /* Put the overlay on the wrong list. */
3202 end = OVERLAY_END (overlay);
3203 if (OVERLAY_POSITION (end) < XINT (b->overlay_center))
3204 b->overlays_after = Fcons (overlay, b->overlays_after);
3205 else
3206 b->overlays_before = Fcons (overlay, b->overlays_before);
3207
3208 /* This puts it in the right list, and in the right order. */
3209 recenter_overlay_lists (b, XINT (b->overlay_center));
3210
3211 return unbind_to (count, overlay);
3212 }
3213
3214 DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0,
3215 "Delete the overlay OVERLAY from its buffer.")
3216 (overlay)
3217 Lisp_Object overlay;
3218 {
3219 Lisp_Object buffer;
3220 struct buffer *b;
3221 int count = specpdl_ptr - specpdl;
3222
3223 CHECK_OVERLAY (overlay, 0);
3224
3225 buffer = Fmarker_buffer (OVERLAY_START (overlay));
3226 if (NILP (buffer))
3227 return Qnil;
3228
3229 b = XBUFFER (buffer);
3230
3231 specbind (Qinhibit_quit, Qt);
3232
3233 b->overlays_before = Fdelq (overlay, b->overlays_before);
3234 b->overlays_after = Fdelq (overlay, b->overlays_after);
3235
3236 modify_overlay (b,
3237 marker_position (OVERLAY_START (overlay)),
3238 marker_position (OVERLAY_END (overlay)));
3239
3240 Fset_marker (OVERLAY_START (overlay), Qnil, Qnil);
3241 Fset_marker (OVERLAY_END (overlay), Qnil, Qnil);
3242
3243 return unbind_to (count, Qnil);
3244 }
3245 \f
3246 /* Overlay dissection functions. */
3247
3248 DEFUN ("overlay-start", Foverlay_start, Soverlay_start, 1, 1, 0,
3249 "Return the position at which OVERLAY starts.")
3250 (overlay)
3251 Lisp_Object overlay;
3252 {
3253 CHECK_OVERLAY (overlay, 0);
3254
3255 return (Fmarker_position (OVERLAY_START (overlay)));
3256 }
3257
3258 DEFUN ("overlay-end", Foverlay_end, Soverlay_end, 1, 1, 0,
3259 "Return the position at which OVERLAY ends.")
3260 (overlay)
3261 Lisp_Object overlay;
3262 {
3263 CHECK_OVERLAY (overlay, 0);
3264
3265 return (Fmarker_position (OVERLAY_END (overlay)));
3266 }
3267
3268 DEFUN ("overlay-buffer", Foverlay_buffer, Soverlay_buffer, 1, 1, 0,
3269 "Return the buffer OVERLAY belongs to.")
3270 (overlay)
3271 Lisp_Object overlay;
3272 {
3273 CHECK_OVERLAY (overlay, 0);
3274
3275 return Fmarker_buffer (OVERLAY_START (overlay));
3276 }
3277
3278 DEFUN ("overlay-properties", Foverlay_properties, Soverlay_properties, 1, 1, 0,
3279 "Return a list of the properties on OVERLAY.\n\
3280 This is a copy of OVERLAY's plist; modifying its conses has no effect on\n\
3281 OVERLAY.")
3282 (overlay)
3283 Lisp_Object overlay;
3284 {
3285 CHECK_OVERLAY (overlay, 0);
3286
3287 return Fcopy_sequence (XOVERLAY (overlay)->plist);
3288 }
3289
3290 \f
3291 DEFUN ("overlays-at", Foverlays_at, Soverlays_at, 1, 1, 0,
3292 "Return a list of the overlays that contain position POS.")
3293 (pos)
3294 Lisp_Object pos;
3295 {
3296 int noverlays;
3297 Lisp_Object *overlay_vec;
3298 int len;
3299 Lisp_Object result;
3300
3301 CHECK_NUMBER_COERCE_MARKER (pos, 0);
3302
3303 len = 10;
3304 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
3305
3306 /* Put all the overlays we want in a vector in overlay_vec.
3307 Store the length in len. */
3308 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
3309 (int *) 0, (int *) 0);
3310
3311 /* Make a list of them all. */
3312 result = Flist (noverlays, overlay_vec);
3313
3314 xfree (overlay_vec);
3315 return result;
3316 }
3317
3318 DEFUN ("overlays-in", Foverlays_in, Soverlays_in, 2, 2, 0,
3319 "Return a list of the overlays that overlap the region BEG ... END.\n\
3320 Overlap means that at least one character is contained within the overlay\n\
3321 and also contained within the specified region.\n\
3322 Empty overlays are included in the result if they are located at BEG\n\
3323 or between BEG and END.")
3324 (beg, end)
3325 Lisp_Object beg, end;
3326 {
3327 int noverlays;
3328 Lisp_Object *overlay_vec;
3329 int len;
3330 Lisp_Object result;
3331
3332 CHECK_NUMBER_COERCE_MARKER (beg, 0);
3333 CHECK_NUMBER_COERCE_MARKER (end, 0);
3334
3335 len = 10;
3336 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
3337
3338 /* Put all the overlays we want in a vector in overlay_vec.
3339 Store the length in len. */
3340 noverlays = overlays_in (XINT (beg), XINT (end), 1, &overlay_vec, &len,
3341 (int *) 0, (int *) 0);
3342
3343 /* Make a list of them all. */
3344 result = Flist (noverlays, overlay_vec);
3345
3346 xfree (overlay_vec);
3347 return result;
3348 }
3349
3350 DEFUN ("next-overlay-change", Fnext_overlay_change, Snext_overlay_change,
3351 1, 1, 0,
3352 "Return the next position after POS where an overlay starts or ends.\n\
3353 If there are no more overlay boundaries after POS, return (point-max).")
3354 (pos)
3355 Lisp_Object pos;
3356 {
3357 int noverlays;
3358 int endpos;
3359 Lisp_Object *overlay_vec;
3360 int len;
3361 int i;
3362
3363 CHECK_NUMBER_COERCE_MARKER (pos, 0);
3364
3365 len = 10;
3366 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
3367
3368 /* Put all the overlays we want in a vector in overlay_vec.
3369 Store the length in len.
3370 endpos gets the position where the next overlay starts. */
3371 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
3372 &endpos, (int *) 0);
3373
3374 /* If any of these overlays ends before endpos,
3375 use its ending point instead. */
3376 for (i = 0; i < noverlays; i++)
3377 {
3378 Lisp_Object oend;
3379 int oendpos;
3380
3381 oend = OVERLAY_END (overlay_vec[i]);
3382 oendpos = OVERLAY_POSITION (oend);
3383 if (oendpos < endpos)
3384 endpos = oendpos;
3385 }
3386
3387 xfree (overlay_vec);
3388 return make_number (endpos);
3389 }
3390
3391 DEFUN ("previous-overlay-change", Fprevious_overlay_change,
3392 Sprevious_overlay_change, 1, 1, 0,
3393 "Return the previous position before POS where an overlay starts or ends.\n\
3394 If there are no more overlay boundaries before POS, return (point-min).")
3395 (pos)
3396 Lisp_Object pos;
3397 {
3398 int noverlays;
3399 int prevpos;
3400 Lisp_Object *overlay_vec;
3401 int len;
3402
3403 CHECK_NUMBER_COERCE_MARKER (pos, 0);
3404
3405 len = 10;
3406 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
3407
3408 /* At beginning of buffer, we know the answer;
3409 avoid bug subtracting 1 below. */
3410 if (XINT (pos) == BEGV)
3411 return pos;
3412
3413 /* Put all the overlays we want in a vector in overlay_vec.
3414 Store the length in len.
3415 prevpos gets the position of the previous change. */
3416 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
3417 (int *) 0, &prevpos);
3418
3419 xfree (overlay_vec);
3420 return make_number (prevpos);
3421 }
3422 \f
3423 /* These functions are for debugging overlays. */
3424
3425 DEFUN ("overlay-lists", Foverlay_lists, Soverlay_lists, 0, 0, 0,
3426 "Return a pair of lists giving all the overlays of the current buffer.\n\
3427 The car has all the overlays before the overlay center;\n\
3428 the cdr has all the overlays after the overlay center.\n\
3429 Recentering overlays moves overlays between these lists.\n\
3430 The lists you get are copies, so that changing them has no effect.\n\
3431 However, the overlays you get are the real objects that the buffer uses.")
3432 ()
3433 {
3434 Lisp_Object before, after;
3435 before = current_buffer->overlays_before;
3436 if (CONSP (before))
3437 before = Fcopy_sequence (before);
3438 after = current_buffer->overlays_after;
3439 if (CONSP (after))
3440 after = Fcopy_sequence (after);
3441
3442 return Fcons (before, after);
3443 }
3444
3445 DEFUN ("overlay-recenter", Foverlay_recenter, Soverlay_recenter, 1, 1, 0,
3446 "Recenter the overlays of the current buffer around position POS.")
3447 (pos)
3448 Lisp_Object pos;
3449 {
3450 CHECK_NUMBER_COERCE_MARKER (pos, 0);
3451
3452 recenter_overlay_lists (current_buffer, XINT (pos));
3453 return Qnil;
3454 }
3455 \f
3456 DEFUN ("overlay-get", Foverlay_get, Soverlay_get, 2, 2, 0,
3457 "Get the property of overlay OVERLAY with property name PROP.")
3458 (overlay, prop)
3459 Lisp_Object overlay, prop;
3460 {
3461 Lisp_Object plist, fallback;
3462
3463 CHECK_OVERLAY (overlay, 0);
3464
3465 fallback = Qnil;
3466
3467 for (plist = XOVERLAY (overlay)->plist;
3468 CONSP (plist) && CONSP (XCDR (plist));
3469 plist = XCDR (XCDR (plist)))
3470 {
3471 if (EQ (XCAR (plist), prop))
3472 return XCAR (XCDR (plist));
3473 else if (EQ (XCAR (plist), Qcategory))
3474 {
3475 Lisp_Object tem;
3476 tem = Fcar (Fcdr (plist));
3477 if (SYMBOLP (tem))
3478 fallback = Fget (tem, prop);
3479 }
3480 }
3481
3482 return fallback;
3483 }
3484
3485 DEFUN ("overlay-put", Foverlay_put, Soverlay_put, 3, 3, 0,
3486 "Set one property of overlay OVERLAY: give property PROP value VALUE.")
3487 (overlay, prop, value)
3488 Lisp_Object overlay, prop, value;
3489 {
3490 Lisp_Object tail, buffer;
3491 int changed;
3492
3493 CHECK_OVERLAY (overlay, 0);
3494
3495 buffer = Fmarker_buffer (OVERLAY_START (overlay));
3496
3497 for (tail = XOVERLAY (overlay)->plist;
3498 CONSP (tail) && CONSP (XCDR (tail));
3499 tail = XCDR (XCDR (tail)))
3500 if (EQ (XCAR (tail), prop))
3501 {
3502 changed = !EQ (XCAR (XCDR (tail)), value);
3503 XCAR (XCDR (tail)) = value;
3504 goto found;
3505 }
3506 /* It wasn't in the list, so add it to the front. */
3507 changed = !NILP (value);
3508 XOVERLAY (overlay)->plist
3509 = Fcons (prop, Fcons (value, XOVERLAY (overlay)->plist));
3510 found:
3511 if (! NILP (buffer))
3512 {
3513 if (changed)
3514 modify_overlay (XBUFFER (buffer),
3515 marker_position (OVERLAY_START (overlay)),
3516 marker_position (OVERLAY_END (overlay)));
3517 if (EQ (prop, Qevaporate) && ! NILP (value)
3518 && (OVERLAY_POSITION (OVERLAY_START (overlay))
3519 == OVERLAY_POSITION (OVERLAY_END (overlay))))
3520 Fdelete_overlay (overlay);
3521 }
3522 return value;
3523 }
3524 \f
3525 /* Subroutine of report_overlay_modification. */
3526
3527 /* Lisp vector holding overlay hook functions to call.
3528 Vector elements come in pairs.
3529 Each even-index element is a list of hook functions.
3530 The following odd-index element is the overlay they came from.
3531
3532 Before the buffer change, we fill in this vector
3533 as we call overlay hook functions.
3534 After the buffer change, we get the functions to call from this vector.
3535 This way we always call the same functions before and after the change. */
3536 static Lisp_Object last_overlay_modification_hooks;
3537
3538 /* Number of elements actually used in last_overlay_modification_hooks. */
3539 static int last_overlay_modification_hooks_used;
3540
3541 /* Add one functionlist/overlay pair
3542 to the end of last_overlay_modification_hooks. */
3543
3544 static void
3545 add_overlay_mod_hooklist (functionlist, overlay)
3546 Lisp_Object functionlist, overlay;
3547 {
3548 int oldsize = XVECTOR (last_overlay_modification_hooks)->size;
3549
3550 if (last_overlay_modification_hooks_used == oldsize)
3551 {
3552 Lisp_Object old;
3553 old = last_overlay_modification_hooks;
3554 last_overlay_modification_hooks
3555 = Fmake_vector (make_number (oldsize * 2), Qnil);
3556 bcopy (XVECTOR (old)->contents,
3557 XVECTOR (last_overlay_modification_hooks)->contents,
3558 sizeof (Lisp_Object) * oldsize);
3559 }
3560 XVECTOR (last_overlay_modification_hooks)->contents[last_overlay_modification_hooks_used++] = functionlist;
3561 XVECTOR (last_overlay_modification_hooks)->contents[last_overlay_modification_hooks_used++] = overlay;
3562 }
3563 \f
3564 /* Run the modification-hooks of overlays that include
3565 any part of the text in START to END.
3566 If this change is an insertion, also
3567 run the insert-before-hooks of overlay starting at END,
3568 and the insert-after-hooks of overlay ending at START.
3569
3570 This is called both before and after the modification.
3571 AFTER is nonzero when we call after the modification.
3572
3573 ARG1, ARG2, ARG3 are arguments to pass to the hook functions.
3574 When AFTER is nonzero, they are the start position,
3575 the position after the inserted new text,
3576 and the length of deleted or replaced old text. */
3577
3578 void
3579 report_overlay_modification (start, end, after, arg1, arg2, arg3)
3580 Lisp_Object start, end;
3581 int after;
3582 Lisp_Object arg1, arg2, arg3;
3583 {
3584 Lisp_Object prop, overlay, tail;
3585 /* 1 if this change is an insertion. */
3586 int insertion = (after ? XFASTINT (arg3) == 0 : EQ (start, end));
3587 int tail_copied;
3588 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
3589
3590 overlay = Qnil;
3591 tail = Qnil;
3592 GCPRO5 (overlay, tail, arg1, arg2, arg3);
3593
3594 if (after)
3595 {
3596 /* Call the functions recorded in last_overlay_modification_hooks
3597 rather than scanning the overlays again.
3598 First copy the vector contents, in case some of these hooks
3599 do subsequent modification of the buffer. */
3600 int size = last_overlay_modification_hooks_used;
3601 Lisp_Object *copy = (Lisp_Object *) alloca (size * sizeof (Lisp_Object));
3602 int i;
3603
3604 bcopy (XVECTOR (last_overlay_modification_hooks)->contents,
3605 copy, size * sizeof (Lisp_Object));
3606 gcpro1.var = copy;
3607 gcpro1.nvars = size;
3608
3609 for (i = 0; i < size;)
3610 {
3611 Lisp_Object prop, overlay;
3612 prop = copy[i++];
3613 overlay = copy[i++];
3614 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
3615 }
3616 UNGCPRO;
3617 return;
3618 }
3619
3620 /* We are being called before a change.
3621 Scan the overlays to find the functions to call. */
3622 last_overlay_modification_hooks_used = 0;
3623 tail_copied = 0;
3624 for (tail = current_buffer->overlays_before;
3625 CONSP (tail);
3626 tail = XCDR (tail))
3627 {
3628 int startpos, endpos;
3629 Lisp_Object ostart, oend;
3630
3631 overlay = XCAR (tail);
3632
3633 ostart = OVERLAY_START (overlay);
3634 oend = OVERLAY_END (overlay);
3635 endpos = OVERLAY_POSITION (oend);
3636 if (XFASTINT (start) > endpos)
3637 break;
3638 startpos = OVERLAY_POSITION (ostart);
3639 if (insertion && (XFASTINT (start) == startpos
3640 || XFASTINT (end) == startpos))
3641 {
3642 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
3643 if (!NILP (prop))
3644 {
3645 /* Copy TAIL in case the hook recenters the overlay lists. */
3646 if (!tail_copied)
3647 tail = Fcopy_sequence (tail);
3648 tail_copied = 1;
3649 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
3650 }
3651 }
3652 if (insertion && (XFASTINT (start) == endpos
3653 || XFASTINT (end) == endpos))
3654 {
3655 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
3656 if (!NILP (prop))
3657 {
3658 if (!tail_copied)
3659 tail = Fcopy_sequence (tail);
3660 tail_copied = 1;
3661 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
3662 }
3663 }
3664 /* Test for intersecting intervals. This does the right thing
3665 for both insertion and deletion. */
3666 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
3667 {
3668 prop = Foverlay_get (overlay, Qmodification_hooks);
3669 if (!NILP (prop))
3670 {
3671 if (!tail_copied)
3672 tail = Fcopy_sequence (tail);
3673 tail_copied = 1;
3674 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
3675 }
3676 }
3677 }
3678
3679 tail_copied = 0;
3680 for (tail = current_buffer->overlays_after;
3681 CONSP (tail);
3682 tail = XCDR (tail))
3683 {
3684 int startpos, endpos;
3685 Lisp_Object ostart, oend;
3686
3687 overlay = XCAR (tail);
3688
3689 ostart = OVERLAY_START (overlay);
3690 oend = OVERLAY_END (overlay);
3691 startpos = OVERLAY_POSITION (ostart);
3692 endpos = OVERLAY_POSITION (oend);
3693 if (XFASTINT (end) < startpos)
3694 break;
3695 if (insertion && (XFASTINT (start) == startpos
3696 || XFASTINT (end) == startpos))
3697 {
3698 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
3699 if (!NILP (prop))
3700 {
3701 if (!tail_copied)
3702 tail = Fcopy_sequence (tail);
3703 tail_copied = 1;
3704 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
3705 }
3706 }
3707 if (insertion && (XFASTINT (start) == endpos
3708 || XFASTINT (end) == endpos))
3709 {
3710 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
3711 if (!NILP (prop))
3712 {
3713 if (!tail_copied)
3714 tail = Fcopy_sequence (tail);
3715 tail_copied = 1;
3716 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
3717 }
3718 }
3719 /* Test for intersecting intervals. This does the right thing
3720 for both insertion and deletion. */
3721 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
3722 {
3723 prop = Foverlay_get (overlay, Qmodification_hooks);
3724 if (!NILP (prop))
3725 {
3726 if (!tail_copied)
3727 tail = Fcopy_sequence (tail);
3728 tail_copied = 1;
3729 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
3730 }
3731 }
3732 }
3733
3734 UNGCPRO;
3735 }
3736
3737 static void
3738 call_overlay_mod_hooks (list, overlay, after, arg1, arg2, arg3)
3739 Lisp_Object list, overlay;
3740 int after;
3741 Lisp_Object arg1, arg2, arg3;
3742 {
3743 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3744
3745 GCPRO4 (list, arg1, arg2, arg3);
3746 if (! after)
3747 add_overlay_mod_hooklist (list, overlay);
3748
3749 while (!NILP (list))
3750 {
3751 if (NILP (arg3))
3752 call4 (Fcar (list), overlay, after ? Qt : Qnil, arg1, arg2);
3753 else
3754 call5 (Fcar (list), overlay, after ? Qt : Qnil, arg1, arg2, arg3);
3755 list = Fcdr (list);
3756 }
3757 UNGCPRO;
3758 }
3759
3760 /* Delete any zero-sized overlays at position POS, if the `evaporate'
3761 property is set. */
3762 void
3763 evaporate_overlays (pos)
3764 int pos;
3765 {
3766 Lisp_Object tail, overlay, hit_list;
3767
3768 hit_list = Qnil;
3769 if (pos <= XFASTINT (current_buffer->overlay_center))
3770 for (tail = current_buffer->overlays_before; CONSP (tail);
3771 tail = XCDR (tail))
3772 {
3773 int endpos;
3774 overlay = XCAR (tail);
3775 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3776 if (endpos < pos)
3777 break;
3778 if (endpos == pos && OVERLAY_POSITION (OVERLAY_START (overlay)) == pos
3779 && ! NILP (Foverlay_get (overlay, Qevaporate)))
3780 hit_list = Fcons (overlay, hit_list);
3781 }
3782 else
3783 for (tail = current_buffer->overlays_after; CONSP (tail);
3784 tail = XCDR (tail))
3785 {
3786 int startpos;
3787 overlay = XCAR (tail);
3788 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3789 if (startpos > pos)
3790 break;
3791 if (startpos == pos && OVERLAY_POSITION (OVERLAY_END (overlay)) == pos
3792 && ! NILP (Foverlay_get (overlay, Qevaporate)))
3793 hit_list = Fcons (overlay, hit_list);
3794 }
3795 for (; CONSP (hit_list); hit_list = XCDR (hit_list))
3796 Fdelete_overlay (XCAR (hit_list));
3797 }
3798 \f
3799 /* Somebody has tried to store a value with an unacceptable type
3800 in the slot with offset OFFSET. */
3801
3802 void
3803 buffer_slot_type_mismatch (offset)
3804 int offset;
3805 {
3806 Lisp_Object sym;
3807 char *type_name;
3808 sym = *(Lisp_Object *)(offset + (char *)&buffer_local_symbols);
3809 switch (XINT (*(Lisp_Object *)(offset + (char *)&buffer_local_types)))
3810 {
3811 case Lisp_Int: type_name = "integers"; break;
3812 case Lisp_String: type_name = "strings"; break;
3813 case Lisp_Symbol: type_name = "symbols"; break;
3814
3815 default:
3816 abort ();
3817 }
3818
3819 error ("Only %s should be stored in the buffer-local variable %s",
3820 type_name, XSYMBOL (sym)->name->data);
3821 }
3822 \f
3823 void
3824 init_buffer_once ()
3825 {
3826 buffer_permanent_local_flags = 0;
3827
3828 /* Make sure all markable slots in buffer_defaults
3829 are initialized reasonably, so mark_buffer won't choke. */
3830 reset_buffer (&buffer_defaults);
3831 reset_buffer_local_variables (&buffer_defaults, 1);
3832 reset_buffer (&buffer_local_symbols);
3833 reset_buffer_local_variables (&buffer_local_symbols, 1);
3834 /* Prevent GC from getting confused. */
3835 buffer_defaults.text = &buffer_defaults.own_text;
3836 buffer_local_symbols.text = &buffer_local_symbols.own_text;
3837 BUF_INTERVALS (&buffer_defaults) = 0;
3838 BUF_INTERVALS (&buffer_local_symbols) = 0;
3839 XSETBUFFER (Vbuffer_defaults, &buffer_defaults);
3840 XSETBUFFER (Vbuffer_local_symbols, &buffer_local_symbols);
3841
3842 /* Set up the default values of various buffer slots. */
3843 /* Must do these before making the first buffer! */
3844
3845 /* real setup is done in loaddefs.el */
3846 buffer_defaults.mode_line_format = build_string ("%-");
3847 buffer_defaults.header_line_format = Qnil;
3848 buffer_defaults.abbrev_mode = Qnil;
3849 buffer_defaults.overwrite_mode = Qnil;
3850 buffer_defaults.case_fold_search = Qt;
3851 buffer_defaults.auto_fill_function = Qnil;
3852 buffer_defaults.selective_display = Qnil;
3853 #ifndef old
3854 buffer_defaults.selective_display_ellipses = Qt;
3855 #endif
3856 buffer_defaults.abbrev_table = Qnil;
3857 buffer_defaults.display_table = Qnil;
3858 buffer_defaults.undo_list = Qnil;
3859 buffer_defaults.mark_active = Qnil;
3860 buffer_defaults.file_format = Qnil;
3861 buffer_defaults.overlays_before = Qnil;
3862 buffer_defaults.overlays_after = Qnil;
3863 XSETFASTINT (buffer_defaults.overlay_center, BEG);
3864
3865 XSETFASTINT (buffer_defaults.tab_width, 8);
3866 buffer_defaults.truncate_lines = Qnil;
3867 buffer_defaults.ctl_arrow = Qt;
3868 buffer_defaults.direction_reversed = Qnil;
3869
3870 #ifdef DOS_NT
3871 buffer_defaults.buffer_file_type = Qnil; /* TEXT */
3872 #endif
3873 buffer_defaults.enable_multibyte_characters = Qt;
3874 buffer_defaults.buffer_file_coding_system = Qnil;
3875 XSETFASTINT (buffer_defaults.fill_column, 70);
3876 XSETFASTINT (buffer_defaults.left_margin, 0);
3877 buffer_defaults.cache_long_line_scans = Qnil;
3878 buffer_defaults.file_truename = Qnil;
3879 XSETFASTINT (buffer_defaults.display_count, 0);
3880 buffer_defaults.indicate_empty_lines = Qnil;
3881 buffer_defaults.scroll_up_aggressively = Qnil;
3882 buffer_defaults.scroll_down_aggressively = Qnil;
3883 buffer_defaults.display_time = Qnil;
3884
3885 /* Assign the local-flags to the slots that have default values.
3886 The local flag is a bit that is used in the buffer
3887 to say that it has its own local value for the slot.
3888 The local flag bits are in the local_var_flags slot of the buffer. */
3889
3890 /* Nothing can work if this isn't true */
3891 if (sizeof (EMACS_INT) != sizeof (Lisp_Object)) abort ();
3892
3893 /* 0 means not a lisp var, -1 means always local, else mask */
3894 bzero (&buffer_local_flags, sizeof buffer_local_flags);
3895 XSETINT (buffer_local_flags.filename, -1);
3896 XSETINT (buffer_local_flags.directory, -1);
3897 XSETINT (buffer_local_flags.backed_up, -1);
3898 XSETINT (buffer_local_flags.save_length, -1);
3899 XSETINT (buffer_local_flags.auto_save_file_name, -1);
3900 XSETINT (buffer_local_flags.read_only, -1);
3901 XSETINT (buffer_local_flags.major_mode, -1);
3902 XSETINT (buffer_local_flags.mode_name, -1);
3903 XSETINT (buffer_local_flags.undo_list, -1);
3904 XSETINT (buffer_local_flags.mark_active, -1);
3905 XSETINT (buffer_local_flags.point_before_scroll, -1);
3906 XSETINT (buffer_local_flags.file_truename, -1);
3907 XSETINT (buffer_local_flags.invisibility_spec, -1);
3908 XSETINT (buffer_local_flags.file_format, -1);
3909 XSETINT (buffer_local_flags.display_count, -1);
3910 XSETINT (buffer_local_flags.display_time, -1);
3911 XSETINT (buffer_local_flags.enable_multibyte_characters, -1);
3912
3913 XSETFASTINT (buffer_local_flags.mode_line_format, 1);
3914 XSETFASTINT (buffer_local_flags.abbrev_mode, 2);
3915 XSETFASTINT (buffer_local_flags.overwrite_mode, 4);
3916 XSETFASTINT (buffer_local_flags.case_fold_search, 8);
3917 XSETFASTINT (buffer_local_flags.auto_fill_function, 0x10);
3918 XSETFASTINT (buffer_local_flags.selective_display, 0x20);
3919 #ifndef old
3920 XSETFASTINT (buffer_local_flags.selective_display_ellipses, 0x40);
3921 #endif
3922 XSETFASTINT (buffer_local_flags.tab_width, 0x80);
3923 XSETFASTINT (buffer_local_flags.truncate_lines, 0x100);
3924 XSETFASTINT (buffer_local_flags.ctl_arrow, 0x200);
3925 XSETFASTINT (buffer_local_flags.fill_column, 0x400);
3926 XSETFASTINT (buffer_local_flags.left_margin, 0x800);
3927 XSETFASTINT (buffer_local_flags.abbrev_table, 0x1000);
3928 XSETFASTINT (buffer_local_flags.display_table, 0x2000);
3929 #ifdef DOS_NT
3930 XSETFASTINT (buffer_local_flags.buffer_file_type, 0x4000);
3931 /* Make this one a permanent local. */
3932 buffer_permanent_local_flags |= 0x4000;
3933 #endif
3934 XSETFASTINT (buffer_local_flags.syntax_table, 0x8000);
3935 XSETFASTINT (buffer_local_flags.cache_long_line_scans, 0x10000);
3936 XSETFASTINT (buffer_local_flags.category_table, 0x20000);
3937 XSETFASTINT (buffer_local_flags.direction_reversed, 0x40000);
3938 XSETFASTINT (buffer_local_flags.buffer_file_coding_system, 0x80000);
3939 /* Make this one a permanent local. */
3940 buffer_permanent_local_flags |= 0x80000;
3941 XSETFASTINT (buffer_local_flags.left_margin_width, 0x100000);
3942 XSETFASTINT (buffer_local_flags.right_margin_width, 0x200000);
3943 XSETFASTINT (buffer_local_flags.indicate_empty_lines, 0x400000);
3944 XSETFASTINT (buffer_local_flags.scroll_up_aggressively, 0x800000);
3945 XSETFASTINT (buffer_local_flags.scroll_down_aggressively, 0x1000000);
3946 XSETFASTINT (buffer_local_flags.header_line_format, 0x2000000);
3947
3948 Vbuffer_alist = Qnil;
3949 current_buffer = 0;
3950 all_buffers = 0;
3951
3952 QSFundamental = build_string ("Fundamental");
3953
3954 Qfundamental_mode = intern ("fundamental-mode");
3955 buffer_defaults.major_mode = Qfundamental_mode;
3956
3957 Qmode_class = intern ("mode-class");
3958
3959 Qprotected_field = intern ("protected-field");
3960
3961 Qpermanent_local = intern ("permanent-local");
3962
3963 Qkill_buffer_hook = intern ("kill-buffer-hook");
3964
3965 Vprin1_to_string_buffer = Fget_buffer_create (build_string (" prin1"));
3966
3967 /* super-magic invisible buffer */
3968 Vbuffer_alist = Qnil;
3969
3970 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
3971
3972 inhibit_modification_hooks = 0;
3973 }
3974
3975 void
3976 init_buffer ()
3977 {
3978 char buf[MAXPATHLEN+1];
3979 char *pwd;
3980 struct stat dotstat, pwdstat;
3981 Lisp_Object temp;
3982 int rc;
3983
3984 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
3985 if (NILP (buffer_defaults.enable_multibyte_characters))
3986 Fset_buffer_multibyte (Qnil);
3987
3988 /* If PWD is accurate, use it instead of calling getwd. This is faster
3989 when PWD is right, and may avoid a fatal error. */
3990 if ((pwd = getenv ("PWD")) != 0
3991 && (IS_DIRECTORY_SEP (*pwd) || (*pwd && IS_DEVICE_SEP (pwd[1])))
3992 && stat (pwd, &pwdstat) == 0
3993 && stat (".", &dotstat) == 0
3994 && dotstat.st_ino == pwdstat.st_ino
3995 && dotstat.st_dev == pwdstat.st_dev
3996 && strlen (pwd) < MAXPATHLEN)
3997 strcpy (buf, pwd);
3998 #ifdef HAVE_GETCWD
3999 else if (getcwd (buf, MAXPATHLEN+1) == 0)
4000 fatal ("`getcwd' failed: %s\n", strerror (errno));
4001 #else
4002 else if (getwd (buf) == 0)
4003 fatal ("`getwd' failed: %s\n", buf);
4004 #endif
4005
4006 #ifndef VMS
4007 /* Maybe this should really use some standard subroutine
4008 whose definition is filename syntax dependent. */
4009 rc = strlen (buf);
4010 if (!(IS_DIRECTORY_SEP (buf[rc - 1])))
4011 {
4012 buf[rc] = DIRECTORY_SEP;
4013 buf[rc + 1] = '\0';
4014 }
4015 #endif /* not VMS */
4016
4017 current_buffer->directory = build_string (buf);
4018
4019 /* Add /: to the front of the name
4020 if it would otherwise be treated as magic. */
4021 temp = Ffind_file_name_handler (current_buffer->directory, Qt);
4022 if (! NILP (temp)
4023 /* If the default dir is just /, TEMP is non-nil
4024 because of the ange-ftp completion handler.
4025 However, it is not necessary to turn / into /:/.
4026 So avoid doing that. */
4027 && strcmp ("/", XSTRING (current_buffer->directory)->data))
4028 current_buffer->directory
4029 = concat2 (build_string ("/:"), current_buffer->directory);
4030
4031 temp = get_minibuffer (0);
4032 XBUFFER (temp)->directory = current_buffer->directory;
4033 }
4034
4035 /* initialize the buffer routines */
4036 void
4037 syms_of_buffer ()
4038 {
4039 staticpro (&last_overlay_modification_hooks);
4040 last_overlay_modification_hooks
4041 = Fmake_vector (make_number (10), Qnil);
4042
4043 staticpro (&Vbuffer_defaults);
4044 staticpro (&Vbuffer_local_symbols);
4045 staticpro (&Qfundamental_mode);
4046 staticpro (&Qmode_class);
4047 staticpro (&QSFundamental);
4048 staticpro (&Vbuffer_alist);
4049 staticpro (&Qprotected_field);
4050 staticpro (&Qpermanent_local);
4051 staticpro (&Qkill_buffer_hook);
4052 Qoverlayp = intern ("overlayp");
4053 staticpro (&Qoverlayp);
4054 Qevaporate = intern ("evaporate");
4055 staticpro (&Qevaporate);
4056 Qmodification_hooks = intern ("modification-hooks");
4057 staticpro (&Qmodification_hooks);
4058 Qinsert_in_front_hooks = intern ("insert-in-front-hooks");
4059 staticpro (&Qinsert_in_front_hooks);
4060 Qinsert_behind_hooks = intern ("insert-behind-hooks");
4061 staticpro (&Qinsert_behind_hooks);
4062 Qget_file_buffer = intern ("get-file-buffer");
4063 staticpro (&Qget_file_buffer);
4064 Qpriority = intern ("priority");
4065 staticpro (&Qpriority);
4066 Qwindow = intern ("window");
4067 staticpro (&Qwindow);
4068 Qbefore_string = intern ("before-string");
4069 staticpro (&Qbefore_string);
4070 Qafter_string = intern ("after-string");
4071 staticpro (&Qafter_string);
4072 Qfirst_change_hook = intern ("first-change-hook");
4073 staticpro (&Qfirst_change_hook);
4074 Qbefore_change_functions = intern ("before-change-functions");
4075 staticpro (&Qbefore_change_functions);
4076 Qafter_change_functions = intern ("after-change-functions");
4077 staticpro (&Qafter_change_functions);
4078
4079 Fput (Qprotected_field, Qerror_conditions,
4080 Fcons (Qprotected_field, Fcons (Qerror, Qnil)));
4081 Fput (Qprotected_field, Qerror_message,
4082 build_string ("Attempt to modify a protected field"));
4083
4084 /* All these use DEFVAR_LISP_NOPRO because the slots in
4085 buffer_defaults will all be marked via Vbuffer_defaults. */
4086
4087 DEFVAR_LISP_NOPRO ("default-mode-line-format",
4088 &buffer_defaults.mode_line_format,
4089 "Default value of `mode-line-format' for buffers that don't override it.\n\
4090 This is the same as (default-value 'mode-line-format).");
4091
4092 DEFVAR_LISP_NOPRO ("default-header-line-format",
4093 &buffer_defaults.header_line_format,
4094 "Default value of `header-line-format' for buffers that don't override it.\n\
4095 This is the same as (default-value 'header-line-format).");
4096
4097 DEFVAR_LISP_NOPRO ("default-abbrev-mode",
4098 &buffer_defaults.abbrev_mode,
4099 "Default value of `abbrev-mode' for buffers that do not override it.\n\
4100 This is the same as (default-value 'abbrev-mode).");
4101
4102 DEFVAR_LISP_NOPRO ("default-ctl-arrow",
4103 &buffer_defaults.ctl_arrow,
4104 "Default value of `ctl-arrow' for buffers that do not override it.\n\
4105 This is the same as (default-value 'ctl-arrow).");
4106
4107 DEFVAR_LISP_NOPRO ("default-direction-reversed",
4108 &buffer_defaults.direction_reversed,
4109 "Default value of `direction_reversed' for buffers that do not override it.\n\
4110 This is the same as (default-value 'direction-reversed).");
4111
4112 DEFVAR_LISP_NOPRO ("default-enable-multibyte-characters",
4113 &buffer_defaults.enable_multibyte_characters,
4114 "*Default value of `enable-multibyte-characters' for buffers not overriding it.\n\
4115 This is the same as (default-value 'enable-multibyte-characters).");
4116
4117 DEFVAR_LISP_NOPRO ("default-buffer-file-coding-system",
4118 &buffer_defaults.buffer_file_coding_system,
4119 "Default value of `buffer-file-coding-system' for buffers not overriding it.\n\
4120 This is the same as (default-value 'buffer-file-coding-system).");
4121
4122 DEFVAR_LISP_NOPRO ("default-truncate-lines",
4123 &buffer_defaults.truncate_lines,
4124 "Default value of `truncate-lines' for buffers that do not override it.\n\
4125 This is the same as (default-value 'truncate-lines).");
4126
4127 DEFVAR_LISP_NOPRO ("default-fill-column",
4128 &buffer_defaults.fill_column,
4129 "Default value of `fill-column' for buffers that do not override it.\n\
4130 This is the same as (default-value 'fill-column).");
4131
4132 DEFVAR_LISP_NOPRO ("default-left-margin",
4133 &buffer_defaults.left_margin,
4134 "Default value of `left-margin' for buffers that do not override it.\n\
4135 This is the same as (default-value 'left-margin).");
4136
4137 DEFVAR_LISP_NOPRO ("default-tab-width",
4138 &buffer_defaults.tab_width,
4139 "Default value of `tab-width' for buffers that do not override it.\n\
4140 This is the same as (default-value 'tab-width).");
4141
4142 DEFVAR_LISP_NOPRO ("default-case-fold-search",
4143 &buffer_defaults.case_fold_search,
4144 "Default value of `case-fold-search' for buffers that don't override it.\n\
4145 This is the same as (default-value 'case-fold-search).");
4146
4147 #ifdef DOS_NT
4148 DEFVAR_LISP_NOPRO ("default-buffer-file-type",
4149 &buffer_defaults.buffer_file_type,
4150 "Default file type for buffers that do not override it.\n\
4151 This is the same as (default-value 'buffer-file-type).\n\
4152 The file type is nil for text, t for binary.");
4153 #endif
4154
4155 DEFVAR_LISP_NOPRO ("default-left-margin-width",
4156 &buffer_defaults.left_margin_width,
4157 "Default value of `left-margin-width' for buffers that don't override it.\n\
4158 This is the same as (default-value 'left-margin-width).");
4159
4160 DEFVAR_LISP_NOPRO ("default-right-margin-width",
4161 &buffer_defaults.right_margin_width,
4162 "Default value of `right_margin_width' for buffers that don't override it.\n\
4163 This is the same as (default-value 'right-margin-width).");
4164
4165 DEFVAR_LISP_NOPRO ("default-indicate-empty-lines",
4166 &buffer_defaults.indicate_empty_lines,
4167 "Default value of `indicate-empty-lines' for buffers that don't override it.\n\
4168 This is the same as (default-value 'indicate-empty-lines).");
4169
4170 DEFVAR_LISP_NOPRO ("default-scroll-up-aggressively",
4171 &buffer_defaults.scroll_up_aggressively,
4172 "Default value of `scroll-up-aggressively' for buffers that\n\
4173 don't override it. This is the same as (default-value\n\
4174 'scroll-up-aggressively).");
4175
4176 DEFVAR_LISP_NOPRO ("default-scroll-down-aggressively",
4177 &buffer_defaults.scroll_down_aggressively,
4178 "Default value of `scroll-down-aggressively' for buffers that\n\
4179 don't override it. This is the same as (default-value\n\
4180 'scroll-down-aggressively).");
4181
4182 DEFVAR_PER_BUFFER ("header-line-format",
4183 &current_buffer->header_line_format,
4184 Qnil,
4185 "Analogous to `mode-line-format', but for a mode line displayed\n\
4186 at the top of windows.");
4187
4188 DEFVAR_PER_BUFFER ("mode-line-format", &current_buffer->mode_line_format,
4189 Qnil, 0);
4190
4191 /* This doc string is too long for cpp; cpp dies if it isn't in a comment.
4192 But make-docfile finds it!
4193 DEFVAR_PER_BUFFER ("mode-line-format", &current_buffer->mode_line_format,
4194 Qnil,
4195 "Template for displaying mode line for current buffer.\n\
4196 Each buffer has its own value of this variable.\n\
4197 Value may be nil, a string, a symbol or a list or cons cell.\n\
4198 A value of nil means don't display a mode line.\n\
4199 For a symbol, its value is used (but it is ignored if t or nil).\n\
4200 A string appearing directly as the value of a symbol is processed verbatim\n\
4201 in that the %-constructs below are not recognized.\n\
4202 For a list of the form `(:eval FORM)', FORM is evaluated and the result\n\
4203 is used as a mode line element.\n\
4204 For a list whose car is a symbol, the symbol's value is taken,\n\
4205 and if that is non-nil, the cadr of the list is processed recursively.\n\
4206 Otherwise, the caddr of the list (if there is one) is processed.\n\
4207 For a list whose car is a string or list, each element is processed\n\
4208 recursively and the results are effectively concatenated.\n\
4209 For a list whose car is an integer, the cdr of the list is processed\n\
4210 and padded (if the number is positive) or truncated (if negative)\n\
4211 to the width specified by that number.\n\
4212 A string is printed verbatim in the mode line except for %-constructs:\n\
4213 (%-constructs are allowed when the string is the entire mode-line-format\n\
4214 or when it is found in a cons-cell or a list)\n\
4215 %b -- print buffer name. %f -- print visited file name.\n\
4216 %F -- print frame name.\n\
4217 %* -- print %, * or hyphen. %+ -- print *, % or hyphen.\n\
4218 %& is like %*, but ignore read-only-ness.\n\
4219 % means buffer is read-only and * means it is modified.\n\
4220 For a modified read-only buffer, %* gives % and %+ gives *.\n\
4221 %s -- print process status. %l -- print the current line number.\n\
4222 %c -- print the current column number (this makes editing slower).\n\
4223 To make the column number update correctly in all cases,\n\
4224 `column-number-mode' must be non-nil.\n\
4225 %p -- print percent of buffer above top of window, or Top, Bot or All.\n\
4226 %P -- print percent of buffer above bottom of window, perhaps plus Top,\n\
4227 or print Bottom or All.\n\
4228 %m -- print the mode name.\n\
4229 %n -- print Narrow if appropriate.\n\
4230 %z -- print mnemonics of buffer, terminal, and keyboard coding systems.\n\
4231 %Z -- like %z, but including the end-of-line format.\n\
4232 %[ -- print one [ for each recursive editing level. %] similar.\n\
4233 %% -- print %. %- -- print infinitely many dashes.\n\
4234 Decimal digits after the % specify field width to which to pad.");
4235 */
4236
4237 DEFVAR_LISP_NOPRO ("default-major-mode", &buffer_defaults.major_mode,
4238 "*Major mode for new buffers. Defaults to `fundamental-mode'.\n\
4239 nil here means use current buffer's major mode.");
4240
4241 DEFVAR_PER_BUFFER ("major-mode", &current_buffer->major_mode,
4242 make_number (Lisp_Symbol),
4243 "Symbol for current buffer's major mode.");
4244
4245 DEFVAR_PER_BUFFER ("mode-name", &current_buffer->mode_name,
4246 make_number (Lisp_String),
4247 "Pretty name of current buffer's major mode (a string).");
4248
4249 DEFVAR_PER_BUFFER ("abbrev-mode", &current_buffer->abbrev_mode, Qnil,
4250 "Non-nil turns on automatic expansion of abbrevs as they are inserted.\n\
4251 Automatically becomes buffer-local when set in any fashion.");
4252
4253 DEFVAR_PER_BUFFER ("case-fold-search", &current_buffer->case_fold_search,
4254 Qnil,
4255 "*Non-nil if searches and matches should ignore case.\n\
4256 Automatically becomes buffer-local when set in any fashion.");
4257
4258 DEFVAR_PER_BUFFER ("fill-column", &current_buffer->fill_column,
4259 make_number (Lisp_Int),
4260 "*Column beyond which automatic line-wrapping should happen.\n\
4261 Automatically becomes buffer-local when set in any fashion.");
4262
4263 DEFVAR_PER_BUFFER ("left-margin", &current_buffer->left_margin,
4264 make_number (Lisp_Int),
4265 "*Column for the default indent-line-function to indent to.\n\
4266 Linefeed indents to this column in Fundamental mode.\n\
4267 Automatically becomes buffer-local when set in any fashion.");
4268
4269 DEFVAR_PER_BUFFER ("tab-width", &current_buffer->tab_width,
4270 make_number (Lisp_Int),
4271 "*Distance between tab stops (for display of tab characters), in columns.\n\
4272 Automatically becomes buffer-local when set in any fashion.");
4273
4274 DEFVAR_PER_BUFFER ("ctl-arrow", &current_buffer->ctl_arrow, Qnil,
4275 "*Non-nil means display control chars with uparrow.\n\
4276 A value of nil means use backslash and octal digits.\n\
4277 Automatically becomes buffer-local when set in any fashion.\n\
4278 This variable does not apply to characters whose display is specified\n\
4279 in the current display table (if there is one).");
4280
4281 DEFVAR_PER_BUFFER ("enable-multibyte-characters",
4282 &current_buffer->enable_multibyte_characters,
4283 make_number (-1),
4284 "Non-nil means the buffer contents are regarded as multi-byte characters.\n\
4285 Otherwise they are regarded as unibyte. This affects the display,\n\
4286 file I/O and the behavior of various editing commands.\n\
4287 \n\
4288 This variable is buffer-local but you cannot set it directly;\n\
4289 use the function `set-buffer-multibyte' to change a buffer's representation.\n\
4290 Changing its default value with `setq-default' is supported.\n\
4291 See also variable `default-enable-multibyte-characters' and Info node\n\
4292 `(elisp)Text Representations'.");
4293
4294 DEFVAR_PER_BUFFER ("buffer-file-coding-system",
4295 &current_buffer->buffer_file_coding_system, Qnil,
4296 "Coding system to be used for encoding the buffer contents on saving.\n\
4297 This variable applies to saving the buffer, and also to `write-region'\n\
4298 and other functions that use `write-region'.\n\
4299 It does not apply to sending output to subprocesses, however.\n\
4300 \n\
4301 If this is nil, the buffer is saved without any code conversion\n\
4302 unless some coding system is specified in `file-coding-system-alist'\n\
4303 for the buffer file.\n\
4304 \n\
4305 The variable `coding-system-for-write', if non-nil, overrides this variable.\n\
4306 \n\
4307 This variable is never applied to a way of decoding\n\
4308 a file while reading it.");
4309
4310 DEFVAR_PER_BUFFER ("direction-reversed", &current_buffer->direction_reversed,
4311 Qnil,
4312 "*Non-nil means lines in the buffer are displayed right to left.");
4313
4314 DEFVAR_PER_BUFFER ("truncate-lines", &current_buffer->truncate_lines, Qnil,
4315 "*Non-nil means do not display continuation lines;\n\
4316 give each line of text one screen line.\n\
4317 Automatically becomes buffer-local when set in any fashion.\n\
4318 \n\
4319 Note that this is overridden by the variable\n\
4320 `truncate-partial-width-windows' if that variable is non-nil\n\
4321 and this buffer is not full-frame width.");
4322
4323 #ifdef DOS_NT
4324 DEFVAR_PER_BUFFER ("buffer-file-type", &current_buffer->buffer_file_type,
4325 Qnil,
4326 "Non-nil if the visited file is a binary file.\n\
4327 This variable is meaningful on MS-DOG and Windows NT.\n\
4328 On those systems, it is automatically local in every buffer.\n\
4329 On other systems, this variable is normally always nil.");
4330 #endif
4331
4332 DEFVAR_PER_BUFFER ("default-directory", &current_buffer->directory,
4333 make_number (Lisp_String),
4334 "Name of default directory of current buffer. Should end with slash.\n\
4335 Each buffer has its own value of this variable.");
4336
4337 DEFVAR_PER_BUFFER ("auto-fill-function", &current_buffer->auto_fill_function,
4338 Qnil,
4339 "Function called (if non-nil) to perform auto-fill.\n\
4340 It is called after self-inserting a space or newline.\n\
4341 Each buffer has its own value of this variable.\n\
4342 NOTE: This variable is not a hook;\n\
4343 its value may not be a list of functions.");
4344
4345 DEFVAR_PER_BUFFER ("buffer-file-name", &current_buffer->filename,
4346 make_number (Lisp_String),
4347 "Name of file visited in current buffer, or nil if not visiting a file.\n\
4348 Each buffer has its own value of this variable.");
4349
4350 DEFVAR_PER_BUFFER ("buffer-file-truename", &current_buffer->file_truename,
4351 make_number (Lisp_String),
4352 "Abbreviated truename of file visited in current buffer, or nil if none.\n\
4353 The truename of a file is calculated by `file-truename'\n\
4354 and then abbreviated with `abbreviate-file-name'.\n\
4355 Each buffer has its own value of this variable.");
4356
4357 DEFVAR_PER_BUFFER ("buffer-auto-save-file-name",
4358 &current_buffer->auto_save_file_name,
4359 make_number (Lisp_String),
4360 "Name of file for auto-saving current buffer,\n\
4361 or nil if buffer should not be auto-saved.\n\
4362 Each buffer has its own value of this variable.");
4363
4364 DEFVAR_PER_BUFFER ("buffer-read-only", &current_buffer->read_only, Qnil,
4365 "Non-nil if this buffer is read-only.\n\
4366 Each buffer has its own value of this variable.");
4367
4368 DEFVAR_PER_BUFFER ("buffer-backed-up", &current_buffer->backed_up, Qnil,
4369 "Non-nil if this buffer's file has been backed up.\n\
4370 Backing up is done before the first time the file is saved.\n\
4371 Each buffer has its own value of this variable.");
4372
4373 DEFVAR_PER_BUFFER ("buffer-saved-size", &current_buffer->save_length,
4374 make_number (Lisp_Int),
4375 "Length of current buffer when last read in, saved or auto-saved.\n\
4376 0 initially.\n\
4377 Each buffer has its own value of this variable.");
4378
4379 DEFVAR_PER_BUFFER ("selective-display", &current_buffer->selective_display,
4380 Qnil,
4381 "Non-nil enables selective display:\n\
4382 Integer N as value means display only lines\n\
4383 that start with less than n columns of space.\n\
4384 A value of t means, after a ^M, all the rest of the line is invisible.\n\
4385 Then ^M's in the file are written into files as newlines.\n\n\
4386 Automatically becomes buffer-local when set in any fashion.");
4387
4388 #ifndef old
4389 DEFVAR_PER_BUFFER ("selective-display-ellipses",
4390 &current_buffer->selective_display_ellipses,
4391 Qnil,
4392 "t means display ... on previous line when a line is invisible.\n\
4393 Automatically becomes buffer-local when set in any fashion.");
4394 #endif
4395
4396 DEFVAR_PER_BUFFER ("overwrite-mode", &current_buffer->overwrite_mode, Qnil,
4397 "Non-nil if self-insertion should replace existing text.\n\
4398 The value should be one of `overwrite-mode-textual',\n\
4399 `overwrite-mode-binary', or nil.\n\
4400 If it is `overwrite-mode-textual', self-insertion still\n\
4401 inserts at the end of a line, and inserts when point is before a tab,\n\
4402 until the tab is filled in.\n\
4403 If `overwrite-mode-binary', self-insertion replaces newlines and tabs too.\n\
4404 Automatically becomes buffer-local when set in any fashion.");
4405
4406 #if 0 /* The doc string is too long for some compilers,
4407 but make-docfile can find it in this comment. */
4408 DEFVAR_PER_BUFFER ("buffer-display-table", &current_buffer->display_table,
4409 Qnil,
4410 "Display table that controls display of the contents of current buffer.\n\
4411 Automatically becomes buffer-local when set in any fashion.\n\
4412 The display table is a char-table created with `make-display-table'.\n\
4413 The ordinary char-table elements control how to display each possible text\n\
4414 character. Each value should be a vector of characters or nil;\n\
4415 nil means display the character in the default fashion.\n\
4416 There are six extra slots to control the display of\n\
4417 the end of a truncated screen line (extra-slot 0, a single character);\n\
4418 the end of a continued line (extra-slot 1, a single character);\n\
4419 the escape character used to display character codes in octal\n\
4420 (extra-slot 2, a single character);\n\
4421 the character used as an arrow for control characters (extra-slot 3,\n\
4422 a single character);\n\
4423 the decoration indicating the presence of invisible lines (extra-slot 4,\n\
4424 a vector of characters);\n\
4425 the character used to draw the border between side-by-side windows\n\
4426 (extra-slot 5, a single character).\n\
4427 See also the functions `display-table-slot' and `set-display-table-slot'.\n\
4428 If this variable is nil, the value of `standard-display-table' is used.\n\
4429 Each window can have its own, overriding display table.");
4430 #endif
4431 DEFVAR_PER_BUFFER ("buffer-display-table", &current_buffer->display_table,
4432 Qnil, 0);
4433
4434 DEFVAR_PER_BUFFER ("left-margin-width", &current_buffer->left_margin_width,
4435 Qnil,
4436 "*Width of left marginal area for display of a buffer.\n\
4437 Automatically becomes buffer-local when set in any fashion.\n\
4438 A value of nil means no marginal area.");
4439
4440 DEFVAR_PER_BUFFER ("right-margin-width", &current_buffer->right_margin_width,
4441 Qnil,
4442 "*Width of right marginal area for display of a buffer.\n\
4443 Automatically becomes buffer-local when set in any fashion.\n\
4444 A value of nil means no marginal area.");
4445
4446 DEFVAR_PER_BUFFER ("indicate-empty-lines",
4447 &current_buffer->indicate_empty_lines, Qnil,
4448 "*Visually indicate empty lines after the buffer end.\n\
4449 If non-nil, a bitmap is displayed in the left fringe of a window on\n\
4450 window-systems.\n\
4451 Automatically becomes buffer-local when set in any fashion.\n");
4452
4453 DEFVAR_PER_BUFFER ("scroll-up-aggressively",
4454 &current_buffer->scroll_up_aggressively, Qnil,
4455 "*If a number, scroll display up aggressively.\n\
4456 If scrolling a window because point is above the window start, choose\n\
4457 a new window start so that point ends up that fraction of the window's\n\
4458 height from the bottom of the window.\n\
4459 Automatically becomes buffer-local when set in any fashion.");
4460
4461 DEFVAR_PER_BUFFER ("scroll-down-aggressively",
4462 &current_buffer->scroll_down_aggressively, Qnil,
4463 "*If a number, scroll display down aggressively.\n\
4464 If scrolling a window because point is below the window end, choose\n\
4465 a new window start so that point ends up that fraction of the window's\n\
4466 height from the top of the window.\n\
4467 Automatically becomes buffer-local when set in any fashion.");
4468
4469 /*DEFVAR_LISP ("debug-check-symbol", &Vcheck_symbol,
4470 "Don't ask.");
4471 */
4472 DEFVAR_LISP ("before-change-function", &Vbefore_change_function,
4473 "If non-nil, a function to call before each text change (obsolete).\n\
4474 Two arguments are passed to the function: the positions of\n\
4475 the beginning and end of the range of old text to be changed.\n\
4476 \(For an insertion, the beginning and end are at the same place.)\n\
4477 No information is given about the length of the text after the change.\n\
4478 \n\
4479 Buffer changes made while executing the `before-change-function'\n\
4480 don't call any before-change or after-change functions.\n\
4481 That's because these variables are temporarily set to nil.\n\
4482 As a result, a hook function cannot straightforwardly alter the value of\n\
4483 these variables. See the Emacs Lisp manual for a way of\n\
4484 accomplishing an equivalent result by using other variables.\n\n\
4485 This variable is obsolete; use `before-change-functions' instead.");
4486 Vbefore_change_function = Qnil;
4487
4488 DEFVAR_LISP ("after-change-function", &Vafter_change_function,
4489 "If non-nil, a Function to call after each text change (obsolete).\n\
4490 Three arguments are passed to the function: the positions of\n\
4491 the beginning and end of the range of changed text,\n\
4492 and the length of the pre-change text replaced by that range.\n\
4493 \(For an insertion, the pre-change length is zero;\n\
4494 for a deletion, that length is the number of bytes deleted,\n\
4495 and the post-change beginning and end are at the same place.)\n\
4496 \n\
4497 Buffer changes made while executing the `after-change-function'\n\
4498 don't call any before-change or after-change functions.\n\
4499 That's because these variables are temporarily set to nil.\n\
4500 As a result, a hook function cannot straightforwardly alter the value of\n\
4501 these variables. See the Emacs Lisp manual for a way of\n\
4502 accomplishing an equivalent result by using other variables.\n\n\
4503 This variable is obsolete; use `after-change-functions' instead.");
4504 Vafter_change_function = Qnil;
4505
4506 DEFVAR_LISP ("before-change-functions", &Vbefore_change_functions,
4507 "List of functions to call before each text change.\n\
4508 Two arguments are passed to each function: the positions of\n\
4509 the beginning and end of the range of old text to be changed.\n\
4510 \(For an insertion, the beginning and end are at the same place.)\n\
4511 No information is given about the length of the text after the change.\n\
4512 \n\
4513 Buffer changes made while executing the `before-change-functions'\n\
4514 don't call any before-change or after-change functions.\n\
4515 That's because these variables are temporarily set to nil.\n\
4516 As a result, a hook function cannot straightforwardly alter the value of\n\
4517 these variables. See the Emacs Lisp manual for a way of\n\
4518 accomplishing an equivalent result by using other variables.\n\
4519 \n\
4520 If an unhandled error happens in running these functions,\n\
4521 the variable's value remains nil. That prevents the error\n\
4522 from happening repeatedly and making Emacs nonfunctional.");
4523 Vbefore_change_functions = Qnil;
4524
4525 DEFVAR_LISP ("after-change-functions", &Vafter_change_functions,
4526 "List of function to call after each text change.\n\
4527 Three arguments are passed to each function: the positions of\n\
4528 the beginning and end of the range of changed text,\n\
4529 and the length in bytes of the pre-change text replaced by that range.\n\
4530 \(For an insertion, the pre-change length is zero;\n\
4531 for a deletion, that length is the number of bytes deleted,\n\
4532 and the post-change beginning and end are at the same place.)\n\
4533 \n\
4534 Buffer changes made while executing the `after-change-functions'\n\
4535 don't call any before-change or after-change functions.\n\
4536 That's because these variables are temporarily set to nil.\n\
4537 As a result, a hook function cannot straightforwardly alter the value of\n\
4538 these variables. See the Emacs Lisp manual for a way of\n\
4539 accomplishing an equivalent result by using other variables.\n\
4540 \n\
4541 If an unhandled error happens in running these functions,\n\
4542 the variable's value remains nil. That prevents the error\n\
4543 from happening repeatedly and making Emacs nonfunctional.");
4544 Vafter_change_functions = Qnil;
4545
4546 DEFVAR_LISP ("first-change-hook", &Vfirst_change_hook,
4547 "A list of functions to call before changing a buffer which is unmodified.\n\
4548 The functions are run using the `run-hooks' function.");
4549 Vfirst_change_hook = Qnil;
4550
4551 #if 0 /* The doc string is too long for some compilers,
4552 but make-docfile can find it in this comment. */
4553 DEFVAR_PER_BUFFER ("buffer-undo-list", &current_buffer->undo_list, Qnil,
4554 "List of undo entries in current buffer.\n\
4555 This variable is always local in all buffers.\n\
4556 Recent changes come first; older changes follow newer.\n\
4557 \n\
4558 An entry (BEG . END) represents an insertion which begins at\n\
4559 position BEG and ends at position END.\n\
4560 \n\
4561 An entry (TEXT . POSITION) represents the deletion of the string TEXT\n\
4562 from (abs POSITION). If POSITION is positive, point was at the front\n\
4563 of the text being deleted; if negative, point was at the end.\n\
4564 \n\
4565 An entry (t HIGH . LOW) indicates that the buffer previously had\n\
4566 \"unmodified\" status. HIGH and LOW are the high and low 16-bit portions\n\
4567 of the visited file's modification time, as of that time. If the\n\
4568 modification time of the most recent save is different, this entry is\n\
4569 obsolete.\n\
4570 \n\
4571 An entry (nil PROPERTY VALUE BEG . END) indicates that a text property\n\
4572 was modified between BEG and END. PROPERTY is the property name,\n\
4573 and VALUE is the old value.\n\
4574 \n\
4575 An entry (MARKER . DISTANCE) indicates that the marker MARKER\n\
4576 was adjusted in position by the offset DISTANCE (an integer).\n\
4577 \n\
4578 An entry of the form POSITION indicates that point was at the buffer\n\
4579 location given by the integer. Undoing an entry of this form places\n\
4580 point at POSITION.\n\
4581 \n\
4582 nil marks undo boundaries. The undo command treats the changes\n\
4583 between two undo boundaries as a single step to be undone.\n\
4584 \n\
4585 If the value of the variable is t, undo information is not recorded.");
4586 #endif
4587 DEFVAR_PER_BUFFER ("buffer-undo-list", &current_buffer->undo_list, Qnil,
4588 0);
4589
4590 DEFVAR_PER_BUFFER ("mark-active", &current_buffer->mark_active, Qnil,
4591 "Non-nil means the mark and region are currently active in this buffer.\n\
4592 Automatically local in all buffers.");
4593
4594 DEFVAR_PER_BUFFER ("cache-long-line-scans", &current_buffer->cache_long_line_scans, Qnil,
4595 "Non-nil means that Emacs should use caches to handle long lines more quickly.\n\
4596 This variable is buffer-local, in all buffers.\n\
4597 \n\
4598 Normally, the line-motion functions work by scanning the buffer for\n\
4599 newlines. Columnar operations (like move-to-column and\n\
4600 compute-motion) also work by scanning the buffer, summing character\n\
4601 widths as they go. This works well for ordinary text, but if the\n\
4602 buffer's lines are very long (say, more than 500 characters), these\n\
4603 motion functions will take longer to execute. Emacs may also take\n\
4604 longer to update the display.\n\
4605 \n\
4606 If cache-long-line-scans is non-nil, these motion functions cache the\n\
4607 results of their scans, and consult the cache to avoid rescanning\n\
4608 regions of the buffer until the text is modified. The caches are most\n\
4609 beneficial when they prevent the most searching---that is, when the\n\
4610 buffer contains long lines and large regions of characters with the\n\
4611 same, fixed screen width.\n\
4612 \n\
4613 When cache-long-line-scans is non-nil, processing short lines will\n\
4614 become slightly slower (because of the overhead of consulting the\n\
4615 cache), and the caches will use memory roughly proportional to the\n\
4616 number of newlines and characters whose screen width varies.\n\
4617 \n\
4618 The caches require no explicit maintenance; their accuracy is\n\
4619 maintained internally by the Emacs primitives. Enabling or disabling\n\
4620 the cache should not affect the behavior of any of the motion\n\
4621 functions; it should only affect their performance.");
4622
4623 DEFVAR_PER_BUFFER ("point-before-scroll", &current_buffer->point_before_scroll, Qnil,
4624 "Value of point before the last series of scroll operations, or nil.\n\
4625 This variable is always local in all buffers.");
4626
4627 DEFVAR_PER_BUFFER ("buffer-file-format", &current_buffer->file_format, Qnil,
4628 "List of formats to use when saving this buffer.\n\
4629 This variable is always local in all buffers.\n\
4630 Formats are defined by `format-alist'. This variable is\n\
4631 set when a file is visited. Automatically local in all buffers.");
4632
4633 DEFVAR_PER_BUFFER ("buffer-invisibility-spec",
4634 &current_buffer->invisibility_spec, Qnil,
4635 "Invisibility spec of this buffer.\n\
4636 This variable is always local in all buffers.\n\
4637 The default is t, which means that text is invisible\n\
4638 if it has a non-nil `invisible' property.\n\
4639 If the value is a list, a text character is invisible if its `invisible'\n\
4640 property is an element in that list.\n\
4641 If an element is a cons cell of the form (PROP . ELLIPSIS),\n\
4642 then characters with property value PROP are invisible,\n\
4643 and they have an ellipsis as well if ELLIPSIS is non-nil.");
4644
4645 DEFVAR_PER_BUFFER ("buffer-display-count",
4646 &current_buffer->display_count, Qnil,
4647 "A number incremented each time this buffer is displayed in a window.\n\
4648 This variable is always local in all buffers.\n\
4649 The function `set-window-buffer increments it.");
4650
4651 DEFVAR_PER_BUFFER ("buffer-display-time",
4652 &current_buffer->display_time, Qnil,
4653 "Time stamp updated each time this buffer is displayed in a window.\n\
4654 This variable is always local in all buffers.\n\
4655 The function `set-window-buffer' updates this variable\n\
4656 to the value obtained by calling `current-time'.\n\
4657 If the buffer has never been shown in a window, the value is nil.");
4658
4659 DEFVAR_LISP ("transient-mark-mode", &Vtransient_mark_mode,
4660 "*Non-nil means deactivate the mark when the buffer contents change.\n\
4661 Non-nil also enables highlighting of the region whenever the mark is active.\n\
4662 The variable `highlight-nonselected-windows' controls whether to highlight\n\
4663 all windows or just the selected window.");
4664 Vtransient_mark_mode = Qnil;
4665
4666 DEFVAR_LISP ("inhibit-read-only", &Vinhibit_read_only,
4667 "*Non-nil means disregard read-only status of buffers or characters.\n\
4668 If the value is t, disregard `buffer-read-only' and all `read-only'\n\
4669 text properties. If the value is a list, disregard `buffer-read-only'\n\
4670 and disregard a `read-only' text property if the property value\n\
4671 is a member of the list.");
4672 Vinhibit_read_only = Qnil;
4673
4674 DEFVAR_LISP ("kill-buffer-query-functions", &Vkill_buffer_query_functions,
4675 "List of functions called with no args to query before killing a buffer.");
4676 Vkill_buffer_query_functions = Qnil;
4677
4678 defsubr (&Sbuffer_live_p);
4679 defsubr (&Sbuffer_list);
4680 defsubr (&Sget_buffer);
4681 defsubr (&Sget_file_buffer);
4682 defsubr (&Sget_buffer_create);
4683 defsubr (&Smake_indirect_buffer);
4684 defsubr (&Sgenerate_new_buffer_name);
4685 defsubr (&Sbuffer_name);
4686 /*defsubr (&Sbuffer_number);*/
4687 defsubr (&Sbuffer_file_name);
4688 defsubr (&Sbuffer_base_buffer);
4689 defsubr (&Sbuffer_local_variables);
4690 defsubr (&Sbuffer_modified_p);
4691 defsubr (&Sset_buffer_modified_p);
4692 defsubr (&Sbuffer_modified_tick);
4693 defsubr (&Srename_buffer);
4694 defsubr (&Sother_buffer);
4695 defsubr (&Sbuffer_disable_undo);
4696 defsubr (&Sbuffer_enable_undo);
4697 defsubr (&Skill_buffer);
4698 defsubr (&Sset_buffer_major_mode);
4699 defsubr (&Sswitch_to_buffer);
4700 defsubr (&Spop_to_buffer);
4701 defsubr (&Scurrent_buffer);
4702 defsubr (&Sset_buffer);
4703 defsubr (&Sbarf_if_buffer_read_only);
4704 defsubr (&Sbury_buffer);
4705 defsubr (&Serase_buffer);
4706 defsubr (&Sset_buffer_multibyte);
4707 defsubr (&Skill_all_local_variables);
4708
4709 defsubr (&Soverlayp);
4710 defsubr (&Smake_overlay);
4711 defsubr (&Sdelete_overlay);
4712 defsubr (&Smove_overlay);
4713 defsubr (&Soverlay_start);
4714 defsubr (&Soverlay_end);
4715 defsubr (&Soverlay_buffer);
4716 defsubr (&Soverlay_properties);
4717 defsubr (&Soverlays_at);
4718 defsubr (&Soverlays_in);
4719 defsubr (&Snext_overlay_change);
4720 defsubr (&Sprevious_overlay_change);
4721 defsubr (&Soverlay_recenter);
4722 defsubr (&Soverlay_lists);
4723 defsubr (&Soverlay_get);
4724 defsubr (&Soverlay_put);
4725 }
4726
4727 void
4728 keys_of_buffer ()
4729 {
4730 initial_define_key (control_x_map, 'b', "switch-to-buffer");
4731 initial_define_key (control_x_map, 'k', "kill-buffer");
4732
4733 /* This must not be in syms_of_buffer, because Qdisabled is not
4734 initialized when that function gets called. */
4735 Fput (intern ("erase-buffer"), Qdisabled, Qt);
4736 }