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