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