* alloc.c (make_event_array): Use SSET for storing into a string.
[bpt/emacs.git] / src / buffer.c
CommitLineData
1ab256cb 1/* Buffer manipulation primitives for GNU Emacs.
08327b22 2 Copyright (C) 1985,86,87,88,89,93,94,95,97,98, 1999, 2000, 2001, 2002
c922bc55 3 Free Software Foundation, Inc.
1ab256cb
RM
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
c922bc55 9the Free Software Foundation; either version 2, or (at your option)
1ab256cb
RM
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
3b7ad313
EN
19the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20Boston, MA 02111-1307, USA. */
1ab256cb 21
68c45bf0 22#include <config.h>
1ab256cb 23
2381d133
JB
24#include <sys/types.h>
25#include <sys/stat.h>
1ab256cb 26#include <sys/param.h>
9dde47f5 27#include <errno.h>
15e7873a 28#include <stdio.h>
9dde47f5 29
2538fae4 30#ifndef USE_CRT_DLL
9dde47f5 31extern int errno;
2538fae4 32#endif
1ab256cb
RM
33
34#ifndef MAXPATHLEN
35/* in 4.1, param.h fails to define this. */
36#define MAXPATHLEN 1024
37#endif /* not MAXPATHLEN */
38
dfcf069d
AS
39#ifdef HAVE_UNISTD_H
40#include <unistd.h>
41#endif
7ee72033 42
1ab256cb 43#include "lisp.h"
21cf4cf8 44#include "intervals.h"
1ab256cb
RM
45#include "window.h"
46#include "commands.h"
47#include "buffer.h"
3b06f880 48#include "charset.h"
28e969dd 49#include "region-cache.h"
1ab256cb 50#include "indent.h"
d014bf88 51#include "blockinput.h"
2538fae4 52#include "keyboard.h"
e35f6ff7 53#include "keymap.h"
08460cd4 54#include "frame.h"
1ab256cb
RM
55
56struct buffer *current_buffer; /* the current buffer */
57
58/* First buffer in chain of all buffers (in reverse order of creation).
59 Threaded through ->next. */
60
61struct buffer *all_buffers;
62
63/* This structure holds the default values of the buffer-local variables
64 defined with DEFVAR_PER_BUFFER, that have special slots in each buffer.
65 The default value occupies the same slot in this structure
66 as an individual buffer's value occupies in that buffer.
67 Setting the default value also goes through the alist of buffers
68 and stores into each buffer that does not say it has a local value. */
69
70struct buffer buffer_defaults;
71
72/* A Lisp_Object pointer to the above, used for staticpro */
73
74static Lisp_Object Vbuffer_defaults;
75
76/* This structure marks which slots in a buffer have corresponding
77 default values in buffer_defaults.
78 Each such slot has a nonzero value in this structure.
79 The value has only one nonzero bit.
80
81 When a buffer has its own local value for a slot,
7c02e886
GM
82 the entry for that slot (found in the same slot in this structure)
83 is turned on in the buffer's local_flags array.
1ab256cb
RM
84
85 If a slot in this structure is -1, then even though there may
86 be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
87 and the corresponding slot in buffer_defaults is not used.
88
89 If a slot is -2, then there is no DEFVAR_PER_BUFFER for it,
90 but there is a default value which is copied into each buffer.
91
92 If a slot in this structure is negative, then even though there may
93 be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
94 and the corresponding slot in buffer_defaults is not used.
95
96 If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is
97 zero, that is a bug */
98
99struct buffer buffer_local_flags;
100
101/* This structure holds the names of symbols whose values may be
102 buffer-local. It is indexed and accessed in the same way as the above. */
103
104struct buffer buffer_local_symbols;
105/* A Lisp_Object pointer to the above, used for staticpro */
106static Lisp_Object Vbuffer_local_symbols;
107
0fa3ba92
JB
108/* This structure holds the required types for the values in the
109 buffer-local slots. If a slot contains Qnil, then the
110 corresponding buffer slot may contain a value of any type. If a
111 slot contains an integer, then prospective values' tags must be
1bf08baf
KH
112 equal to that integer (except nil is always allowed).
113 When a tag does not match, the function
114 buffer_slot_type_mismatch will signal an error.
115
116 If a slot here contains -1, the corresponding variable is read-only. */
0fa3ba92
JB
117struct buffer buffer_local_types;
118
13de9290
RS
119/* Flags indicating which built-in buffer-local variables
120 are permanent locals. */
7313acd0 121static char buffer_permanent_local_flags[MAX_PER_BUFFER_VARS];
7c02e886
GM
122
123/* Number of per-buffer variables used. */
124
7313acd0 125int last_per_buffer_idx;
13de9290 126
1ab256cb 127Lisp_Object Fset_buffer ();
01050cb5 128void set_buffer_internal ();
c7aa5005 129void set_buffer_internal_1 ();
173f2a64 130static void call_overlay_mod_hooks ();
2f3f993b 131static void swap_out_buffer_local_variables ();
13de9290 132static void reset_buffer_local_variables ();
1ab256cb
RM
133
134/* Alist of all buffer names vs the buffers. */
135/* This used to be a variable, but is no longer,
136 to prevent lossage due to user rplac'ing this alist or its elements. */
137Lisp_Object Vbuffer_alist;
138
139/* Functions to call before and after each text change. */
5f079267
RS
140Lisp_Object Vbefore_change_functions;
141Lisp_Object Vafter_change_functions;
1ab256cb 142
c48f61ef
RS
143Lisp_Object Vtransient_mark_mode;
144
a96b68f1
RS
145/* t means ignore all read-only text properties.
146 A list means ignore such a property if its value is a member of the list.
147 Any non-nil value means ignore buffer-read-only. */
148Lisp_Object Vinhibit_read_only;
149
dcdffbf6
RS
150/* List of functions to call that can query about killing a buffer.
151 If any of these functions returns nil, we don't kill it. */
152Lisp_Object Vkill_buffer_query_functions;
153
dbc4e1c1
JB
154/* List of functions to call before changing an unmodified buffer. */
155Lisp_Object Vfirst_change_hook;
22378665 156
dbc4e1c1 157Lisp_Object Qfirst_change_hook;
22378665
RS
158Lisp_Object Qbefore_change_functions;
159Lisp_Object Qafter_change_functions;
1ab256cb 160
7775635d
KH
161/* If nonzero, all modification hooks are suppressed. */
162int inhibit_modification_hooks;
163
1ab256cb
RM
164Lisp_Object Qfundamental_mode, Qmode_class, Qpermanent_local;
165
166Lisp_Object Qprotected_field;
167
168Lisp_Object QSFundamental; /* A string "Fundamental" */
169
170Lisp_Object Qkill_buffer_hook;
171
5fe0b67e
RS
172Lisp_Object Qget_file_buffer;
173
52f8ec73
JB
174Lisp_Object Qoverlayp;
175
bbbe9545 176Lisp_Object Qpriority, Qwindow, Qevaporate, Qbefore_string, Qafter_string;
5985d248 177
294d215f
RS
178Lisp_Object Qmodification_hooks;
179Lisp_Object Qinsert_in_front_hooks;
180Lisp_Object Qinsert_behind_hooks;
181
b86af064
GM
182static void alloc_buffer_text P_ ((struct buffer *, size_t));
183static void free_buffer_text P_ ((struct buffer *b));
04e4cb3a 184static Lisp_Object copy_overlays P_ ((struct buffer *, Lisp_Object));
26f545d7 185static void modify_overlay P_ ((struct buffer *, int, int));
b86af064
GM
186
187
1ab256cb
RM
188/* For debugging; temporary. See set_buffer_internal. */
189/* Lisp_Object Qlisp_mode, Vcheck_symbol; */
190
01136e9b 191void
1ab256cb
RM
192nsberror (spec)
193 Lisp_Object spec;
194{
a7a60ce9 195 if (STRINGP (spec))
d5db4077 196 error ("No buffer named %s", SDATA (spec));
1ab256cb
RM
197 error ("Invalid buffer argument");
198}
199\f
0dc88e60 200DEFUN ("buffer-live-p", Fbuffer_live_p, Sbuffer_live_p, 1, 1, 0,
7ee72033
MB
201 doc: /* Return non-nil if OBJECT is a buffer which has not been killed.
202Value is nil if OBJECT is not a buffer or if it has been killed. */)
203 (object)
0dc88e60
RS
204 Lisp_Object object;
205{
206 return ((BUFFERP (object) && ! NILP (XBUFFER (object)->name))
207 ? Qt : Qnil);
208}
209
08460cd4 210DEFUN ("buffer-list", Fbuffer_list, Sbuffer_list, 0, 1, 0,
7ee72033
MB
211 doc: /* Return a list of all existing live buffers.
212If the optional arg FRAME is a frame, we return that frame's buffer list. */)
213 (frame)
08460cd4 214 Lisp_Object frame;
1ab256cb 215{
08460cd4
RS
216 Lisp_Object framelist, general;
217 general = Fmapcar (Qcdr, Vbuffer_alist);
218
219 if (FRAMEP (frame))
220 {
221 Lisp_Object tail;
222
b7826503 223 CHECK_FRAME (frame);
08460cd4
RS
224
225 framelist = Fcopy_sequence (XFRAME (frame)->buffer_list);
226
227 /* Remove from GENERAL any buffer that duplicates one in FRAMELIST. */
228 tail = framelist;
229 while (! NILP (tail))
230 {
7539e11f
KR
231 general = Fdelq (XCAR (tail), general);
232 tail = XCDR (tail);
08460cd4
RS
233 }
234 return nconc2 (framelist, general);
235 }
236
237 return general;
1ab256cb
RM
238}
239
04ae1b48
RS
240/* Like Fassoc, but use Fstring_equal to compare
241 (which ignores text properties),
242 and don't ever QUIT. */
243
244static Lisp_Object
245assoc_ignore_text_properties (key, list)
246 register Lisp_Object key;
247 Lisp_Object list;
248{
249 register Lisp_Object tail;
250 for (tail = list; !NILP (tail); tail = Fcdr (tail))
251 {
252 register Lisp_Object elt, tem;
253 elt = Fcar (tail);
254 tem = Fstring_equal (Fcar (elt), key);
255 if (!NILP (tem))
256 return elt;
257 }
258 return Qnil;
259}
260
1ab256cb 261DEFUN ("get-buffer", Fget_buffer, Sget_buffer, 1, 1, 0,
7ee72033 262 doc: /* Return the buffer named NAME (a string).
018ba359 263If there is no live buffer named NAME, return nil.
7ee72033
MB
264NAME may also be a buffer; if so, the value is that buffer. */)
265 (name)
1ab256cb
RM
266 register Lisp_Object name;
267{
a7a60ce9 268 if (BUFFERP (name))
1ab256cb 269 return name;
b7826503 270 CHECK_STRING (name);
1ab256cb 271
04ae1b48 272 return Fcdr (assoc_ignore_text_properties (name, Vbuffer_alist));
1ab256cb
RM
273}
274
275DEFUN ("get-file-buffer", Fget_file_buffer, Sget_file_buffer, 1, 1, 0,
7ee72033 276 doc: /* Return the buffer visiting file FILENAME (a string).
018ba359
PJ
277The buffer's `buffer-file-name' must match exactly the expansion of FILENAME.
278If there is no such live buffer, return nil.
7ee72033
MB
279See also `find-buffer-visiting'. */)
280 (filename)
1ab256cb
RM
281 register Lisp_Object filename;
282{
283 register Lisp_Object tail, buf, tem;
5fe0b67e
RS
284 Lisp_Object handler;
285
b7826503 286 CHECK_STRING (filename);
1ab256cb
RM
287 filename = Fexpand_file_name (filename, Qnil);
288
5fe0b67e
RS
289 /* If the file name has special constructs in it,
290 call the corresponding file handler. */
a617e913 291 handler = Ffind_file_name_handler (filename, Qget_file_buffer);
5fe0b67e
RS
292 if (!NILP (handler))
293 return call2 (handler, Qget_file_buffer, filename);
294
7539e11f 295 for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
1ab256cb 296 {
7539e11f 297 buf = Fcdr (XCAR (tail));
a7a60ce9
KH
298 if (!BUFFERP (buf)) continue;
299 if (!STRINGP (XBUFFER (buf)->filename)) continue;
1ab256cb 300 tem = Fstring_equal (XBUFFER (buf)->filename, filename);
265a9e55 301 if (!NILP (tem))
1ab256cb
RM
302 return buf;
303 }
304 return Qnil;
305}
306
52e01189
RS
307Lisp_Object
308get_truename_buffer (filename)
309 register Lisp_Object filename;
310{
311 register Lisp_Object tail, buf, tem;
312
7539e11f 313 for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
52e01189 314 {
7539e11f 315 buf = Fcdr (XCAR (tail));
52e01189
RS
316 if (!BUFFERP (buf)) continue;
317 if (!STRINGP (XBUFFER (buf)->file_truename)) continue;
318 tem = Fstring_equal (XBUFFER (buf)->file_truename, filename);
319 if (!NILP (tem))
320 return buf;
321 }
322 return Qnil;
323}
324
1ab256cb
RM
325/* Incremented for each buffer created, to assign the buffer number. */
326int buffer_count;
327
328DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 1, 0,
7ee72033 329 doc: /* Return the buffer named NAME, or create such a buffer and return it.
018ba359
PJ
330A new buffer is created if there is no live buffer named NAME.
331If NAME starts with a space, the new buffer does not keep undo information.
332If NAME is a buffer instead of a string, then it is the value returned.
7ee72033
MB
333The value is never nil. */)
334 (name)
1ab256cb
RM
335 register Lisp_Object name;
336{
a9ee7a59 337 register Lisp_Object buf;
1ab256cb
RM
338 register struct buffer *b;
339
340 buf = Fget_buffer (name);
265a9e55 341 if (!NILP (buf))
1ab256cb
RM
342 return buf;
343
d5db4077 344 if (SCHARS (name) == 0)
31cd83e9
KH
345 error ("Empty string for buffer name is not allowed");
346
a21260d9 347 b = (struct buffer *) allocate_buffer ();
1ab256cb 348
336cd056
RS
349 b->size = sizeof (struct buffer) / sizeof (EMACS_INT);
350
351 /* An ordinary buffer uses its own struct buffer_text. */
352 b->text = &b->own_text;
353 b->base_buffer = 0;
354
1ab256cb 355 BUF_GAP_SIZE (b) = 20;
9ac0d9e0 356 BLOCK_INPUT;
3b06f880
KH
357 /* We allocate extra 1-byte at the tail and keep it always '\0' for
358 anchoring a search. */
b86af064 359 alloc_buffer_text (b, BUF_GAP_SIZE (b) + 1);
9ac0d9e0 360 UNBLOCK_INPUT;
1ab256cb 361 if (! BUF_BEG_ADDR (b))
81841847 362 buffer_memory_full ();
1ab256cb
RM
363
364 BUF_PT (b) = 1;
365 BUF_GPT (b) = 1;
366 BUF_BEGV (b) = 1;
367 BUF_ZV (b) = 1;
368 BUF_Z (b) = 1;
3f236a40
RS
369 BUF_PT_BYTE (b) = 1;
370 BUF_GPT_BYTE (b) = 1;
371 BUF_BEGV_BYTE (b) = 1;
372 BUF_ZV_BYTE (b) = 1;
373 BUF_Z_BYTE (b) = 1;
1ab256cb 374 BUF_MODIFF (b) = 1;
2509d356 375 BUF_OVERLAY_MODIFF (b) = 1;
336cd056
RS
376 BUF_SAVE_MODIFF (b) = 1;
377 BUF_INTERVALS (b) = 0;
b5a225b4
GM
378 BUF_UNCHANGED_MODIFIED (b) = 1;
379 BUF_OVERLAY_UNCHANGED_MODIFIED (b) = 1;
380 BUF_END_UNCHANGED (b) = 0;
381 BUF_BEG_UNCHANGED (b) = 0;
3b06f880 382 *(BUF_GPT_ADDR (b)) = *(BUF_Z_ADDR (b)) = 0; /* Put an anchor '\0'. */
1ab256cb 383
28e969dd
JB
384 b->newline_cache = 0;
385 b->width_run_cache = 0;
386 b->width_table = Qnil;
b5a225b4 387 b->prevent_redisplay_optimizations_p = 1;
28e969dd 388
1ab256cb
RM
389 /* Put this on the chain of all buffers including killed ones. */
390 b->next = all_buffers;
391 all_buffers = b;
392
336cd056
RS
393 /* An ordinary buffer normally doesn't need markers
394 to handle BEGV and ZV. */
395 b->pt_marker = Qnil;
396 b->begv_marker = Qnil;
397 b->zv_marker = Qnil;
04ae1b48
RS
398
399 name = Fcopy_sequence (name);
ab77f05c 400 STRING_SET_INTERVALS (name, NULL_INTERVAL);
1ab256cb 401 b->name = name;
04ae1b48 402
d5db4077 403 if (SREF (name, 0) != ' ')
1ab256cb
RM
404 b->undo_list = Qnil;
405 else
406 b->undo_list = Qt;
407
408 reset_buffer (b);
13de9290 409 reset_buffer_local_variables (b, 1);
1ab256cb
RM
410
411 /* Put this in the alist of all live buffers. */
67180c6a 412 XSETBUFFER (buf, b);
1ab256cb
RM
413 Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));
414
415 b->mark = Fmake_marker ();
336cd056
RS
416 BUF_MARKERS (b) = Qnil;
417 b->name = name;
418 return buf;
419}
420
7e9d5818 421
04e4cb3a
GM
422/* Return a list of overlays which is a copy of the overlay list
423 LIST, but for buffer B. */
424
425static Lisp_Object
426copy_overlays (b, list)
427 struct buffer *b;
428 Lisp_Object list;
429{
430 Lisp_Object result, buffer;
431
432 XSETBUFFER (buffer, b);
433
434 for (result = Qnil; CONSP (list); list = XCDR (list))
435 {
436 Lisp_Object overlay, start, end, old_overlay;
437 int charpos;
438
439 old_overlay = XCAR (list);
440 charpos = marker_position (OVERLAY_START (old_overlay));
441 start = Fmake_marker ();
db3a49a6 442 Fset_marker (start, make_number (charpos), buffer);
04e4cb3a
GM
443 XMARKER (start)->insertion_type
444 = XMARKER (OVERLAY_START (old_overlay))->insertion_type;
445
446 charpos = marker_position (OVERLAY_END (old_overlay));
447 end = Fmake_marker ();
db3a49a6 448 Fset_marker (end, make_number (charpos), buffer);
04e4cb3a
GM
449 XMARKER (end)->insertion_type
450 = XMARKER (OVERLAY_END (old_overlay))->insertion_type;
451
452 overlay = allocate_misc ();
453 XMISCTYPE (overlay) = Lisp_Misc_Overlay;
454 OVERLAY_START (overlay) = start;
455 OVERLAY_END (overlay) = end;
456 OVERLAY_PLIST (overlay) = Fcopy_sequence (OVERLAY_PLIST (old_overlay));
457
458 result = Fcons (overlay, result);
459 }
460
461 return Fnreverse (result);
462}
463
464
7e9d5818
GM
465/* Clone per-buffer values of buffer FROM.
466
467 Buffer TO gets the same per-buffer values as FROM, with the
468 following exceptions: (1) TO's name is left untouched, (2) markers
469 are copied and made to refer to TO, and (3) overlay lists are
470 copied. */
471
472static void
473clone_per_buffer_values (from, to)
474 struct buffer *from, *to;
475{
476 Lisp_Object to_buffer;
477 int offset;
478
479 XSETBUFFER (to_buffer, to);
480
481 for (offset = PER_BUFFER_VAR_OFFSET (name) + sizeof (Lisp_Object);
482 offset < sizeof *to;
483 offset += sizeof (Lisp_Object))
484 {
485 Lisp_Object obj;
486
487 obj = PER_BUFFER_VALUE (from, offset);
488 if (MARKERP (obj))
489 {
490 struct Lisp_Marker *m = XMARKER (obj);
491 obj = Fmake_marker ();
492 XMARKER (obj)->insertion_type = m->insertion_type;
493 set_marker_both (obj, to_buffer, m->charpos, m->bytepos);
494 }
495
496 PER_BUFFER_VALUE (to, offset) = obj;
497 }
498
7e9d5818 499 bcopy (from->local_flags, to->local_flags, sizeof to->local_flags);
04e4cb3a
GM
500
501 to->overlays_before = copy_overlays (to, from->overlays_before);
502 to->overlays_after = copy_overlays (to, from->overlays_after);
7e9d5818
GM
503}
504
505
506DEFUN ("make-indirect-buffer", Fmake_indirect_buffer, Smake_indirect_buffer,
507 2, 3,
193c3837 508 "bMake indirect buffer (to buffer): \nBName of indirect buffer: ",
7ee72033 509 doc: /* Create and return an indirect buffer for buffer BASE-BUFFER, named NAME.
018ba359
PJ
510BASE-BUFFER should be an existing buffer (or buffer name).
511NAME should be a string which is not the name of an existing buffer.
512Optional argument CLONE non-nil means preserve BASE-BUFFER's state,
513such as major and minor modes, in the indirect buffer.
7ee72033
MB
514CLONE nil means the indirect buffer's state is reset to default values. */)
515 (base_buffer, name, clone)
7e9d5818 516 Lisp_Object base_buffer, name, clone;
336cd056 517{
7e9d5818
GM
518 Lisp_Object buf;
519 struct buffer *b;
336cd056
RS
520
521 buf = Fget_buffer (name);
522 if (!NILP (buf))
d5db4077 523 error ("Buffer name `%s' is in use", SDATA (name));
336cd056
RS
524
525 base_buffer = Fget_buffer (base_buffer);
526 if (NILP (base_buffer))
d5db4077 527 error ("No such buffer: `%s'", SDATA (name));
336cd056 528
d5db4077 529 if (SCHARS (name) == 0)
336cd056
RS
530 error ("Empty string for buffer name is not allowed");
531
a21260d9 532 b = (struct buffer *) allocate_buffer ();
336cd056
RS
533 b->size = sizeof (struct buffer) / sizeof (EMACS_INT);
534
535 if (XBUFFER (base_buffer)->base_buffer)
536 b->base_buffer = XBUFFER (base_buffer)->base_buffer;
537 else
538 b->base_buffer = XBUFFER (base_buffer);
539
540 /* Use the base buffer's text object. */
541 b->text = b->base_buffer->text;
542
543 BUF_BEGV (b) = BUF_BEGV (b->base_buffer);
544 BUF_ZV (b) = BUF_ZV (b->base_buffer);
545 BUF_PT (b) = BUF_PT (b->base_buffer);
3f236a40
RS
546 BUF_BEGV_BYTE (b) = BUF_BEGV_BYTE (b->base_buffer);
547 BUF_ZV_BYTE (b) = BUF_ZV_BYTE (b->base_buffer);
548 BUF_PT_BYTE (b) = BUF_PT_BYTE (b->base_buffer);
336cd056
RS
549
550 b->newline_cache = 0;
551 b->width_run_cache = 0;
552 b->width_table = Qnil;
553
554 /* Put this on the chain of all buffers including killed ones. */
555 b->next = all_buffers;
556 all_buffers = b;
557
558 name = Fcopy_sequence (name);
ab77f05c 559 STRING_SET_INTERVALS (name, NULL_INTERVAL);
336cd056
RS
560 b->name = name;
561
562 reset_buffer (b);
13de9290 563 reset_buffer_local_variables (b, 1);
336cd056
RS
564
565 /* Put this in the alist of all live buffers. */
566 XSETBUFFER (buf, b);
567 Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));
568
569 b->mark = Fmake_marker ();
1ab256cb 570 b->name = name;
336cd056 571
abc9d959
RS
572 /* The multibyte status belongs to the base buffer. */
573 b->enable_multibyte_characters = b->base_buffer->enable_multibyte_characters;
574
336cd056
RS
575 /* Make sure the base buffer has markers for its narrowing. */
576 if (NILP (b->base_buffer->pt_marker))
577 {
578 b->base_buffer->pt_marker = Fmake_marker ();
3f236a40
RS
579 set_marker_both (b->base_buffer->pt_marker, base_buffer,
580 BUF_PT (b->base_buffer),
581 BUF_PT_BYTE (b->base_buffer));
336cd056
RS
582 }
583 if (NILP (b->base_buffer->begv_marker))
584 {
585 b->base_buffer->begv_marker = Fmake_marker ();
3f236a40
RS
586 set_marker_both (b->base_buffer->begv_marker, base_buffer,
587 BUF_BEGV (b->base_buffer),
588 BUF_BEGV_BYTE (b->base_buffer));
336cd056
RS
589 }
590 if (NILP (b->base_buffer->zv_marker))
591 {
592 b->base_buffer->zv_marker = Fmake_marker ();
3f236a40
RS
593 set_marker_both (b->base_buffer->zv_marker, base_buffer,
594 BUF_ZV (b->base_buffer),
595 BUF_ZV_BYTE (b->base_buffer));
26d84681 596 XMARKER (b->base_buffer->zv_marker)->insertion_type = 1;
336cd056
RS
597 }
598
7e9d5818
GM
599 if (NILP (clone))
600 {
601 /* Give the indirect buffer markers for its narrowing. */
602 b->pt_marker = Fmake_marker ();
603 set_marker_both (b->pt_marker, buf, BUF_PT (b), BUF_PT_BYTE (b));
604 b->begv_marker = Fmake_marker ();
605 set_marker_both (b->begv_marker, buf, BUF_BEGV (b), BUF_BEGV_BYTE (b));
606 b->zv_marker = Fmake_marker ();
607 set_marker_both (b->zv_marker, buf, BUF_ZV (b), BUF_ZV_BYTE (b));
608 XMARKER (b->zv_marker)->insertion_type = 1;
609 }
610 else
611 clone_per_buffer_values (b->base_buffer, b);
336cd056 612
a9ee7a59 613 return buf;
1ab256cb
RM
614}
615
bcd40520
RS
616/* Reinitialize everything about a buffer except its name and contents
617 and local variables. */
1ab256cb
RM
618
619void
620reset_buffer (b)
621 register struct buffer *b;
622{
623 b->filename = Qnil;
f6ed2e84 624 b->file_truename = Qnil;
1ab256cb
RM
625 b->directory = (current_buffer) ? current_buffer->directory : Qnil;
626 b->modtime = 0;
8d7a4592 627 XSETFASTINT (b->save_length, 0);
1ab256cb 628 b->last_window_start = 1;
8b264726 629 /* It is more conservative to start out "changed" than "unchanged". */
b5a225b4
GM
630 b->clip_changed = 0;
631 b->prevent_redisplay_optimizations_p = 1;
1ab256cb
RM
632 b->backed_up = Qnil;
633 b->auto_save_modified = 0;
84f6bcba 634 b->auto_save_failure_time = -1;
1ab256cb
RM
635 b->auto_save_file_name = Qnil;
636 b->read_only = Qnil;
2eec3b4e
RS
637 b->overlays_before = Qnil;
638 b->overlays_after = Qnil;
8d7a4592 639 XSETFASTINT (b->overlay_center, 1);
dfda7a7f 640 b->mark_active = Qnil;
943e065b 641 b->point_before_scroll = Qnil;
be9aafdd 642 b->file_format = Qnil;
0dc6f165 643 b->last_selected_window = Qnil;
7962a441 644 XSETINT (b->display_count, 0);
3fd364db 645 b->display_time = Qnil;
1bf08baf 646 b->enable_multibyte_characters = buffer_defaults.enable_multibyte_characters;
bb2ec976 647 b->cursor_type = buffer_defaults.cursor_type;
a3bbced0 648 b->extra_line_spacing = buffer_defaults.extra_line_spacing;
0522997d
RS
649
650 b->display_error_modiff = 0;
1ab256cb
RM
651}
652
bcd40520
RS
653/* Reset buffer B's local variables info.
654 Don't use this on a buffer that has already been in use;
655 it does not treat permanent locals consistently.
13de9290
RS
656 Instead, use Fkill_all_local_variables.
657
658 If PERMANENT_TOO is 1, then we reset permanent built-in
659 buffer-local variables. If PERMANENT_TOO is 0,
660 we preserve those. */
bcd40520 661
13de9290
RS
662static void
663reset_buffer_local_variables (b, permanent_too)
1ab256cb 664 register struct buffer *b;
13de9290 665 int permanent_too;
1ab256cb
RM
666{
667 register int offset;
7c02e886 668 int i;
1ab256cb
RM
669
670 /* Reset the major mode to Fundamental, together with all the
671 things that depend on the major mode.
672 default-major-mode is handled at a higher level.
673 We ignore it here. */
674 b->major_mode = Qfundamental_mode;
675 b->keymap = Qnil;
676 b->abbrev_table = Vfundamental_mode_abbrev_table;
677 b->mode_name = QSFundamental;
678 b->minor_modes = Qnil;
3446af9c
RS
679
680 /* If the standard case table has been altered and invalidated,
681 fix up its insides first. */
682 if (! (CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[0])
683 && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[1])
684 && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[2])))
685 Fset_standard_case_table (Vascii_downcase_table);
686
1ab256cb 687 b->downcase_table = Vascii_downcase_table;
1e9b6335
RS
688 b->upcase_table = XCHAR_TABLE (Vascii_downcase_table)->extras[0];
689 b->case_canon_table = XCHAR_TABLE (Vascii_downcase_table)->extras[1];
690 b->case_eqv_table = XCHAR_TABLE (Vascii_downcase_table)->extras[2];
3cb719bd 691 b->invisibility_spec = Qt;
2e716096
RS
692#ifndef DOS_NT
693 b->buffer_file_type = Qnil;
694#endif
3cb719bd 695
1ab256cb
RM
696#if 0
697 b->sort_table = XSTRING (Vascii_sort_table);
698 b->folding_sort_table = XSTRING (Vascii_folding_sort_table);
699#endif /* 0 */
700
13de9290 701 /* Reset all (or most) per-buffer variables to their defaults. */
1ab256cb 702 b->local_var_alist = Qnil;
7313acd0 703 for (i = 0; i < last_per_buffer_idx; ++i)
7c02e886 704 if (permanent_too || buffer_permanent_local_flags[i] == 0)
7313acd0 705 SET_PER_BUFFER_VALUE_P (b, i, 0);
1ab256cb
RM
706
707 /* For each slot that has a default value,
708 copy that into the slot. */
709
7313acd0 710 for (offset = PER_BUFFER_VAR_OFFSET (name);
7c02e886
GM
711 offset < sizeof *b;
712 offset += sizeof (Lisp_Object))
aab80822 713 {
7313acd0 714 int idx = PER_BUFFER_IDX (offset);
7c02e886
GM
715 if ((idx > 0
716 && (permanent_too
717 || buffer_permanent_local_flags[idx] == 0))
718 /* Is -2 used anywhere? */
719 || idx == -2)
7313acd0 720 PER_BUFFER_VALUE (b, offset) = PER_BUFFER_DEFAULT (offset);
aab80822 721 }
1ab256cb
RM
722}
723
01050cb5
RM
724/* We split this away from generate-new-buffer, because rename-buffer
725 and set-visited-file-name ought to be able to use this to really
726 rename the buffer properly. */
727
728DEFUN ("generate-new-buffer-name", Fgenerate_new_buffer_name, Sgenerate_new_buffer_name,
efc7e75f 729 1, 2, 0,
7ee72033 730 doc: /* Return a string that is the name of no existing buffer based on NAME.
018ba359
PJ
731If there is no live buffer named NAME, then return NAME.
732Otherwise modify name by appending `<NUMBER>', incrementing NUMBER
733until an unused name is found, and then return that name.
734Optional second argument IGNORE specifies a name that is okay to use
735\(if it is in the sequence to be tried)
7ee72033
MB
736even if a buffer with that name exists. */)
737 (name, ignore)
c273e647 738 register Lisp_Object name, ignore;
1ab256cb
RM
739{
740 register Lisp_Object gentemp, tem;
741 int count;
742 char number[10];
743
b7826503 744 CHECK_STRING (name);
1ab256cb
RM
745
746 tem = Fget_buffer (name);
265a9e55 747 if (NILP (tem))
01050cb5 748 return name;
1ab256cb
RM
749
750 count = 1;
751 while (1)
752 {
753 sprintf (number, "<%d>", ++count);
754 gentemp = concat2 (name, build_string (number));
638e4fc3 755 tem = Fstring_equal (gentemp, ignore);
c273e647
RS
756 if (!NILP (tem))
757 return gentemp;
1ab256cb 758 tem = Fget_buffer (gentemp);
265a9e55 759 if (NILP (tem))
01050cb5 760 return gentemp;
1ab256cb
RM
761 }
762}
763
764\f
765DEFUN ("buffer-name", Fbuffer_name, Sbuffer_name, 0, 1, 0,
7ee72033
MB
766 doc: /* Return the name of BUFFER, as a string.
767With no argument or nil as argument, return the name of the current buffer. */)
768 (buffer)
1ab256cb
RM
769 register Lisp_Object buffer;
770{
265a9e55 771 if (NILP (buffer))
1ab256cb 772 return current_buffer->name;
b7826503 773 CHECK_BUFFER (buffer);
1ab256cb
RM
774 return XBUFFER (buffer)->name;
775}
776
777DEFUN ("buffer-file-name", Fbuffer_file_name, Sbuffer_file_name, 0, 1, 0,
7ee72033
MB
778 doc: /* Return name of file BUFFER is visiting, or nil if none.
779No argument or nil as argument means use the current buffer. */)
780 (buffer)
1ab256cb
RM
781 register Lisp_Object buffer;
782{
265a9e55 783 if (NILP (buffer))
1ab256cb 784 return current_buffer->filename;
b7826503 785 CHECK_BUFFER (buffer);
1ab256cb
RM
786 return XBUFFER (buffer)->filename;
787}
788
336cd056
RS
789DEFUN ("buffer-base-buffer", Fbuffer_base_buffer, Sbuffer_base_buffer,
790 0, 1, 0,
7ee72033
MB
791 doc: /* Return the base buffer of indirect buffer BUFFER.
792If BUFFER is not indirect, return nil. */)
793 (buffer)
336cd056
RS
794 register Lisp_Object buffer;
795{
796 struct buffer *base;
797 Lisp_Object base_buffer;
798
799 if (NILP (buffer))
800 base = current_buffer->base_buffer;
801 else
802 {
b7826503 803 CHECK_BUFFER (buffer);
336cd056
RS
804 base = XBUFFER (buffer)->base_buffer;
805 }
806
807 if (! base)
808 return Qnil;
809 XSETBUFFER (base_buffer, base);
810 return base_buffer;
811}
812
79aa712d
RS
813DEFUN ("buffer-local-value", Fbuffer_local_value,
814 Sbuffer_local_value, 2, 2, 0,
815 doc: /* Return the value of VARIABLE in BUFFER.
816If VARIABLE does not have a buffer-local binding in BUFFER, the value
817is the default binding of variable. */)
818 (symbol, buffer)
819 register Lisp_Object symbol;
820 register Lisp_Object buffer;
821{
822 register struct buffer *buf;
823 register Lisp_Object result;
824
ae69175b
RS
825 CHECK_SYMBOL (symbol);
826 CHECK_BUFFER (buffer);
79aa712d
RS
827 buf = XBUFFER (buffer);
828
829 /* Look in local_var_list */
830 result = Fassoc (symbol, buf->local_var_alist);
831 if (NILP (result))
832 {
833 int offset, idx;
834 int found = 0;
835
836 /* Look in special slots */
837 for (offset = PER_BUFFER_VAR_OFFSET (name);
838 offset < sizeof (struct buffer);
839 /* sizeof EMACS_INT == sizeof Lisp_Object */
840 offset += (sizeof (EMACS_INT)))
841 {
842 idx = PER_BUFFER_IDX (offset);
843 if ((idx == -1 || PER_BUFFER_VALUE_P (buf, idx))
844 && SYMBOLP (PER_BUFFER_SYMBOL (offset))
845 && EQ (PER_BUFFER_SYMBOL (offset), symbol))
846 {
847 result = PER_BUFFER_VALUE (buf, offset);
848 found = 1;
849 break;
850 }
851 }
852
853 if (!found)
854 result = Fdefault_value (symbol);
855 }
856 else
f0bac7de
RS
857 {
858 Lisp_Object valcontents;
859 Lisp_Object current_alist_element;
860
861 /* What binding is loaded right now? */
862 valcontents = SYMBOL_VALUE (symbol);
863 current_alist_element
864 = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr);
865
866 /* The value of the currently loaded binding is not
867 stored in it, but rather in the realvalue slot.
868 Store that value into the binding it belongs to
869 in case that is the one we are about to use. */
870
871 Fsetcdr (current_alist_element,
872 do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue));
873
874 /* Now get the (perhaps updated) value out of the binding. */
875 result = XCDR (result);
876 }
79aa712d
RS
877
878 if (EQ (result, Qunbound))
879 return Fsignal (Qvoid_variable, Fcons (symbol, Qnil));
880
881 return result;
882}
883
1ab256cb 884DEFUN ("buffer-local-variables", Fbuffer_local_variables,
efc7e75f 885 Sbuffer_local_variables, 0, 1, 0,
7ee72033 886 doc: /* Return an alist of variables that are buffer-local in BUFFER.
018ba359
PJ
887Most elements look like (SYMBOL . VALUE), describing one variable.
888For a symbol that is locally unbound, just the symbol appears in the value.
889Note that storing new VALUEs in these elements doesn't change the variables.
7ee72033
MB
890No argument or nil as argument means use current buffer as BUFFER. */)
891 (buffer)
1ab256cb
RM
892 register Lisp_Object buffer;
893{
894 register struct buffer *buf;
553defa4 895 register Lisp_Object result;
1ab256cb 896
265a9e55 897 if (NILP (buffer))
1ab256cb
RM
898 buf = current_buffer;
899 else
900 {
b7826503 901 CHECK_BUFFER (buffer);
1ab256cb
RM
902 buf = XBUFFER (buffer);
903 }
904
553defa4
RS
905 result = Qnil;
906
1ab256cb 907 {
553defa4 908 register Lisp_Object tail;
7539e11f 909 for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail))
1ab256cb 910 {
553defa4
RS
911 Lisp_Object val, elt;
912
7539e11f 913 elt = XCAR (tail);
553defa4 914
e0585c64
RS
915 /* Reference each variable in the alist in buf.
916 If inquiring about the current buffer, this gets the current values,
917 so store them into the alist so the alist is up to date.
918 If inquiring about some other buffer, this swaps out any values
919 for that buffer, making the alist up to date automatically. */
7539e11f 920 val = find_symbol_value (XCAR (elt));
e0585c64
RS
921 /* Use the current buffer value only if buf is the current buffer. */
922 if (buf != current_buffer)
7539e11f 923 val = XCDR (elt);
553defa4
RS
924
925 /* If symbol is unbound, put just the symbol in the list. */
926 if (EQ (val, Qunbound))
7539e11f 927 result = Fcons (XCAR (elt), result);
553defa4
RS
928 /* Otherwise, put (symbol . value) in the list. */
929 else
7539e11f 930 result = Fcons (Fcons (XCAR (elt), val), result);
1ab256cb
RM
931 }
932 }
933
1ab256cb
RM
934 /* Add on all the variables stored in special slots. */
935 {
7c02e886 936 int offset, idx;
1ab256cb 937
7313acd0 938 for (offset = PER_BUFFER_VAR_OFFSET (name);
1ab256cb 939 offset < sizeof (struct buffer);
7c02e886
GM
940 /* sizeof EMACS_INT == sizeof Lisp_Object */
941 offset += (sizeof (EMACS_INT)))
1ab256cb 942 {
7313acd0
GM
943 idx = PER_BUFFER_IDX (offset);
944 if ((idx == -1 || PER_BUFFER_VALUE_P (buf, idx))
945 && SYMBOLP (PER_BUFFER_SYMBOL (offset)))
946 result = Fcons (Fcons (PER_BUFFER_SYMBOL (offset),
947 PER_BUFFER_VALUE (buf, offset)),
7c02e886 948 result);
1ab256cb
RM
949 }
950 }
553defa4
RS
951
952 return result;
1ab256cb
RM
953}
954
955\f
956DEFUN ("buffer-modified-p", Fbuffer_modified_p, Sbuffer_modified_p,
efc7e75f 957 0, 1, 0,
7ee72033
MB
958 doc: /* Return t if BUFFER was modified since its file was last read or saved.
959No argument or nil as argument means use current buffer as BUFFER. */)
960 (buffer)
1ab256cb
RM
961 register Lisp_Object buffer;
962{
963 register struct buffer *buf;
265a9e55 964 if (NILP (buffer))
1ab256cb
RM
965 buf = current_buffer;
966 else
967 {
b7826503 968 CHECK_BUFFER (buffer);
1ab256cb
RM
969 buf = XBUFFER (buffer);
970 }
971
336cd056 972 return BUF_SAVE_MODIFF (buf) < BUF_MODIFF (buf) ? Qt : Qnil;
1ab256cb
RM
973}
974
975DEFUN ("set-buffer-modified-p", Fset_buffer_modified_p, Sset_buffer_modified_p,
efc7e75f 976 1, 1, 0,
7ee72033
MB
977 doc: /* Mark current buffer as modified or unmodified according to FLAG.
978A non-nil FLAG means mark the buffer modified. */)
979 (flag)
1ab256cb
RM
980 register Lisp_Object flag;
981{
982 register int already;
983 register Lisp_Object fn;
8ec01c70 984 Lisp_Object buffer, window;
1ab256cb
RM
985
986#ifdef CLASH_DETECTION
987 /* If buffer becoming modified, lock the file.
988 If buffer becoming unmodified, unlock the file. */
989
60f4dd23 990 fn = current_buffer->file_truename;
90d456d2
KH
991 /* Test buffer-file-name so that binding it to nil is effective. */
992 if (!NILP (fn) && ! NILP (current_buffer->filename))
1ab256cb 993 {
336cd056 994 already = SAVE_MODIFF < MODIFF;
265a9e55 995 if (!already && !NILP (flag))
1ab256cb 996 lock_file (fn);
265a9e55 997 else if (already && NILP (flag))
1ab256cb
RM
998 unlock_file (fn);
999 }
1000#endif /* CLASH_DETECTION */
1001
336cd056 1002 SAVE_MODIFF = NILP (flag) ? MODIFF : 0;
8ec01c70
GM
1003
1004 /* Set update_mode_lines only if buffer is displayed in some window.
1005 Packages like jit-lock or lazy-lock preserve a buffer's modified
1006 state by recording/restoring the state around blocks of code.
1007 Setting update_mode_lines makes redisplay consider all windows
1008 (on all frames). Stealth fontification of buffers not displayed
1009 would incur additional redisplay costs if we'd set
1010 update_modes_lines unconditionally.
1011
1012 Ideally, I think there should be another mechanism for fontifying
1013 buffers without "modifying" buffers, or redisplay should be
1014 smarter about updating the `*' in mode lines. --gerd */
1015 XSETBUFFER (buffer, current_buffer);
1016 window = Fget_buffer_window (buffer, Qt);
1017 if (WINDOWP (window))
d57b83b3
GM
1018 {
1019 ++update_mode_lines;
1020 current_buffer->prevent_redisplay_optimizations_p = 1;
1021 }
8ec01c70 1022
1ab256cb
RM
1023 return flag;
1024}
1025
a8c21b48
GM
1026DEFUN ("restore-buffer-modified-p", Frestore_buffer_modified_p,
1027 Srestore_buffer_modified_p, 1, 1, 0,
7ee72033 1028 doc: /* Like `set-buffer-modified-p', with a differences concerning redisplay.
018ba359 1029It is not ensured that mode lines will be updated to show the modified
7ee72033
MB
1030state of the current buffer. Use with care. */)
1031 (flag)
a8c21b48
GM
1032 Lisp_Object flag;
1033{
1034#ifdef CLASH_DETECTION
1035 Lisp_Object fn;
1036
1037 /* If buffer becoming modified, lock the file.
1038 If buffer becoming unmodified, unlock the file. */
1039
1040 fn = current_buffer->file_truename;
1041 /* Test buffer-file-name so that binding it to nil is effective. */
1042 if (!NILP (fn) && ! NILP (current_buffer->filename))
1043 {
1044 int already = SAVE_MODIFF < MODIFF;
1045 if (!already && !NILP (flag))
1046 lock_file (fn);
1047 else if (already && NILP (flag))
1048 unlock_file (fn);
1049 }
1050#endif /* CLASH_DETECTION */
1051
1052 SAVE_MODIFF = NILP (flag) ? MODIFF : 0;
1053 return flag;
1054}
1055
1ab256cb 1056DEFUN ("buffer-modified-tick", Fbuffer_modified_tick, Sbuffer_modified_tick,
efc7e75f 1057 0, 1, 0,
7ee72033 1058 doc: /* Return BUFFER's tick counter, incremented for each change in text.
018ba359
PJ
1059Each buffer has a tick counter which is incremented each time the text in
1060that buffer is changed. It wraps around occasionally.
7ee72033
MB
1061No argument or nil as argument means use current buffer as BUFFER. */)
1062 (buffer)
1ab256cb
RM
1063 register Lisp_Object buffer;
1064{
1065 register struct buffer *buf;
265a9e55 1066 if (NILP (buffer))
1ab256cb
RM
1067 buf = current_buffer;
1068 else
1069 {
b7826503 1070 CHECK_BUFFER (buffer);
1ab256cb
RM
1071 buf = XBUFFER (buffer);
1072 }
1073
1074 return make_number (BUF_MODIFF (buf));
1075}
1076\f
01050cb5 1077DEFUN ("rename-buffer", Frename_buffer, Srename_buffer, 1, 2,
4c7e5f09 1078 "sRename buffer (to new name): \nP",
7ee72033 1079 doc: /* Change current buffer's name to NEWNAME (a string).
018ba359
PJ
1080If second arg UNIQUE is nil or omitted, it is an error if a
1081buffer named NEWNAME already exists.
1082If UNIQUE is non-nil, come up with a new name using
1083`generate-new-buffer-name'.
1084Interactively, you can set UNIQUE with a prefix argument.
1085We return the name we actually gave the buffer.
7ee72033
MB
1086This does not change the name of the visited file (if any). */)
1087 (newname, unique)
489c043a 1088 register Lisp_Object newname, unique;
1ab256cb
RM
1089{
1090 register Lisp_Object tem, buf;
1091
b7826503 1092 CHECK_STRING (newname);
d59698c4 1093
d5db4077 1094 if (SCHARS (newname) == 0)
d59698c4
RS
1095 error ("Empty string is invalid as a buffer name");
1096
489c043a 1097 tem = Fget_buffer (newname);
265a9e55 1098 if (!NILP (tem))
01050cb5 1099 {
8801a864
KR
1100 /* Don't short-circuit if UNIQUE is t. That is a useful way to
1101 rename the buffer automatically so you can create another
1102 with the original name. It makes UNIQUE equivalent to
1103 (rename-buffer (generate-new-buffer-name NEWNAME)). */
1104 if (NILP (unique) && XBUFFER (tem) == current_buffer)
1105 return current_buffer->name;
3bd779aa 1106 if (!NILP (unique))
489c043a 1107 newname = Fgenerate_new_buffer_name (newname, current_buffer->name);
01050cb5 1108 else
d5db4077 1109 error ("Buffer name `%s' is in use", SDATA (newname));
01050cb5 1110 }
1ab256cb 1111
489c043a 1112 current_buffer->name = newname;
76f590d7
JB
1113
1114 /* Catch redisplay's attention. Unless we do this, the mode lines for
1115 any windows displaying current_buffer will stay unchanged. */
1116 update_mode_lines++;
1117
67180c6a 1118 XSETBUFFER (buf, current_buffer);
489c043a 1119 Fsetcar (Frassq (buf, Vbuffer_alist), newname);
cf058e49
KH
1120 if (NILP (current_buffer->filename)
1121 && !NILP (current_buffer->auto_save_file_name))
1ab256cb 1122 call0 (intern ("rename-auto-save-file"));
fb5eba9c
RS
1123 /* Refetch since that last call may have done GC. */
1124 return current_buffer->name;
1ab256cb
RM
1125}
1126
773fbdb9 1127DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 3, 0,
7ee72033 1128 doc: /* Return most recently selected buffer other than BUFFER.
018ba359
PJ
1129Buffers not visible in windows are preferred to visible buffers,
1130unless optional second argument VISIBLE-OK is non-nil.
1131If the optional third argument FRAME is non-nil, use that frame's
1132buffer list instead of the selected frame's buffer list.
1133If no other buffer exists, the buffer `*scratch*' is returned.
7ee72033
MB
1134If BUFFER is omitted or nil, some interesting buffer is returned. */)
1135 (buffer, visible_ok, frame)
773fbdb9 1136 register Lisp_Object buffer, visible_ok, frame;
1ab256cb 1137{
89132f25 1138 Lisp_Object Fset_buffer_major_mode ();
7962a441 1139 register Lisp_Object tail, buf, notsogood, tem, pred, add_ons;
1ab256cb
RM
1140 notsogood = Qnil;
1141
773fbdb9 1142 if (NILP (frame))
9ba9623d 1143 frame = selected_frame;
773fbdb9 1144
7962a441 1145 tail = Vbuffer_alist;
773fbdb9 1146 pred = frame_buffer_predicate (frame);
7962a441
RS
1147
1148 /* Consider buffers that have been seen in the selected frame
1149 before other buffers. */
1150
773fbdb9 1151 tem = frame_buffer_list (frame);
7962a441
RS
1152 add_ons = Qnil;
1153 while (CONSP (tem))
1154 {
7539e11f
KR
1155 if (BUFFERP (XCAR (tem)))
1156 add_ons = Fcons (Fcons (Qnil, XCAR (tem)), add_ons);
1157 tem = XCDR (tem);
7962a441
RS
1158 }
1159 tail = nconc2 (Fnreverse (add_ons), tail);
1160
1161 for (; !NILP (tail); tail = Fcdr (tail))
1ab256cb
RM
1162 {
1163 buf = Fcdr (Fcar (tail));
1164 if (EQ (buf, buffer))
1165 continue;
d5db4077 1166 if (SDATA (XBUFFER (buf)->name)[0] == ' ')
1ab256cb 1167 continue;
04ae1b48
RS
1168 /* If the selected frame has a buffer_predicate,
1169 disregard buffers that don't fit the predicate. */
7962a441 1170 if (!NILP (pred))
04ae1b48 1171 {
7962a441 1172 tem = call1 (pred, buf);
04ae1b48
RS
1173 if (NILP (tem))
1174 continue;
1175 }
04ae1b48 1176
a0ebb746 1177 if (NILP (visible_ok))
66ffe51c 1178 tem = Fget_buffer_window (buf, Qvisible);
a0ebb746
JB
1179 else
1180 tem = Qnil;
265a9e55 1181 if (NILP (tem))
1ab256cb 1182 return buf;
265a9e55 1183 if (NILP (notsogood))
1ab256cb
RM
1184 notsogood = buf;
1185 }
265a9e55 1186 if (!NILP (notsogood))
1ab256cb 1187 return notsogood;
dba1a30a
GM
1188 buf = Fget_buffer (build_string ("*scratch*"));
1189 if (NILP (buf))
1190 {
1191 buf = Fget_buffer_create (build_string ("*scratch*"));
1192 Fset_buffer_major_mode (buf);
1193 }
89132f25 1194 return buf;
1ab256cb
RM
1195}
1196\f
316784fb
KH
1197DEFUN ("buffer-disable-undo", Fbuffer_disable_undo, Sbuffer_disable_undo,
1198 0, 1, "",
7ee72033
MB
1199 doc: /* Make BUFFER stop keeping undo information.
1200No argument or nil as argument means do this for the current buffer. */)
1201 (buffer)
ffd56f97 1202 register Lisp_Object buffer;
1ab256cb 1203{
ffd56f97
JB
1204 Lisp_Object real_buffer;
1205
1206 if (NILP (buffer))
67180c6a 1207 XSETBUFFER (real_buffer, current_buffer);
ffd56f97
JB
1208 else
1209 {
1210 real_buffer = Fget_buffer (buffer);
1211 if (NILP (real_buffer))
1212 nsberror (buffer);
1213 }
1214
1215 XBUFFER (real_buffer)->undo_list = Qt;
1216
1ab256cb
RM
1217 return Qnil;
1218}
1219
1220DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, Sbuffer_enable_undo,
1221 0, 1, "",
7ee72033
MB
1222 doc: /* Start keeping undo information for buffer BUFFER.
1223No argument or nil as argument means do this for the current buffer. */)
1224 (buffer)
ffd56f97 1225 register Lisp_Object buffer;
1ab256cb 1226{
ffd56f97 1227 Lisp_Object real_buffer;
1ab256cb 1228
ffd56f97 1229 if (NILP (buffer))
67180c6a 1230 XSETBUFFER (real_buffer, current_buffer);
1ab256cb
RM
1231 else
1232 {
ffd56f97
JB
1233 real_buffer = Fget_buffer (buffer);
1234 if (NILP (real_buffer))
1235 nsberror (buffer);
1ab256cb
RM
1236 }
1237
ffd56f97
JB
1238 if (EQ (XBUFFER (real_buffer)->undo_list, Qt))
1239 XBUFFER (real_buffer)->undo_list = Qnil;
1ab256cb
RM
1240
1241 return Qnil;
1242}
1243
1244/*
1245 DEFVAR_LISP ("kill-buffer-hook", no_cell, "\
1246Hook to be run (by `run-hooks', which see) when a buffer is killed.\n\
1247The buffer being killed will be current while the hook is running.\n\
1248See `kill-buffer'."
1249 */
1250DEFUN ("kill-buffer", Fkill_buffer, Skill_buffer, 1, 1, "bKill buffer: ",
7ee72033 1251 doc: /* Kill the buffer BUFFER.
018ba359
PJ
1252The argument may be a buffer or may be the name of a buffer.
1253An argument of nil means kill the current buffer.
1254
1255Value is t if the buffer is actually killed, nil if user says no.
1256
1257The value of `kill-buffer-hook' (which may be local to that buffer),
1258if not void, is a list of functions to be called, with no arguments,
1259before the buffer is actually killed. The buffer to be killed is current
1260when the hook functions are called.
1261
1262Any processes that have this buffer as the `process-buffer' are killed
7ee72033
MB
1263with SIGHUP. */)
1264 (buffer)
a25f13ae 1265 Lisp_Object buffer;
1ab256cb
RM
1266{
1267 Lisp_Object buf;
1268 register struct buffer *b;
1269 register Lisp_Object tem;
1270 register struct Lisp_Marker *m;
6af718a4 1271 struct gcpro gcpro1;
1ab256cb 1272
a25f13ae 1273 if (NILP (buffer))
1ab256cb
RM
1274 buf = Fcurrent_buffer ();
1275 else
a25f13ae 1276 buf = Fget_buffer (buffer);
265a9e55 1277 if (NILP (buf))
a25f13ae 1278 nsberror (buffer);
1ab256cb
RM
1279
1280 b = XBUFFER (buf);
1281
4a4a9db5
KH
1282 /* Avoid trouble for buffer already dead. */
1283 if (NILP (b->name))
1284 return Qnil;
1285
1ab256cb 1286 /* Query if the buffer is still modified. */
265a9e55 1287 if (INTERACTIVE && !NILP (b->filename)
336cd056 1288 && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b))
1ab256cb 1289 {
a25f13ae 1290 GCPRO1 (buf);
1ab256cb 1291 tem = do_yes_or_no_p (format1 ("Buffer %s modified; kill anyway? ",
d5db4077 1292 SDATA (b->name)));
1ab256cb 1293 UNGCPRO;
265a9e55 1294 if (NILP (tem))
1ab256cb
RM
1295 return Qnil;
1296 }
1297
dcdffbf6 1298 /* Run hooks with the buffer to be killed the current buffer. */
1ab256cb 1299 {
aed13378 1300 int count = SPECPDL_INDEX ();
dcdffbf6 1301 Lisp_Object list;
1ab256cb
RM
1302
1303 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1304 set_buffer_internal (b);
dcdffbf6
RS
1305
1306 /* First run the query functions; if any query is answered no,
1307 don't kill the buffer. */
1308 for (list = Vkill_buffer_query_functions; !NILP (list); list = Fcdr (list))
1309 {
1310 tem = call0 (Fcar (list));
1311 if (NILP (tem))
1312 return unbind_to (count, Qnil);
1313 }
1314
1315 /* Then run the hooks. */
f1597a3a 1316 Frun_hooks (1, &Qkill_buffer_hook);
1ab256cb
RM
1317 unbind_to (count, Qnil);
1318 }
1319
1320 /* We have no more questions to ask. Verify that it is valid
1321 to kill the buffer. This must be done after the questions
1322 since anything can happen within do_yes_or_no_p. */
1323
1324 /* Don't kill the minibuffer now current. */
1325 if (EQ (buf, XWINDOW (minibuf_window)->buffer))
1326 return Qnil;
1327
265a9e55 1328 if (NILP (b->name))
1ab256cb
RM
1329 return Qnil;
1330
336cd056
RS
1331 /* When we kill a base buffer, kill all its indirect buffers.
1332 We do it at this stage so nothing terrible happens if they
1333 ask questions or their hooks get errors. */
1334 if (! b->base_buffer)
1335 {
1336 struct buffer *other;
1337
1338 GCPRO1 (buf);
1339
1340 for (other = all_buffers; other; other = other->next)
4a4a9db5
KH
1341 /* all_buffers contains dead buffers too;
1342 don't re-kill them. */
1343 if (other->base_buffer == b && !NILP (other->name))
336cd056
RS
1344 {
1345 Lisp_Object buf;
1346 XSETBUFFER (buf, other);
1347 Fkill_buffer (buf);
1348 }
1349
1350 UNGCPRO;
1351 }
1352
1ab256cb
RM
1353 /* Make this buffer not be current.
1354 In the process, notice if this is the sole visible buffer
1355 and give up if so. */
1356 if (b == current_buffer)
1357 {
773fbdb9 1358 tem = Fother_buffer (buf, Qnil, Qnil);
1ab256cb
RM
1359 Fset_buffer (tem);
1360 if (b == current_buffer)
1361 return Qnil;
1362 }
1363
77270fac
GM
1364 /* Notice if the buffer to kill is the sole visible buffer
1365 when we're currently in the mini-buffer, and give up if so. */
1366 XSETBUFFER (tem, current_buffer);
1367 if (EQ (tem, XWINDOW (minibuf_window)->buffer))
1368 {
1369 tem = Fother_buffer (buf, Qnil, Qnil);
77270fac
GM
1370 if (EQ (buf, tem))
1371 return Qnil;
1372 }
1373
1ab256cb
RM
1374 /* Now there is no question: we can kill the buffer. */
1375
1376#ifdef CLASH_DETECTION
1377 /* Unlock this buffer's file, if it is locked. */
1378 unlock_buffer (b);
1379#endif /* CLASH_DETECTION */
1380
1ab256cb 1381 kill_buffer_processes (buf);
1ab256cb
RM
1382
1383 tem = Vinhibit_quit;
1384 Vinhibit_quit = Qt;
00550f94 1385 replace_buffer_in_all_windows (buf);
b26dd9cb 1386 Vbuffer_alist = Fdelq (Frassq (buf, Vbuffer_alist), Vbuffer_alist);
7962a441 1387 frames_discard_buffer (buf);
1ab256cb
RM
1388 Vinhibit_quit = tem;
1389
9cf712eb
RS
1390 /* Delete any auto-save file, if we saved it in this session.
1391 But not if the buffer is modified. */
a7a60ce9 1392 if (STRINGP (b->auto_save_file_name)
e95a0b39 1393 && b->auto_save_modified != 0
9cf712eb
RS
1394 && BUF_SAVE_MODIFF (b) < b->auto_save_modified
1395 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
1ab256cb
RM
1396 {
1397 Lisp_Object tem;
1398 tem = Fsymbol_value (intern ("delete-auto-save-files"));
265a9e55 1399 if (! NILP (tem))
cbb6a418 1400 internal_delete_file (b->auto_save_file_name);
1ab256cb
RM
1401 }
1402
4a4a9db5
KH
1403 if (b->base_buffer)
1404 {
1405 /* Unchain all markers that belong to this indirect buffer.
1406 Don't unchain the markers that belong to the base buffer
1407 or its other indirect buffers. */
1408 for (tem = BUF_MARKERS (b); !NILP (tem); )
1409 {
1410 Lisp_Object next;
1411 m = XMARKER (tem);
1412 next = m->chain;
1413 if (m->buffer == b)
1414 unchain_marker (tem);
1415 tem = next;
1416 }
1417 }
1418 else
1ab256cb 1419 {
4a4a9db5 1420 /* Unchain all markers of this buffer and its indirect buffers.
336cd056 1421 and leave them pointing nowhere. */
4a4a9db5 1422 for (tem = BUF_MARKERS (b); !NILP (tem); )
336cd056
RS
1423 {
1424 m = XMARKER (tem);
1425 m->buffer = 0;
1426 tem = m->chain;
1427 m->chain = Qnil;
1428 }
1429 BUF_MARKERS (b) = Qnil;
336cd056 1430 BUF_INTERVALS (b) = NULL_INTERVAL;
336cd056
RS
1431
1432 /* Perhaps we should explicitly free the interval tree here... */
1433 }
33f7013e 1434
2f3f993b
RS
1435 /* Reset the local variables, so that this buffer's local values
1436 won't be protected from GC. They would be protected
1437 if they happened to remain encached in their symbols.
1438 This gets rid of them for certain. */
1439 swap_out_buffer_local_variables (b);
13de9290 1440 reset_buffer_local_variables (b, 1);
2f3f993b 1441
1ab256cb 1442 b->name = Qnil;
336cd056 1443
9ac0d9e0 1444 BLOCK_INPUT;
336cd056 1445 if (! b->base_buffer)
b86af064 1446 free_buffer_text (b);
336cd056 1447
28e969dd
JB
1448 if (b->newline_cache)
1449 {
1450 free_region_cache (b->newline_cache);
1451 b->newline_cache = 0;
1452 }
1453 if (b->width_run_cache)
1454 {
1455 free_region_cache (b->width_run_cache);
1456 b->width_run_cache = 0;
1457 }
1458 b->width_table = Qnil;
9ac0d9e0 1459 UNBLOCK_INPUT;
1ab256cb
RM
1460 b->undo_list = Qnil;
1461
1462 return Qt;
1463}
1464\f
36a8c287
JB
1465/* Move the assoc for buffer BUF to the front of buffer-alist. Since
1466 we do this each time BUF is selected visibly, the more recently
1467 selected buffers are always closer to the front of the list. This
1468 means that other_buffer is more likely to choose a relevant buffer. */
1ab256cb 1469
01136e9b 1470void
1ab256cb
RM
1471record_buffer (buf)
1472 Lisp_Object buf;
1473{
1474 register Lisp_Object link, prev;
773fbdb9 1475 Lisp_Object frame;
9ba9623d 1476 frame = selected_frame;
1ab256cb
RM
1477
1478 prev = Qnil;
7539e11f 1479 for (link = Vbuffer_alist; CONSP (link); link = XCDR (link))
1ab256cb 1480 {
7539e11f 1481 if (EQ (XCDR (XCAR (link)), buf))
1ab256cb
RM
1482 break;
1483 prev = link;
1484 }
1485
36a8c287
JB
1486 /* Effectively do Vbuffer_alist = Fdelq (link, Vbuffer_alist);
1487 we cannot use Fdelq itself here because it allows quitting. */
1ab256cb 1488
265a9e55 1489 if (NILP (prev))
7539e11f 1490 Vbuffer_alist = XCDR (Vbuffer_alist);
1ab256cb 1491 else
f3fbd155 1492 XSETCDR (prev, XCDR (XCDR (prev)));
1ab256cb 1493
f3fbd155 1494 XSETCDR (link, Vbuffer_alist);
1ab256cb 1495 Vbuffer_alist = link;
7962a441
RS
1496
1497 /* Now move this buffer to the front of frame_buffer_list also. */
1498
1499 prev = Qnil;
773fbdb9 1500 for (link = frame_buffer_list (frame); CONSP (link);
7539e11f 1501 link = XCDR (link))
7962a441 1502 {
7539e11f 1503 if (EQ (XCAR (link), buf))
7962a441
RS
1504 break;
1505 prev = link;
1506 }
1507
1508 /* Effectively do delq. */
1509
1510 if (CONSP (link))
1511 {
1512 if (NILP (prev))
773fbdb9 1513 set_frame_buffer_list (frame,
7539e11f 1514 XCDR (frame_buffer_list (frame)));
7962a441 1515 else
f3fbd155 1516 XSETCDR (prev, XCDR (XCDR (prev)));
7962a441 1517
f3fbd155 1518 XSETCDR (link, frame_buffer_list (frame));
773fbdb9 1519 set_frame_buffer_list (frame, link);
7962a441
RS
1520 }
1521 else
773fbdb9 1522 set_frame_buffer_list (frame, Fcons (buf, frame_buffer_list (frame)));
1ab256cb
RM
1523}
1524
a9ee7a59 1525DEFUN ("set-buffer-major-mode", Fset_buffer_major_mode, Sset_buffer_major_mode, 1, 1, 0,
7ee72033 1526 doc: /* Set an appropriate major mode for BUFFER.
864b90c9 1527For the *scratch* buffer, use `initial-major-mode', otherwise choose a mode
71a0f2c6 1528according to `default-major-mode'.
018ba359 1529Use this function before selecting the buffer, since it may need to inspect
7ee72033
MB
1530the current buffer's major mode. */)
1531 (buffer)
a2428fa2 1532 Lisp_Object buffer;
a9ee7a59
KH
1533{
1534 int count;
1535 Lisp_Object function;
1536
71a0f2c6 1537 if (STRINGP (XBUFFER (buffer)->name)
d5db4077 1538 && strcmp (SDATA (XBUFFER (buffer)->name), "*scratch*") == 0)
71a0f2c6
GM
1539 function = find_symbol_value (intern ("initial-major-mode"));
1540 else
1541 {
1542 function = buffer_defaults.major_mode;
1543 if (NILP (function)
1544 && NILP (Fget (current_buffer->major_mode, Qmode_class)))
1545 function = current_buffer->major_mode;
1546 }
1547
a9ee7a59
KH
1548 if (NILP (function) || EQ (function, Qfundamental_mode))
1549 return Qnil;
1550
aed13378 1551 count = SPECPDL_INDEX ();
a9ee7a59
KH
1552
1553 /* To select a nonfundamental mode,
1554 select the buffer temporarily and then call the mode function. */
1555
1556 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1557
a2428fa2 1558 Fset_buffer (buffer);
a9ee7a59
KH
1559 call0 (function);
1560
1561 return unbind_to (count, Qnil);
1562}
1563
2594e0fd
RS
1564/* If switching buffers in WINDOW would be an error, return
1565 a C string saying what the error would be. */
1566
1567char *
1568no_switch_window (window)
1569 Lisp_Object window;
1ab256cb 1570{
1ab256cb 1571 Lisp_Object tem;
2594e0fd
RS
1572 if (EQ (minibuf_window, window))
1573 return "Cannot switch buffers in minibuffer window";
1574 tem = Fwindow_dedicated_p (window);
c01d0677 1575 if (EQ (tem, Qt))
2594e0fd
RS
1576 return "Cannot switch buffers in a dedicated window";
1577 return NULL;
1578}
1579
1580/* Switch to buffer BUFFER in the selected window.
1581 If NORECORD is non-nil, don't call record_buffer. */
1582
1583Lisp_Object
1584switch_to_buffer_1 (buffer, norecord)
1585 Lisp_Object buffer, norecord;
1586{
1587 register Lisp_Object buf;
1ab256cb 1588
a25f13ae 1589 if (NILP (buffer))
773fbdb9 1590 buf = Fother_buffer (Fcurrent_buffer (), Qnil, Qnil);
1ab256cb 1591 else
a9ee7a59 1592 {
a25f13ae 1593 buf = Fget_buffer (buffer);
a9ee7a59
KH
1594 if (NILP (buf))
1595 {
a25f13ae 1596 buf = Fget_buffer_create (buffer);
a9ee7a59
KH
1597 Fset_buffer_major_mode (buf);
1598 }
1599 }
1ab256cb 1600 Fset_buffer (buf);
265a9e55 1601 if (NILP (norecord))
1ab256cb
RM
1602 record_buffer (buf);
1603
1604 Fset_window_buffer (EQ (selected_window, minibuf_window)
5fcd022d
JB
1605 ? Fnext_window (minibuf_window, Qnil, Qnil)
1606 : selected_window,
1ab256cb
RM
1607 buf);
1608
cd0c235a 1609 return buf;
1ab256cb
RM
1610}
1611
2594e0fd 1612DEFUN ("switch-to-buffer", Fswitch_to_buffer, Sswitch_to_buffer, 1, 2, "BSwitch to buffer: ",
7ee72033 1613 doc: /* Select buffer BUFFER in the current window.
018ba359
PJ
1614BUFFER may be a buffer or a buffer name.
1615Optional second arg NORECORD non-nil means
1616do not put this buffer at the front of the list of recently selected ones.
1617
1618WARNING: This is NOT the way to work on another buffer temporarily
1619within a Lisp program! Use `set-buffer' instead. That avoids messing with
7ee72033
MB
1620the window-buffer correspondences. */)
1621 (buffer, norecord)
2594e0fd
RS
1622 Lisp_Object buffer, norecord;
1623{
1624 char *err;
1625
1626 err = no_switch_window (selected_window);
1627 if (err) error (err);
1628
1629 return switch_to_buffer_1 (buffer, norecord);
1630}
1631
cd0c235a 1632DEFUN ("pop-to-buffer", Fpop_to_buffer, Spop_to_buffer, 1, 3, 0,
7ee72033 1633 doc: /* Select buffer BUFFER in some window, preferably a different one.
018ba359
PJ
1634If BUFFER is nil, then some other buffer is chosen.
1635If `pop-up-windows' is non-nil, windows can be split to do this.
1636If optional second arg OTHER-WINDOW is non-nil, insist on finding another
1637window even if BUFFER is already visible in the selected window.
1638This uses the function `display-buffer' as a subroutine; see the documentation
1639of `display-buffer' for additional customization information.
1640
1641Optional third arg NORECORD non-nil means
7ee72033
MB
1642do not put this buffer at the front of the list of recently selected ones. */)
1643 (buffer, other_window, norecord)
6d12711f 1644 Lisp_Object buffer, other_window, norecord;
1ab256cb
RM
1645{
1646 register Lisp_Object buf;
a25f13ae 1647 if (NILP (buffer))
773fbdb9 1648 buf = Fother_buffer (Fcurrent_buffer (), Qnil, Qnil);
1ab256cb 1649 else
7c2087ee 1650 {
a25f13ae 1651 buf = Fget_buffer (buffer);
7c2087ee
RS
1652 if (NILP (buf))
1653 {
a25f13ae 1654 buf = Fget_buffer_create (buffer);
7c2087ee
RS
1655 Fset_buffer_major_mode (buf);
1656 }
1657 }
1ab256cb 1658 Fset_buffer (buf);
6d12711f 1659 if (NILP (norecord))
c58dab63 1660 /* This seems bogus since Fselect_window will call record_buffer anyway. */
6d12711f 1661 record_buffer (buf);
6b17d756 1662 Fselect_window (Fdisplay_buffer (buf, other_window, Qnil));
e8b3a22d 1663 return buf;
1ab256cb
RM
1664}
1665
1666DEFUN ("current-buffer", Fcurrent_buffer, Scurrent_buffer, 0, 0, 0,
7ee72033
MB
1667 doc: /* Return the current buffer as a Lisp object. */)
1668 ()
1ab256cb
RM
1669{
1670 register Lisp_Object buf;
67180c6a 1671 XSETBUFFER (buf, current_buffer);
1ab256cb
RM
1672 return buf;
1673}
1674\f
7ec44ec6
GM
1675/* Set the current buffer to B.
1676
1677 We previously set windows_or_buffers_changed here to invalidate
1678 global unchanged information in beg_unchanged and end_unchanged.
1679 This is no longer necessary because we now compute unchanged
1680 information on a buffer-basis. Every action affecting other
1681 windows than the selected one requires a select_window at some
1682 time, and that increments windows_or_buffers_changed. */
1ab256cb
RM
1683
1684void
1685set_buffer_internal (b)
1686 register struct buffer *b;
1687{
b5a225b4 1688 if (current_buffer != b)
7ec44ec6 1689 set_buffer_internal_1 (b);
c7aa5005
KH
1690}
1691
1692/* Set the current buffer to B, and do not set windows_or_buffers_changed.
1693 This is used by redisplay. */
1694
1695void
1696set_buffer_internal_1 (b)
1697 register struct buffer *b;
1698{
1699 register struct buffer *old_buf;
1700 register Lisp_Object tail, valcontents;
1701 Lisp_Object tem;
1702
b86af064 1703#ifdef USE_MMAP_FOR_BUFFERS
684b01ee 1704 if (b->text->beg == NULL)
b86af064
GM
1705 enlarge_buffer_text (b, 0);
1706#endif /* USE_MMAP_FOR_BUFFERS */
684b01ee 1707
c7aa5005
KH
1708 if (current_buffer == b)
1709 return;
1710
1ab256cb
RM
1711 old_buf = current_buffer;
1712 current_buffer = b;
1713 last_known_column_point = -1; /* invalidate indentation cache */
1714
336cd056
RS
1715 if (old_buf)
1716 {
1717 /* Put the undo list back in the base buffer, so that it appears
1718 that an indirect buffer shares the undo list of its base. */
1719 if (old_buf->base_buffer)
1720 old_buf->base_buffer->undo_list = old_buf->undo_list;
1721
1722 /* If the old current buffer has markers to record PT, BEGV and ZV
1723 when it is not current, update them now. */
1724 if (! NILP (old_buf->pt_marker))
1725 {
1726 Lisp_Object obuf;
1727 XSETBUFFER (obuf, old_buf);
3f236a40
RS
1728 set_marker_both (old_buf->pt_marker, obuf,
1729 BUF_PT (old_buf), BUF_PT_BYTE (old_buf));
336cd056
RS
1730 }
1731 if (! NILP (old_buf->begv_marker))
1732 {
1733 Lisp_Object obuf;
1734 XSETBUFFER (obuf, old_buf);
3f236a40
RS
1735 set_marker_both (old_buf->begv_marker, obuf,
1736 BUF_BEGV (old_buf), BUF_BEGV_BYTE (old_buf));
336cd056
RS
1737 }
1738 if (! NILP (old_buf->zv_marker))
1739 {
1740 Lisp_Object obuf;
1741 XSETBUFFER (obuf, old_buf);
3f236a40
RS
1742 set_marker_both (old_buf->zv_marker, obuf,
1743 BUF_ZV (old_buf), BUF_ZV_BYTE (old_buf));
336cd056
RS
1744 }
1745 }
1746
1747 /* Get the undo list from the base buffer, so that it appears
1748 that an indirect buffer shares the undo list of its base. */
1749 if (b->base_buffer)
1750 b->undo_list = b->base_buffer->undo_list;
1751
1752 /* If the new current buffer has markers to record PT, BEGV and ZV
1753 when it is not current, fetch them now. */
1754 if (! NILP (b->pt_marker))
3f236a40
RS
1755 {
1756 BUF_PT (b) = marker_position (b->pt_marker);
1757 BUF_PT_BYTE (b) = marker_byte_position (b->pt_marker);
1758 }
336cd056 1759 if (! NILP (b->begv_marker))
3f236a40
RS
1760 {
1761 BUF_BEGV (b) = marker_position (b->begv_marker);
1762 BUF_BEGV_BYTE (b) = marker_byte_position (b->begv_marker);
1763 }
336cd056 1764 if (! NILP (b->zv_marker))
3f236a40
RS
1765 {
1766 BUF_ZV (b) = marker_position (b->zv_marker);
1767 BUF_ZV_BYTE (b) = marker_byte_position (b->zv_marker);
1768 }
336cd056 1769
1ab256cb
RM
1770 /* Look down buffer's list of local Lisp variables
1771 to find and update any that forward into C variables. */
1772
7539e11f 1773 for (tail = b->local_var_alist; !NILP (tail); tail = XCDR (tail))
1ab256cb 1774 {
f5c1dd0d 1775 valcontents = SYMBOL_VALUE (XCAR (XCAR (tail)));
a7a60ce9
KH
1776 if ((BUFFER_LOCAL_VALUEP (valcontents)
1777 || SOME_BUFFER_LOCAL_VALUEP (valcontents))
3d871c85 1778 && (tem = XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
a7a60ce9 1779 (BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem))))
1ab256cb
RM
1780 /* Just reference the variable
1781 to cause it to become set for this buffer. */
7539e11f 1782 Fsymbol_value (XCAR (XCAR (tail)));
1ab256cb
RM
1783 }
1784
1785 /* Do the same with any others that were local to the previous buffer */
1786
1787 if (old_buf)
7539e11f 1788 for (tail = old_buf->local_var_alist; !NILP (tail); tail = XCDR (tail))
1ab256cb 1789 {
f5c1dd0d 1790 valcontents = SYMBOL_VALUE (XCAR (XCAR (tail)));
a7a60ce9
KH
1791 if ((BUFFER_LOCAL_VALUEP (valcontents)
1792 || SOME_BUFFER_LOCAL_VALUEP (valcontents))
3d871c85 1793 && (tem = XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
a7a60ce9 1794 (BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem))))
1ab256cb
RM
1795 /* Just reference the variable
1796 to cause it to become set for this buffer. */
7539e11f 1797 Fsymbol_value (XCAR (XCAR (tail)));
1ab256cb
RM
1798 }
1799}
1800
336cd056 1801/* Switch to buffer B temporarily for redisplay purposes.
bbbe9545 1802 This avoids certain things that don't need to be done within redisplay. */
336cd056
RS
1803
1804void
1805set_buffer_temp (b)
1806 struct buffer *b;
1807{
1808 register struct buffer *old_buf;
1809
1810 if (current_buffer == b)
1811 return;
1812
1813 old_buf = current_buffer;
1814 current_buffer = b;
1815
1816 if (old_buf)
1817 {
1818 /* If the old current buffer has markers to record PT, BEGV and ZV
1819 when it is not current, update them now. */
1820 if (! NILP (old_buf->pt_marker))
1821 {
1822 Lisp_Object obuf;
1823 XSETBUFFER (obuf, old_buf);
3f236a40
RS
1824 set_marker_both (old_buf->pt_marker, obuf,
1825 BUF_PT (old_buf), BUF_PT_BYTE (old_buf));
336cd056
RS
1826 }
1827 if (! NILP (old_buf->begv_marker))
1828 {
1829 Lisp_Object obuf;
1830 XSETBUFFER (obuf, old_buf);
3f236a40
RS
1831 set_marker_both (old_buf->begv_marker, obuf,
1832 BUF_BEGV (old_buf), BUF_BEGV_BYTE (old_buf));
336cd056
RS
1833 }
1834 if (! NILP (old_buf->zv_marker))
1835 {
1836 Lisp_Object obuf;
1837 XSETBUFFER (obuf, old_buf);
3f236a40
RS
1838 set_marker_both (old_buf->zv_marker, obuf,
1839 BUF_ZV (old_buf), BUF_ZV_BYTE (old_buf));
336cd056
RS
1840 }
1841 }
1842
1843 /* If the new current buffer has markers to record PT, BEGV and ZV
1844 when it is not current, fetch them now. */
1845 if (! NILP (b->pt_marker))
3f236a40
RS
1846 {
1847 BUF_PT (b) = marker_position (b->pt_marker);
1848 BUF_PT_BYTE (b) = marker_byte_position (b->pt_marker);
1849 }
336cd056 1850 if (! NILP (b->begv_marker))
3f236a40
RS
1851 {
1852 BUF_BEGV (b) = marker_position (b->begv_marker);
1853 BUF_BEGV_BYTE (b) = marker_byte_position (b->begv_marker);
1854 }
336cd056 1855 if (! NILP (b->zv_marker))
3f236a40
RS
1856 {
1857 BUF_ZV (b) = marker_position (b->zv_marker);
1858 BUF_ZV_BYTE (b) = marker_byte_position (b->zv_marker);
1859 }
336cd056
RS
1860}
1861
1ab256cb 1862DEFUN ("set-buffer", Fset_buffer, Sset_buffer, 1, 1, 0,
7ee72033 1863 doc: /* Make the buffer BUFFER current for editing operations.
018ba359
PJ
1864BUFFER may be a buffer or the name of an existing buffer.
1865See also `save-excursion' when you want to make a buffer current temporarily.
1866This function does not display the buffer, so its effect ends
1867when the current command terminates.
7ee72033
MB
1868Use `switch-to-buffer' or `pop-to-buffer' to switch buffers permanently. */)
1869 (buffer)
a25f13ae 1870 register Lisp_Object buffer;
1ab256cb 1871{
a25f13ae
KH
1872 register Lisp_Object buf;
1873 buf = Fget_buffer (buffer);
1874 if (NILP (buf))
1875 nsberror (buffer);
1876 if (NILP (XBUFFER (buf)->name))
1ab256cb 1877 error ("Selecting deleted buffer");
a25f13ae
KH
1878 set_buffer_internal (XBUFFER (buf));
1879 return buf;
1ab256cb 1880}
d0628b06
RS
1881
1882/* Set the current buffer to BUFFER provided it is alive. */
1883
1884Lisp_Object
1885set_buffer_if_live (buffer)
1886 Lisp_Object buffer;
1887{
1888 if (! NILP (XBUFFER (buffer)->name))
1889 Fset_buffer (buffer);
1890 return Qnil;
1891}
1ab256cb
RM
1892\f
1893DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only,
1894 Sbarf_if_buffer_read_only, 0, 0, 0,
7ee72033
MB
1895 doc: /* Signal a `buffer-read-only' error if the current buffer is read-only. */)
1896 ()
1ab256cb 1897{
a96b68f1
RS
1898 if (!NILP (current_buffer->read_only)
1899 && NILP (Vinhibit_read_only))
1ab256cb
RM
1900 Fsignal (Qbuffer_read_only, (Fcons (Fcurrent_buffer (), Qnil)));
1901 return Qnil;
1902}
1903
1904DEFUN ("bury-buffer", Fbury_buffer, Sbury_buffer, 0, 1, "",
7ee72033 1905 doc: /* Put BUFFER at the end of the list of all buffers.
018ba359
PJ
1906There it is the least likely candidate for `other-buffer' to return;
1907thus, the least likely buffer for \\[switch-to-buffer] to select by default.
1908If BUFFER is nil or omitted, bury the current buffer.
1909Also, if BUFFER is nil or omitted, remove the current buffer from the
7ee72033
MB
1910selected window if it is displayed there. */)
1911 (buffer)
a2428fa2 1912 register Lisp_Object buffer;
1ab256cb 1913{
b271272a 1914 /* Figure out what buffer we're going to bury. */
a2428fa2 1915 if (NILP (buffer))
a5611885 1916 {
c58dab63 1917 Lisp_Object tem;
a2428fa2 1918 XSETBUFFER (buffer, current_buffer);
0a63b212 1919
c58dab63 1920 tem = Fwindow_buffer (selected_window);
0a63b212 1921 /* If we're burying the current buffer, unshow it. */
c58dab63 1922 if (EQ (buffer, tem))
a78e0303
PJ
1923 {
1924 if (NILP (Fwindow_dedicated_p (selected_window)))
1925 Fswitch_to_buffer (Fother_buffer (buffer, Qnil, Qnil), Qnil);
1926 else if (NILP (XWINDOW (selected_window)->parent))
1927 Ficonify_frame (Fwindow_frame (selected_window));
1928 else
1929 Fdelete_window (selected_window);
1930 }
a5611885 1931 }
1ab256cb
RM
1932 else
1933 {
1934 Lisp_Object buf1;
1935
a2428fa2 1936 buf1 = Fget_buffer (buffer);
265a9e55 1937 if (NILP (buf1))
a2428fa2
EN
1938 nsberror (buffer);
1939 buffer = buf1;
b271272a
JB
1940 }
1941
a1a8b28e
GM
1942 /* Move buffer to the end of the buffer list. Do nothing if the
1943 buffer is killed. */
1944 if (!NILP (XBUFFER (buffer)->name))
1945 {
1946 Lisp_Object aelt, link;
b271272a 1947
a1a8b28e
GM
1948 aelt = Frassq (buffer, Vbuffer_alist);
1949 link = Fmemq (aelt, Vbuffer_alist);
1950 Vbuffer_alist = Fdelq (aelt, Vbuffer_alist);
f3fbd155 1951 XSETCDR (link, Qnil);
a1a8b28e 1952 Vbuffer_alist = nconc2 (Vbuffer_alist, link);
1ab256cb 1953
6c488ddb
RS
1954 /* Removing BUFFER from frame-specific lists
1955 has the effect of putting BUFFER at the end
1956 of the combined list in each frame. */
1957 frames_discard_buffer (buffer);
a1a8b28e 1958 }
dec989eb 1959
1ab256cb
RM
1960 return Qnil;
1961}
1962\f
c922bc55 1963DEFUN ("erase-buffer", Ferase_buffer, Serase_buffer, 0, 0, "*",
7ee72033 1964 doc: /* Delete the entire contents of the current buffer.
018ba359 1965Any narrowing restriction in effect (see `narrow-to-region') is removed,
7ee72033
MB
1966so the buffer is truly empty after this. */)
1967 ()
1ab256cb
RM
1968{
1969 Fwiden ();
c0d9a0c3
GM
1970
1971 del_range (BEG, Z);
c280bc6a 1972
1ab256cb
RM
1973 current_buffer->last_window_start = 1;
1974 /* Prevent warnings, or suspension of auto saving, that would happen
1975 if future size is less than past size. Use of erase-buffer
1976 implies that the future text is not really related to the past text. */
8d7a4592 1977 XSETFASTINT (current_buffer->save_length, 0);
1ab256cb
RM
1978 return Qnil;
1979}
1980
01136e9b 1981void
1ab256cb
RM
1982validate_region (b, e)
1983 register Lisp_Object *b, *e;
1984{
b7826503
PJ
1985 CHECK_NUMBER_COERCE_MARKER (*b);
1986 CHECK_NUMBER_COERCE_MARKER (*e);
1ab256cb
RM
1987
1988 if (XINT (*b) > XINT (*e))
1989 {
03192067
KH
1990 Lisp_Object tem;
1991 tem = *b; *b = *e; *e = tem;
1ab256cb
RM
1992 }
1993
1994 if (!(BEGV <= XINT (*b) && XINT (*b) <= XINT (*e)
1995 && XINT (*e) <= ZV))
1996 args_out_of_range (*b, *e);
1997}
1998\f
b05525fa
RS
1999/* Advance BYTE_POS up to a character boundary
2000 and return the adjusted position. */
2001
2002static int
2003advance_to_char_boundary (byte_pos)
2004 int byte_pos;
2005{
f8449323 2006 int c;
b05525fa 2007
f8449323
RS
2008 if (byte_pos == BEG)
2009 /* Beginning of buffer is always a character boundary. */
2010 return 1;
2011
2012 c = FETCH_BYTE (byte_pos);
2013 if (! CHAR_HEAD_P (c))
b05525fa 2014 {
1be6387d 2015 /* We should advance BYTE_POS only when C is a constituent of a
f8449323 2016 multibyte sequence. */
a9bcded1
KH
2017 int orig_byte_pos = byte_pos;
2018
2019 do
2020 {
2021 byte_pos--;
2022 c = FETCH_BYTE (byte_pos);
2023 }
2024 while (! CHAR_HEAD_P (c) && byte_pos > BEG);
f8449323 2025 INC_POS (byte_pos);
a9bcded1
KH
2026 if (byte_pos < orig_byte_pos)
2027 byte_pos = orig_byte_pos;
f8449323
RS
2028 /* If C is a constituent of a multibyte sequence, BYTE_POS was
2029 surely advance to the correct character boundary. If C is
2030 not, BYTE_POS was unchanged. */
b05525fa
RS
2031 }
2032
20773569 2033 return byte_pos;
b05525fa
RS
2034}
2035
3ac81adb
RS
2036DEFUN ("set-buffer-multibyte", Fset_buffer_multibyte, Sset_buffer_multibyte,
2037 1, 1, 0,
7ee72033 2038 doc: /* Set the multibyte flag of the current buffer to FLAG.
018ba359
PJ
2039If FLAG is t, this makes the buffer a multibyte buffer.
2040If FLAG is nil, this makes the buffer a single-byte buffer.
2041The buffer contents remain unchanged as a sequence of bytes
7ee72033
MB
2042but the contents viewed as characters do change. */)
2043 (flag)
3ac81adb
RS
2044 Lisp_Object flag;
2045{
2046 Lisp_Object tail, markers;
abc9d959 2047 struct buffer *other;
a9bcded1
KH
2048 int undo_enabled_p = !EQ (current_buffer->undo_list, Qt);
2049 int begv = BEGV, zv = ZV;
2050 int narrowed = (BEG != begv || Z != zv);
ed00559d 2051 int modified_p = !NILP (Fbuffer_modified_p (Qnil));
3ac81adb 2052
6e553d5e
RS
2053 if (current_buffer->base_buffer)
2054 error ("Cannot do `set-buffer-multibyte' on an indirect buffer");
2055
70e77119
AS
2056 /* Do nothing if nothing actually changes. */
2057 if (NILP (flag) == NILP (current_buffer->enable_multibyte_characters))
2058 return flag;
2059
b05525fa
RS
2060 /* It would be better to update the list,
2061 but this is good enough for now. */
a9bcded1
KH
2062 if (undo_enabled_p)
2063 current_buffer->undo_list = Qt;
b05525fa 2064
3ac81adb
RS
2065 /* If the cached position is for this buffer, clear it out. */
2066 clear_charpos_cache (current_buffer);
2067
a9bcded1
KH
2068 if (narrowed)
2069 Fwiden ();
2070
3ac81adb
RS
2071 if (NILP (flag))
2072 {
a9bcded1
KH
2073 int pos, stop;
2074 unsigned char *p;
2075
3ac81adb
RS
2076 /* Do this first, so it can use CHAR_TO_BYTE
2077 to calculate the old correspondences. */
2078 set_intervals_multibyte (0);
2079
2080 current_buffer->enable_multibyte_characters = Qnil;
2081
2082 Z = Z_BYTE;
2083 BEGV = BEGV_BYTE;
2084 ZV = ZV_BYTE;
2085 GPT = GPT_BYTE;
2086 TEMP_SET_PT_BOTH (PT_BYTE, PT_BYTE);
2087
2088 tail = BUF_MARKERS (current_buffer);
8801a864 2089 while (! NILP (tail))
3ac81adb
RS
2090 {
2091 XMARKER (tail)->charpos = XMARKER (tail)->bytepos;
2092 tail = XMARKER (tail)->chain;
2093 }
a9bcded1
KH
2094
2095 /* Convert multibyte form of 8-bit characters to unibyte. */
2096 pos = BEG;
2097 stop = GPT;
2098 p = BEG_ADDR;
2099 while (1)
2100 {
2101 int c, bytes;
2102
2103 if (pos == stop)
2104 {
2105 if (pos == Z)
2106 break;
2107 p = GAP_END_ADDR;
2108 stop = Z;
2109 }
2110 if (MULTIBYTE_STR_AS_UNIBYTE_P (p, bytes))
2111 p += bytes, pos += bytes;
2112 else
2113 {
2114 c = STRING_CHAR (p, stop - pos);
2115 /* Delete all bytes for this 8-bit character but the
2116 last one, and change the last one to the charcter
2117 code. */
2118 bytes--;
2119 del_range_2 (pos, pos, pos + bytes, pos + bytes, 0);
2120 p = GAP_END_ADDR;
2121 *p++ = c;
2122 pos++;
2123 if (begv > pos)
2124 begv -= bytes;
2125 if (zv > pos)
2126 zv -= bytes;
2127 stop = Z;
2128 }
2129 }
2130 if (narrowed)
2131 Fnarrow_to_region (make_number (begv), make_number (zv));
3ac81adb
RS
2132 }
2133 else
2134 {
a9bcded1
KH
2135 int pt = PT;
2136 int pos, stop;
2137 unsigned char *p;
2138
673c57d2 2139 /* Be sure not to have a multibyte sequence striding over the GAP.
a9bcded1
KH
2140 Ex: We change this: "...abc\201 _GAP_ \241def..."
2141 to: "...abc _GAP_ \201\241def..." */
673c57d2
KH
2142
2143 if (GPT_BYTE > 1 && GPT_BYTE < Z_BYTE
2144 && ! CHAR_HEAD_P (*(GAP_END_ADDR)))
2145 {
2146 unsigned char *p = GPT_ADDR - 1;
2147
2148 while (! CHAR_HEAD_P (*p) && p > BEG_ADDR) p--;
2149 if (BASE_LEADING_CODE_P (*p))
2150 {
2151 int new_gpt = GPT_BYTE - (GPT_ADDR - p);
2152
2153 move_gap_both (new_gpt, new_gpt);
2154 }
2155 }
2156
a9bcded1
KH
2157 /* Make the buffer contents valid as multibyte by converting
2158 8-bit characters to multibyte form. */
2159 pos = BEG;
2160 stop = GPT;
2161 p = BEG_ADDR;
2162 while (1)
2163 {
2164 int bytes;
2165
2166 if (pos == stop)
2167 {
2168 if (pos == Z)
2169 break;
2170 p = GAP_END_ADDR;
2171 stop = Z;
2172 }
2173
2174 if (UNIBYTE_STR_AS_MULTIBYTE_P (p, stop - pos, bytes))
2175 p += bytes, pos += bytes;
2176 else
2177 {
2178 unsigned char tmp[MAX_MULTIBYTE_LENGTH];
2179
2180 bytes = CHAR_STRING (*p, tmp);
2181 *p = tmp[0];
2182 TEMP_SET_PT_BOTH (pos + 1, pos + 1);
2183 bytes--;
2184 insert_1_both (tmp + 1, bytes, bytes, 1, 0, 0);
2185 /* Now the gap is after the just inserted data. */
2186 pos = GPT;
2187 p = GAP_END_ADDR;
2188 if (pos <= begv)
2189 begv += bytes;
2190 if (pos <= zv)
2191 zv += bytes;
2192 if (pos <= pt)
2193 pt += bytes;
2194 stop = Z;
2195 }
2196 }
2197
2198 if (pt != PT)
2199 TEMP_SET_PT (pt);
2200
2201 if (narrowed)
2202 Fnarrow_to_region (make_number (begv), make_number (zv));
2203
3ac81adb
RS
2204 /* Do this first, so that chars_in_text asks the right question.
2205 set_intervals_multibyte needs it too. */
2206 current_buffer->enable_multibyte_characters = Qt;
2207
b05525fa 2208 GPT_BYTE = advance_to_char_boundary (GPT_BYTE);
3ac81adb 2209 GPT = chars_in_text (BEG_ADDR, GPT_BYTE - BEG_BYTE) + BEG;
b05525fa 2210
673c57d2 2211 Z = chars_in_text (GAP_END_ADDR, Z_BYTE - GPT_BYTE) + GPT;
b05525fa
RS
2212
2213 BEGV_BYTE = advance_to_char_boundary (BEGV_BYTE);
3ac81adb 2214 if (BEGV_BYTE > GPT_BYTE)
673c57d2 2215 BEGV = chars_in_text (GAP_END_ADDR, BEGV_BYTE - GPT_BYTE) + GPT;
3ac81adb
RS
2216 else
2217 BEGV = chars_in_text (BEG_ADDR, BEGV_BYTE - BEG_BYTE) + BEG;
b05525fa
RS
2218
2219 ZV_BYTE = advance_to_char_boundary (ZV_BYTE);
3ac81adb 2220 if (ZV_BYTE > GPT_BYTE)
673c57d2 2221 ZV = chars_in_text (GAP_END_ADDR, ZV_BYTE - GPT_BYTE) + GPT;
3ac81adb
RS
2222 else
2223 ZV = chars_in_text (BEG_ADDR, ZV_BYTE - BEG_BYTE) + BEG;
b05525fa
RS
2224
2225 {
2226 int pt_byte = advance_to_char_boundary (PT_BYTE);
2227 int pt;
2228
2229 if (pt_byte > GPT_BYTE)
673c57d2 2230 pt = chars_in_text (GAP_END_ADDR, pt_byte - GPT_BYTE) + GPT;
b05525fa
RS
2231 else
2232 pt = chars_in_text (BEG_ADDR, pt_byte - BEG_BYTE) + BEG;
2233 TEMP_SET_PT_BOTH (pt, pt_byte);
2234 }
3ac81adb
RS
2235
2236 tail = markers = BUF_MARKERS (current_buffer);
95fb069b
RS
2237
2238 /* This prevents BYTE_TO_CHAR (that is, buf_bytepos_to_charpos) from
2239 getting confused by the markers that have not yet been updated.
2240 It is also a signal that it should never create a marker. */
3ac81adb
RS
2241 BUF_MARKERS (current_buffer) = Qnil;
2242
8801a864 2243 while (! NILP (tail))
3ac81adb 2244 {
b05525fa
RS
2245 XMARKER (tail)->bytepos
2246 = advance_to_char_boundary (XMARKER (tail)->bytepos);
3ac81adb 2247 XMARKER (tail)->charpos = BYTE_TO_CHAR (XMARKER (tail)->bytepos);
b05525fa 2248
3ac81adb
RS
2249 tail = XMARKER (tail)->chain;
2250 }
b69f9797
RS
2251
2252 /* Make sure no markers were put on the chain
2253 while the chain value was incorrect. */
2254 if (! EQ (BUF_MARKERS (current_buffer), Qnil))
2255 abort ();
2256
3ac81adb
RS
2257 BUF_MARKERS (current_buffer) = markers;
2258
2259 /* Do this last, so it can calculate the new correspondences
2260 between chars and bytes. */
2261 set_intervals_multibyte (1);
2262 }
2263
a9bcded1
KH
2264 if (undo_enabled_p)
2265 current_buffer->undo_list = Qnil;
2266
724b203f
GM
2267 /* Changing the multibyteness of a buffer means that all windows
2268 showing that buffer must be updated thoroughly. */
2269 current_buffer->prevent_redisplay_optimizations_p = 1;
2270 ++windows_or_buffers_changed;
2271
abc9d959
RS
2272 /* Copy this buffer's new multibyte status
2273 into all of its indirect buffers. */
2274 for (other = all_buffers; other; other = other->next)
2275 if (other->base_buffer == current_buffer && !NILP (other->name))
724b203f
GM
2276 {
2277 other->enable_multibyte_characters
2278 = current_buffer->enable_multibyte_characters;
2279 other->prevent_redisplay_optimizations_p = 1;
2280 }
abc9d959 2281
ed00559d
KH
2282 /* Restore the modifiedness of the buffer. */
2283 if (!modified_p && !NILP (Fbuffer_modified_p (Qnil)))
2284 Fset_buffer_modified_p (Qnil);
2285
3ac81adb
RS
2286 return flag;
2287}
2288\f
1ab256cb 2289DEFUN ("kill-all-local-variables", Fkill_all_local_variables, Skill_all_local_variables,
efc7e75f 2290 0, 0, 0,
7ee72033 2291 doc: /* Switch to Fundamental mode by killing current buffer's local variables.
018ba359
PJ
2292Most local variable bindings are eliminated so that the default values
2293become effective once more. Also, the syntax table is set from
2294`standard-syntax-table', the local keymap is set to nil,
2295and the abbrev table from `fundamental-mode-abbrev-table'.
2296This function also forces redisplay of the mode line.
2297
2298Every function to select a new major mode starts by
2299calling this function.
2300
2301As a special exception, local variables whose names have
2302a non-nil `permanent-local' property are not eliminated by this function.
2303
2304The first thing this function does is run
7ee72033
MB
2305the normal hook `change-major-mode-hook'. */)
2306 ()
1ab256cb
RM
2307{
2308 register Lisp_Object alist, sym, tem;
2309 Lisp_Object oalist;
7410477a 2310
fd186f07
RS
2311 if (!NILP (Vrun_hooks))
2312 call1 (Vrun_hooks, intern ("change-major-mode-hook"));
1ab256cb
RM
2313 oalist = current_buffer->local_var_alist;
2314
2f3f993b
RS
2315 /* Make sure none of the bindings in oalist
2316 remain swapped in, in their symbols. */
1ab256cb 2317
2f3f993b 2318 swap_out_buffer_local_variables (current_buffer);
1ab256cb
RM
2319
2320 /* Actually eliminate all local bindings of this buffer. */
2321
13de9290 2322 reset_buffer_local_variables (current_buffer, 0);
1ab256cb 2323
1ab256cb
RM
2324 /* Any which are supposed to be permanent,
2325 make local again, with the same values they had. */
2326
7539e11f 2327 for (alist = oalist; !NILP (alist); alist = XCDR (alist))
1ab256cb 2328 {
7539e11f 2329 sym = XCAR (XCAR (alist));
1ab256cb 2330 tem = Fget (sym, Qpermanent_local);
265a9e55 2331 if (! NILP (tem))
01050cb5
RM
2332 {
2333 Fmake_local_variable (sym);
7539e11f 2334 Fset (sym, XCDR (XCAR (alist)));
01050cb5 2335 }
1ab256cb
RM
2336 }
2337
2338 /* Force mode-line redisplay. Useful here because all major mode
2339 commands call this function. */
2340 update_mode_lines++;
2341
2342 return Qnil;
2343}
2f3f993b
RS
2344
2345/* Make sure no local variables remain set up with buffer B
2346 for their current values. */
2347
2348static void
2349swap_out_buffer_local_variables (b)
2350 struct buffer *b;
2351{
2352 Lisp_Object oalist, alist, sym, tem, buffer;
2353
2354 XSETBUFFER (buffer, b);
2355 oalist = b->local_var_alist;
2356
7539e11f 2357 for (alist = oalist; !NILP (alist); alist = XCDR (alist))
2f3f993b 2358 {
7539e11f 2359 sym = XCAR (XCAR (alist));
2f3f993b
RS
2360
2361 /* Need not do anything if some other buffer's binding is now encached. */
f5c1dd0d 2362 tem = XBUFFER_LOCAL_VALUE (SYMBOL_VALUE (sym))->buffer;
8801a864 2363 if (BUFFERP (tem) && XBUFFER (tem) == current_buffer)
2f3f993b
RS
2364 {
2365 /* Symbol is set up for this buffer's old local value.
2366 Set it up for the current buffer with the default value. */
2367
f5c1dd0d 2368 tem = XBUFFER_LOCAL_VALUE (SYMBOL_VALUE (sym))->cdr;
2f3f993b
RS
2369 /* Store the symbol's current value into the alist entry
2370 it is currently set up for. This is so that, if the
2371 local is marked permanent, and we make it local again
2372 later in Fkill_all_local_variables, we don't lose the value. */
f3fbd155
KR
2373 XSETCDR (XCAR (tem),
2374 do_symval_forwarding (XBUFFER_LOCAL_VALUE (SYMBOL_VALUE (sym))->realvalue));
2f3f993b 2375 /* Switch to the symbol's default-value alist entry. */
f3fbd155 2376 XSETCAR (tem, tem);
2f3f993b 2377 /* Mark it as current for buffer B. */
f5c1dd0d 2378 XBUFFER_LOCAL_VALUE (SYMBOL_VALUE (sym))->buffer = buffer;
2f3f993b 2379 /* Store the current value into any forwarding in the symbol. */
3d871c85 2380 store_symval_forwarding (sym,
f5c1dd0d 2381 XBUFFER_LOCAL_VALUE (SYMBOL_VALUE (sym))->realvalue,
9b3a7dad 2382 XCDR (tem), NULL);
2f3f993b
RS
2383 }
2384 }
2385}
1ab256cb 2386\f
2eec3b4e
RS
2387/* Find all the overlays in the current buffer that contain position POS.
2388 Return the number found, and store them in a vector in *VEC_PTR.
2389 Store in *LEN_PTR the size allocated for the vector.
52f8ec73
JB
2390 Store in *NEXT_PTR the next position after POS where an overlay starts,
2391 or ZV if there are no more overlays.
bbbe9545 2392 Store in *PREV_PTR the previous position before POS where an overlay ends,
413e06a4
RS
2393 or where an overlay starts which ends at or after POS;
2394 or BEGV if there are no such overlays.
239c932b 2395 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
2eec3b4e
RS
2396
2397 *VEC_PTR and *LEN_PTR should contain a valid vector and size
61d54cd5
RS
2398 when this function is called.
2399
2400 If EXTEND is non-zero, we make the vector bigger if necessary.
2401 If EXTEND is zero, we never extend the vector,
2402 and we store only as many overlays as will fit.
ac869cf7
MB
2403 But we still return the total number of overlays.
2404
2405 If CHANGE_REQ is true, then any position written into *PREV_PTR or
2406 *NEXT_PTR is guaranteed to be not equal to POS, unless it is the
2407 default (BEGV or ZV). */
2eec3b4e
RS
2408
2409int
ac869cf7 2410overlays_at (pos, extend, vec_ptr, len_ptr, next_ptr, prev_ptr, change_req)
2eec3b4e 2411 int pos;
61d54cd5 2412 int extend;
2eec3b4e
RS
2413 Lisp_Object **vec_ptr;
2414 int *len_ptr;
2415 int *next_ptr;
239c932b 2416 int *prev_ptr;
ac869cf7 2417 int change_req;
1ab256cb 2418{
6af718a4 2419 Lisp_Object tail, overlay, start, end;
2eec3b4e
RS
2420 int idx = 0;
2421 int len = *len_ptr;
2422 Lisp_Object *vec = *vec_ptr;
2423 int next = ZV;
239c932b 2424 int prev = BEGV;
61d54cd5
RS
2425 int inhibit_storing = 0;
2426
2eec3b4e 2427 for (tail = current_buffer->overlays_before;
8fc0589a 2428 GC_CONSP (tail);
7539e11f 2429 tail = XCDR (tail))
2eec3b4e 2430 {
239c932b 2431 int startpos, endpos;
52f8ec73 2432
7539e11f 2433 overlay = XCAR (tail);
1ab256cb 2434
2eec3b4e
RS
2435 start = OVERLAY_START (overlay);
2436 end = OVERLAY_END (overlay);
239c932b
RS
2437 endpos = OVERLAY_POSITION (end);
2438 if (endpos < pos)
2439 {
2440 if (prev < endpos)
2441 prev = endpos;
2442 break;
2443 }
413e06a4
RS
2444 startpos = OVERLAY_POSITION (start);
2445 /* This one ends at or after POS
daa1c109 2446 so its start counts for PREV_PTR if it's before POS. */
413e06a4
RS
2447 if (prev < startpos && startpos < pos)
2448 prev = startpos;
239c932b
RS
2449 if (endpos == pos)
2450 continue;
2eec3b4e
RS
2451 if (startpos <= pos)
2452 {
2453 if (idx == len)
2454 {
61d54cd5
RS
2455 /* The supplied vector is full.
2456 Either make it bigger, or don't store any more in it. */
2457 if (extend)
2458 {
0552666b
GM
2459 /* Make it work with an initial len == 0. */
2460 len *= 2;
2461 if (len == 0)
2462 len = 4;
2463 *len_ptr = len;
61d54cd5
RS
2464 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2465 *vec_ptr = vec;
2466 }
2467 else
2468 inhibit_storing = 1;
2eec3b4e 2469 }
61d54cd5
RS
2470
2471 if (!inhibit_storing)
2472 vec[idx] = overlay;
2473 /* Keep counting overlays even if we can't return them all. */
2474 idx++;
2eec3b4e
RS
2475 }
2476 else if (startpos < next)
2477 next = startpos;
2478 }
2479
2480 for (tail = current_buffer->overlays_after;
8fc0589a 2481 GC_CONSP (tail);
7539e11f 2482 tail = XCDR (tail))
1ab256cb 2483 {
239c932b 2484 int startpos, endpos;
52f8ec73 2485
7539e11f 2486 overlay = XCAR (tail);
2eec3b4e
RS
2487
2488 start = OVERLAY_START (overlay);
2489 end = OVERLAY_END (overlay);
2490 startpos = OVERLAY_POSITION (start);
52f8ec73 2491 if (pos < startpos)
2eec3b4e
RS
2492 {
2493 if (startpos < next)
2494 next = startpos;
2495 break;
2496 }
239c932b
RS
2497 endpos = OVERLAY_POSITION (end);
2498 if (pos < endpos)
2eec3b4e
RS
2499 {
2500 if (idx == len)
2501 {
61d54cd5
RS
2502 if (extend)
2503 {
2504 *len_ptr = len *= 2;
0552666b
GM
2505 if (len == 0)
2506 len = *len_ptr = 4;
61d54cd5
RS
2507 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2508 *vec_ptr = vec;
2509 }
2510 else
2511 inhibit_storing = 1;
2eec3b4e 2512 }
61d54cd5
RS
2513
2514 if (!inhibit_storing)
2515 vec[idx] = overlay;
2516 idx++;
413e06a4
RS
2517
2518 if (startpos < pos && startpos > prev)
2519 prev = startpos;
2eec3b4e 2520 }
239c932b
RS
2521 else if (endpos < pos && endpos > prev)
2522 prev = endpos;
1d5f4c1d
MB
2523 else if (endpos == pos && startpos > prev
2524 && (!change_req || startpos < pos))
413e06a4 2525 prev = startpos;
1ab256cb
RM
2526 }
2527
239c932b
RS
2528 if (next_ptr)
2529 *next_ptr = next;
2530 if (prev_ptr)
2531 *prev_ptr = prev;
2eec3b4e
RS
2532 return idx;
2533}
74514898
RS
2534\f
2535/* Find all the overlays in the current buffer that overlap the range BEG-END
2a3eeee7
RS
2536 or are empty at BEG.
2537
74514898
RS
2538 Return the number found, and store them in a vector in *VEC_PTR.
2539 Store in *LEN_PTR the size allocated for the vector.
2540 Store in *NEXT_PTR the next position after POS where an overlay starts,
2541 or ZV if there are no more overlays.
2542 Store in *PREV_PTR the previous position before POS where an overlay ends,
2543 or BEGV if there are no previous overlays.
2544 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
2545
2546 *VEC_PTR and *LEN_PTR should contain a valid vector and size
2547 when this function is called.
2548
2549 If EXTEND is non-zero, we make the vector bigger if necessary.
2550 If EXTEND is zero, we never extend the vector,
2551 and we store only as many overlays as will fit.
2552 But we still return the total number of overlays. */
2553
2554int
2555overlays_in (beg, end, extend, vec_ptr, len_ptr, next_ptr, prev_ptr)
2556 int beg, end;
2557 int extend;
2558 Lisp_Object **vec_ptr;
2559 int *len_ptr;
2560 int *next_ptr;
2561 int *prev_ptr;
2562{
6af718a4 2563 Lisp_Object tail, overlay, ostart, oend;
74514898
RS
2564 int idx = 0;
2565 int len = *len_ptr;
2566 Lisp_Object *vec = *vec_ptr;
2567 int next = ZV;
2568 int prev = BEGV;
2569 int inhibit_storing = 0;
2570
2571 for (tail = current_buffer->overlays_before;
2572 GC_CONSP (tail);
7539e11f 2573 tail = XCDR (tail))
74514898
RS
2574 {
2575 int startpos, endpos;
2576
7539e11f 2577 overlay = XCAR (tail);
74514898
RS
2578
2579 ostart = OVERLAY_START (overlay);
2580 oend = OVERLAY_END (overlay);
2581 endpos = OVERLAY_POSITION (oend);
2582 if (endpos < beg)
2583 {
2584 if (prev < endpos)
2585 prev = endpos;
2586 break;
2587 }
2588 startpos = OVERLAY_POSITION (ostart);
2589 /* Count an interval if it either overlaps the range
2a3eeee7 2590 or is empty at the start of the range. */
74514898 2591 if ((beg < endpos && startpos < end)
2a3eeee7 2592 || (startpos == endpos && beg == endpos))
74514898
RS
2593 {
2594 if (idx == len)
2595 {
2596 /* The supplied vector is full.
2597 Either make it bigger, or don't store any more in it. */
2598 if (extend)
2599 {
2600 *len_ptr = len *= 2;
2601 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2602 *vec_ptr = vec;
2603 }
2604 else
2605 inhibit_storing = 1;
2606 }
2607
2608 if (!inhibit_storing)
2609 vec[idx] = overlay;
2610 /* Keep counting overlays even if we can't return them all. */
2611 idx++;
2612 }
2613 else if (startpos < next)
2614 next = startpos;
2615 }
2616
2617 for (tail = current_buffer->overlays_after;
2618 GC_CONSP (tail);
7539e11f 2619 tail = XCDR (tail))
74514898
RS
2620 {
2621 int startpos, endpos;
2622
7539e11f 2623 overlay = XCAR (tail);
74514898
RS
2624
2625 ostart = OVERLAY_START (overlay);
2626 oend = OVERLAY_END (overlay);
2627 startpos = OVERLAY_POSITION (ostart);
2628 if (end < startpos)
2629 {
2630 if (startpos < next)
2631 next = startpos;
2632 break;
2633 }
2634 endpos = OVERLAY_POSITION (oend);
2a3eeee7
RS
2635 /* Count an interval if it either overlaps the range
2636 or is empty at the start of the range. */
74514898 2637 if ((beg < endpos && startpos < end)
2a3eeee7 2638 || (startpos == endpos && beg == endpos))
74514898
RS
2639 {
2640 if (idx == len)
2641 {
2642 if (extend)
2643 {
2644 *len_ptr = len *= 2;
2645 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2646 *vec_ptr = vec;
2647 }
2648 else
2649 inhibit_storing = 1;
2650 }
2651
2652 if (!inhibit_storing)
2653 vec[idx] = overlay;
2654 idx++;
2655 }
2656 else if (endpos < beg && endpos > prev)
2657 prev = endpos;
2658 }
fc04fa47 2659
74514898
RS
2660 if (next_ptr)
2661 *next_ptr = next;
2662 if (prev_ptr)
2663 *prev_ptr = prev;
2664 return idx;
2665}
09a22085
GM
2666
2667
2668/* Return non-zero if there exists an overlay with a non-nil
2669 `mouse-face' property overlapping OVERLAY. */
2670
2671int
2672mouse_face_overlay_overlaps (overlay)
2673 Lisp_Object overlay;
2674{
2675 int start = OVERLAY_POSITION (OVERLAY_START (overlay));
2676 int end = OVERLAY_POSITION (OVERLAY_END (overlay));
bfd8410f 2677 int n, i, size;
09a22085
GM
2678 Lisp_Object *v, tem;
2679
bfd8410f
GM
2680 size = 10;
2681 v = (Lisp_Object *) alloca (size * sizeof *v);
2682 n = overlays_in (start, end, 0, &v, &size, NULL, NULL);
2683 if (n > size)
09a22085 2684 {
09a22085
GM
2685 v = (Lisp_Object *) alloca (n * sizeof *v);
2686 overlays_in (start, end, 0, &v, &n, NULL, NULL);
2687 }
2688
2689 for (i = 0; i < n; ++i)
2690 if (!EQ (v[i], overlay)
2691 && (tem = Foverlay_get (overlay, Qmouse_face),
2692 !NILP (tem)))
2693 break;
2694
2695 return i < n;
2696}
2697
2698
74514898 2699\f
fc04fa47
KH
2700/* Fast function to just test if we're at an overlay boundary. */
2701int
2702overlay_touches_p (pos)
2703 int pos;
2704{
2705 Lisp_Object tail, overlay;
2706
2707 for (tail = current_buffer->overlays_before; GC_CONSP (tail);
7539e11f 2708 tail = XCDR (tail))
fc04fa47
KH
2709 {
2710 int endpos;
2711
7539e11f 2712 overlay = XCAR (tail);
fc04fa47
KH
2713 if (!GC_OVERLAYP (overlay))
2714 abort ();
2715
2716 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2717 if (endpos < pos)
2718 break;
2719 if (endpos == pos || OVERLAY_POSITION (OVERLAY_START (overlay)) == pos)
2720 return 1;
2721 }
2722
2723 for (tail = current_buffer->overlays_after; GC_CONSP (tail);
7539e11f 2724 tail = XCDR (tail))
fc04fa47
KH
2725 {
2726 int startpos;
2727
7539e11f 2728 overlay = XCAR (tail);
fc04fa47
KH
2729 if (!GC_OVERLAYP (overlay))
2730 abort ();
2731
2732 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2733 if (pos < startpos)
2734 break;
2735 if (startpos == pos || OVERLAY_POSITION (OVERLAY_END (overlay)) == pos)
2736 return 1;
2737 }
2738 return 0;
2739}
2eec3b4e 2740\f
5985d248
KH
2741struct sortvec
2742{
2743 Lisp_Object overlay;
2744 int beg, end;
2745 int priority;
2746};
2747
2748static int
dfcf069d
AS
2749compare_overlays (v1, v2)
2750 const void *v1, *v2;
5985d248 2751{
dfcf069d
AS
2752 const struct sortvec *s1 = (const struct sortvec *) v1;
2753 const struct sortvec *s2 = (const struct sortvec *) v2;
5985d248
KH
2754 if (s1->priority != s2->priority)
2755 return s1->priority - s2->priority;
2756 if (s1->beg != s2->beg)
2757 return s1->beg - s2->beg;
2758 if (s1->end != s2->end)
2759 return s2->end - s1->end;
2760 return 0;
2761}
2762
2763/* Sort an array of overlays by priority. The array is modified in place.
2764 The return value is the new size; this may be smaller than the original
2765 size if some of the overlays were invalid or were window-specific. */
2766int
2767sort_overlays (overlay_vec, noverlays, w)
2768 Lisp_Object *overlay_vec;
2769 int noverlays;
2770 struct window *w;
2771{
2772 int i, j;
2773 struct sortvec *sortvec;
2774 sortvec = (struct sortvec *) alloca (noverlays * sizeof (struct sortvec));
2775
2776 /* Put the valid and relevant overlays into sortvec. */
2777
2778 for (i = 0, j = 0; i < noverlays; i++)
2779 {
0fa767e7 2780 Lisp_Object tem;
c99fc30f 2781 Lisp_Object overlay;
5985d248 2782
c99fc30f 2783 overlay = overlay_vec[i];
5985d248
KH
2784 if (OVERLAY_VALID (overlay)
2785 && OVERLAY_POSITION (OVERLAY_START (overlay)) > 0
2786 && OVERLAY_POSITION (OVERLAY_END (overlay)) > 0)
2787 {
0fa767e7
KH
2788 /* If we're interested in a specific window, then ignore
2789 overlays that are limited to some other window. */
2790 if (w)
5985d248 2791 {
0fa767e7
KH
2792 Lisp_Object window;
2793
2794 window = Foverlay_get (overlay, Qwindow);
a7a60ce9 2795 if (WINDOWP (window) && XWINDOW (window) != w)
0fa767e7 2796 continue;
5985d248 2797 }
0fa767e7
KH
2798
2799 /* This overlay is good and counts: put it into sortvec. */
2800 sortvec[j].overlay = overlay;
2801 sortvec[j].beg = OVERLAY_POSITION (OVERLAY_START (overlay));
2802 sortvec[j].end = OVERLAY_POSITION (OVERLAY_END (overlay));
2803 tem = Foverlay_get (overlay, Qpriority);
2804 if (INTEGERP (tem))
2805 sortvec[j].priority = XINT (tem);
2806 else
2807 sortvec[j].priority = 0;
2808 j++;
5985d248
KH
2809 }
2810 }
2811 noverlays = j;
2812
2813 /* Sort the overlays into the proper order: increasing priority. */
2814
2815 if (noverlays > 1)
2816 qsort (sortvec, noverlays, sizeof (struct sortvec), compare_overlays);
2817
2818 for (i = 0; i < noverlays; i++)
2819 overlay_vec[i] = sortvec[i].overlay;
2820 return (noverlays);
2821}
2822\f
bbbe9545
KH
2823struct sortstr
2824{
cb26008f 2825 Lisp_Object string, string2;
bbbe9545
KH
2826 int size;
2827 int priority;
2828};
2829
e8185fa8
KH
2830struct sortstrlist
2831{
2832 struct sortstr *buf; /* An array that expands as needed; never freed. */
2833 int size; /* Allocated length of that array. */
2834 int used; /* How much of the array is currently in use. */
2835 int bytes; /* Total length of the strings in buf. */
2836};
2837
2838/* Buffers for storing information about the overlays touching a given
2839 position. These could be automatic variables in overlay_strings, but
2840 it's more efficient to hold onto the memory instead of repeatedly
2841 allocating and freeing it. */
2842static struct sortstrlist overlay_heads, overlay_tails;
9492daf2 2843static unsigned char *overlay_str_buf;
e8185fa8
KH
2844
2845/* Allocated length of overlay_str_buf. */
2846static int overlay_str_len;
2847
bbbe9545
KH
2848/* A comparison function suitable for passing to qsort. */
2849static int
2850cmp_for_strings (as1, as2)
2851 char *as1, *as2;
2852{
2853 struct sortstr *s1 = (struct sortstr *)as1;
2854 struct sortstr *s2 = (struct sortstr *)as2;
2855 if (s1->size != s2->size)
2856 return s2->size - s1->size;
2857 if (s1->priority != s2->priority)
2858 return s1->priority - s2->priority;
2859 return 0;
2860}
2861
e8185fa8 2862static void
cb26008f 2863record_overlay_string (ssl, str, str2, pri, size)
e8185fa8 2864 struct sortstrlist *ssl;
cb26008f 2865 Lisp_Object str, str2, pri;
e8185fa8
KH
2866 int size;
2867{
43d27a72
RS
2868 int nbytes;
2869
e8185fa8
KH
2870 if (ssl->used == ssl->size)
2871 {
2872 if (ssl->buf)
2873 ssl->size *= 2;
2874 else
2875 ssl->size = 5;
2876 ssl->buf = ((struct sortstr *)
2877 xrealloc (ssl->buf, ssl->size * sizeof (struct sortstr)));
2878 }
2879 ssl->buf[ssl->used].string = str;
cb26008f 2880 ssl->buf[ssl->used].string2 = str2;
e8185fa8
KH
2881 ssl->buf[ssl->used].size = size;
2882 ssl->buf[ssl->used].priority = (INTEGERP (pri) ? XINT (pri) : 0);
2883 ssl->used++;
43d27a72
RS
2884
2885 if (NILP (current_buffer->enable_multibyte_characters))
d5db4077 2886 nbytes = SCHARS (str);
43d27a72 2887 else if (! STRING_MULTIBYTE (str))
d5db4077
KR
2888 nbytes = count_size_as_multibyte (SDATA (str),
2889 SBYTES (str));
43d27a72 2890 else
d5db4077 2891 nbytes = SBYTES (str);
43d27a72
RS
2892
2893 ssl->bytes += nbytes;
2894
cb26008f 2895 if (STRINGP (str2))
43d27a72
RS
2896 {
2897 if (NILP (current_buffer->enable_multibyte_characters))
d5db4077 2898 nbytes = SCHARS (str2);
43d27a72 2899 else if (! STRING_MULTIBYTE (str2))
d5db4077
KR
2900 nbytes = count_size_as_multibyte (SDATA (str2),
2901 SBYTES (str2));
43d27a72 2902 else
d5db4077 2903 nbytes = SBYTES (str2);
43d27a72
RS
2904
2905 ssl->bytes += nbytes;
2906 }
e8185fa8 2907}
bbbe9545
KH
2908
2909/* Return the concatenation of the strings associated with overlays that
2910 begin or end at POS, ignoring overlays that are specific to a window
2911 other than W. The strings are concatenated in the appropriate order:
2912 shorter overlays nest inside longer ones, and higher priority inside
cb26008f
KH
2913 lower. Normally all of the after-strings come first, but zero-sized
2914 overlays have their after-strings ride along with the before-strings
2915 because it would look strange to print them inside-out.
2916
2917 Returns the string length, and stores the contents indirectly through
2918 PSTR, if that variable is non-null. The string may be overwritten by
2919 subsequent calls. */
6b5d3b89 2920
bbbe9545
KH
2921int
2922overlay_strings (pos, w, pstr)
2923 int pos;
2924 struct window *w;
6b5d3b89 2925 unsigned char **pstr;
bbbe9545 2926{
e8185fa8 2927 Lisp_Object ov, overlay, window, str;
bbbe9545 2928 int startpos, endpos;
43d27a72 2929 int multibyte = ! NILP (current_buffer->enable_multibyte_characters);
bbbe9545 2930
e8185fa8
KH
2931 overlay_heads.used = overlay_heads.bytes = 0;
2932 overlay_tails.used = overlay_tails.bytes = 0;
7539e11f 2933 for (ov = current_buffer->overlays_before; CONSP (ov); ov = XCDR (ov))
bbbe9545 2934 {
7539e11f 2935 overlay = XCAR (ov);
bbbe9545
KH
2936 if (!OVERLAYP (overlay))
2937 abort ();
2938
2939 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2940 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2941 if (endpos < pos)
2942 break;
2943 if (endpos != pos && startpos != pos)
2944 continue;
2945 window = Foverlay_get (overlay, Qwindow);
2946 if (WINDOWP (window) && XWINDOW (window) != w)
2947 continue;
e8185fa8
KH
2948 if (startpos == pos
2949 && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
2950 record_overlay_string (&overlay_heads, str,
cb26008f
KH
2951 (startpos == endpos
2952 ? Foverlay_get (overlay, Qafter_string)
2953 : Qnil),
2954 Foverlay_get (overlay, Qpriority),
2955 endpos - startpos);
2956 else if (endpos == pos
2957 && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
2958 record_overlay_string (&overlay_tails, str, Qnil,
e8185fa8
KH
2959 Foverlay_get (overlay, Qpriority),
2960 endpos - startpos);
bbbe9545 2961 }
7539e11f 2962 for (ov = current_buffer->overlays_after; CONSP (ov); ov = XCDR (ov))
bbbe9545 2963 {
7539e11f 2964 overlay = XCAR (ov);
bbbe9545
KH
2965 if (!OVERLAYP (overlay))
2966 abort ();
2967
2968 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2969 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2970 if (startpos > pos)
2971 break;
e8185fa8
KH
2972 if (endpos != pos && startpos != pos)
2973 continue;
2974 window = Foverlay_get (overlay, Qwindow);
2975 if (WINDOWP (window) && XWINDOW (window) != w)
2976 continue;
e8185fa8
KH
2977 if (startpos == pos
2978 && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
2979 record_overlay_string (&overlay_heads, str,
cb26008f
KH
2980 (startpos == endpos
2981 ? Foverlay_get (overlay, Qafter_string)
2982 : Qnil),
2983 Foverlay_get (overlay, Qpriority),
2984 endpos - startpos);
2985 else if (endpos == pos
2986 && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
2987 record_overlay_string (&overlay_tails, str, Qnil,
e8185fa8
KH
2988 Foverlay_get (overlay, Qpriority),
2989 endpos - startpos);
bbbe9545 2990 }
e8185fa8
KH
2991 if (overlay_tails.used > 1)
2992 qsort (overlay_tails.buf, overlay_tails.used, sizeof (struct sortstr),
2993 cmp_for_strings);
2994 if (overlay_heads.used > 1)
2995 qsort (overlay_heads.buf, overlay_heads.used, sizeof (struct sortstr),
2996 cmp_for_strings);
2997 if (overlay_heads.bytes || overlay_tails.bytes)
bbbe9545 2998 {
e8185fa8 2999 Lisp_Object tem;
bbbe9545 3000 int i;
9f4d7cde 3001 unsigned char *p;
e8185fa8 3002 int total = overlay_heads.bytes + overlay_tails.bytes;
bbbe9545
KH
3003
3004 if (total > overlay_str_len)
9f4d7cde
RS
3005 {
3006 overlay_str_len = total;
3007 overlay_str_buf = (unsigned char *)xrealloc (overlay_str_buf,
3008 total);
3009 }
bbbe9545 3010 p = overlay_str_buf;
e8185fa8 3011 for (i = overlay_tails.used; --i >= 0;)
bbbe9545 3012 {
43d27a72 3013 int nbytes;
e8185fa8 3014 tem = overlay_tails.buf[i].string;
d5db4077
KR
3015 nbytes = copy_text (SDATA (tem), p,
3016 SBYTES (tem),
43d27a72
RS
3017 STRING_MULTIBYTE (tem), multibyte);
3018 p += nbytes;
bbbe9545 3019 }
e8185fa8 3020 for (i = 0; i < overlay_heads.used; ++i)
bbbe9545 3021 {
43d27a72 3022 int nbytes;
e8185fa8 3023 tem = overlay_heads.buf[i].string;
d5db4077
KR
3024 nbytes = copy_text (SDATA (tem), p,
3025 SBYTES (tem),
43d27a72
RS
3026 STRING_MULTIBYTE (tem), multibyte);
3027 p += nbytes;
cb26008f
KH
3028 tem = overlay_heads.buf[i].string2;
3029 if (STRINGP (tem))
3030 {
d5db4077
KR
3031 nbytes = copy_text (SDATA (tem), p,
3032 SBYTES (tem),
43d27a72
RS
3033 STRING_MULTIBYTE (tem), multibyte);
3034 p += nbytes;
cb26008f 3035 }
bbbe9545 3036 }
cb26008f
KH
3037 if (p != overlay_str_buf + total)
3038 abort ();
bbbe9545
KH
3039 if (pstr)
3040 *pstr = overlay_str_buf;
e8185fa8 3041 return total;
bbbe9545 3042 }
e8185fa8 3043 return 0;
bbbe9545
KH
3044}
3045\f
5c4f68f1 3046/* Shift overlays in BUF's overlay lists, to center the lists at POS. */
1ab256cb 3047
2eec3b4e 3048void
5c4f68f1
JB
3049recenter_overlay_lists (buf, pos)
3050 struct buffer *buf;
2eec3b4e
RS
3051 int pos;
3052{
3053 Lisp_Object overlay, tail, next, prev, beg, end;
3054
3055 /* See if anything in overlays_before should move to overlays_after. */
3056
3057 /* We don't strictly need prev in this loop; it should always be nil.
3058 But we use it for symmetry and in case that should cease to be true
3059 with some future change. */
3060 prev = Qnil;
5c4f68f1 3061 for (tail = buf->overlays_before;
2eec3b4e
RS
3062 CONSP (tail);
3063 prev = tail, tail = next)
1ab256cb 3064 {
7539e11f
KR
3065 next = XCDR (tail);
3066 overlay = XCAR (tail);
2eec3b4e
RS
3067
3068 /* If the overlay is not valid, get rid of it. */
3069 if (!OVERLAY_VALID (overlay))
52f8ec73
JB
3070#if 1
3071 abort ();
3072#else
2eec3b4e
RS
3073 {
3074 /* Splice the cons cell TAIL out of overlays_before. */
3075 if (!NILP (prev))
7539e11f 3076 XCDR (prev) = next;
2eec3b4e 3077 else
5c4f68f1 3078 buf->overlays_before = next;
2eec3b4e
RS
3079 tail = prev;
3080 continue;
3081 }
52f8ec73 3082#endif
1ab256cb 3083
2eec3b4e
RS
3084 beg = OVERLAY_START (overlay);
3085 end = OVERLAY_END (overlay);
1ab256cb 3086
2eec3b4e 3087 if (OVERLAY_POSITION (end) > pos)
1ab256cb 3088 {
2eec3b4e
RS
3089 /* OVERLAY needs to be moved. */
3090 int where = OVERLAY_POSITION (beg);
3091 Lisp_Object other, other_prev;
3092
3093 /* Splice the cons cell TAIL out of overlays_before. */
3094 if (!NILP (prev))
f3fbd155 3095 XSETCDR (prev, next);
2eec3b4e 3096 else
5c4f68f1 3097 buf->overlays_before = next;
2eec3b4e
RS
3098
3099 /* Search thru overlays_after for where to put it. */
3100 other_prev = Qnil;
5c4f68f1 3101 for (other = buf->overlays_after;
2eec3b4e 3102 CONSP (other);
7539e11f 3103 other_prev = other, other = XCDR (other))
1ab256cb 3104 {
6af718a4 3105 Lisp_Object otherbeg, otheroverlay;
2eec3b4e 3106
7539e11f 3107 otheroverlay = XCAR (other);
2eec3b4e 3108 if (! OVERLAY_VALID (otheroverlay))
52f8ec73 3109 abort ();
2eec3b4e
RS
3110
3111 otherbeg = OVERLAY_START (otheroverlay);
3112 if (OVERLAY_POSITION (otherbeg) >= where)
3113 break;
1ab256cb 3114 }
2eec3b4e
RS
3115
3116 /* Add TAIL to overlays_after before OTHER. */
f3fbd155 3117 XSETCDR (tail, other);
2eec3b4e 3118 if (!NILP (other_prev))
f3fbd155 3119 XSETCDR (other_prev, tail);
1ab256cb 3120 else
5c4f68f1 3121 buf->overlays_after = tail;
2eec3b4e 3122 tail = prev;
1ab256cb 3123 }
2eec3b4e
RS
3124 else
3125 /* We've reached the things that should stay in overlays_before.
3126 All the rest of overlays_before must end even earlier,
3127 so stop now. */
3128 break;
3129 }
3130
3131 /* See if anything in overlays_after should be in overlays_before. */
3132 prev = Qnil;
5c4f68f1 3133 for (tail = buf->overlays_after;
2eec3b4e
RS
3134 CONSP (tail);
3135 prev = tail, tail = next)
3136 {
7539e11f
KR
3137 next = XCDR (tail);
3138 overlay = XCAR (tail);
2eec3b4e
RS
3139
3140 /* If the overlay is not valid, get rid of it. */
3141 if (!OVERLAY_VALID (overlay))
52f8ec73
JB
3142#if 1
3143 abort ();
3144#else
2eec3b4e
RS
3145 {
3146 /* Splice the cons cell TAIL out of overlays_after. */
3147 if (!NILP (prev))
7539e11f 3148 XCDR (prev) = next;
2eec3b4e 3149 else
5c4f68f1 3150 buf->overlays_after = next;
2eec3b4e
RS
3151 tail = prev;
3152 continue;
3153 }
52f8ec73 3154#endif
2eec3b4e
RS
3155
3156 beg = OVERLAY_START (overlay);
3157 end = OVERLAY_END (overlay);
3158
3159 /* Stop looking, when we know that nothing further
3160 can possibly end before POS. */
3161 if (OVERLAY_POSITION (beg) > pos)
3162 break;
3163
3164 if (OVERLAY_POSITION (end) <= pos)
3165 {
3166 /* OVERLAY needs to be moved. */
3167 int where = OVERLAY_POSITION (end);
3168 Lisp_Object other, other_prev;
3169
3170 /* Splice the cons cell TAIL out of overlays_after. */
3171 if (!NILP (prev))
f3fbd155 3172 XSETCDR (prev, next);
2eec3b4e 3173 else
5c4f68f1 3174 buf->overlays_after = next;
2eec3b4e
RS
3175
3176 /* Search thru overlays_before for where to put it. */
3177 other_prev = Qnil;
5c4f68f1 3178 for (other = buf->overlays_before;
2eec3b4e 3179 CONSP (other);
7539e11f 3180 other_prev = other, other = XCDR (other))
2eec3b4e
RS
3181 {
3182 Lisp_Object otherend, otheroverlay;
2eec3b4e 3183
7539e11f 3184 otheroverlay = XCAR (other);
2eec3b4e 3185 if (! OVERLAY_VALID (otheroverlay))
52f8ec73 3186 abort ();
2eec3b4e
RS
3187
3188 otherend = OVERLAY_END (otheroverlay);
3189 if (OVERLAY_POSITION (otherend) <= where)
3190 break;
3191 }
3192
3193 /* Add TAIL to overlays_before before OTHER. */
f3fbd155 3194 XSETCDR (tail, other);
2eec3b4e 3195 if (!NILP (other_prev))
f3fbd155 3196 XSETCDR (other_prev, tail);
2eec3b4e 3197 else
5c4f68f1 3198 buf->overlays_before = tail;
2eec3b4e
RS
3199 tail = prev;
3200 }
3201 }
3202
8d7a4592 3203 XSETFASTINT (buf->overlay_center, pos);
2eec3b4e 3204}
2b1bdf65 3205
423cdb46
KH
3206void
3207adjust_overlays_for_insert (pos, length)
3208 int pos;
3209 int length;
3210{
3211 /* After an insertion, the lists are still sorted properly,
3212 but we may need to update the value of the overlay center. */
3213 if (XFASTINT (current_buffer->overlay_center) >= pos)
3214 XSETFASTINT (current_buffer->overlay_center,
3215 XFASTINT (current_buffer->overlay_center) + length);
3216}
3217
3218void
3219adjust_overlays_for_delete (pos, length)
3220 int pos;
3221 int length;
3222{
3223 if (XFASTINT (current_buffer->overlay_center) < pos)
3224 /* The deletion was to our right. No change needed; the before- and
3225 after-lists are still consistent. */
3226 ;
3227 else if (XFASTINT (current_buffer->overlay_center) > pos + length)
3228 /* The deletion was to our left. We need to adjust the center value
3229 to account for the change in position, but the lists are consistent
3230 given the new value. */
3231 XSETFASTINT (current_buffer->overlay_center,
3232 XFASTINT (current_buffer->overlay_center) - length);
3233 else
3234 /* We're right in the middle. There might be things on the after-list
3235 that now belong on the before-list. Recentering will move them,
3236 and also update the center point. */
3237 recenter_overlay_lists (current_buffer, pos);
3238}
3239
2b1bdf65
KH
3240/* Fix up overlays that were garbled as a result of permuting markers
3241 in the range START through END. Any overlay with at least one
3242 endpoint in this range will need to be unlinked from the overlay
3243 list and reinserted in its proper place.
3244 Such an overlay might even have negative size at this point.
3245 If so, we'll reverse the endpoints. Can you think of anything
3246 better to do in this situation? */
3247void
3248fix_overlays_in_range (start, end)
3249 register int start, end;
3250{
6af718a4 3251 Lisp_Object overlay;
2b1bdf65 3252 Lisp_Object before_list, after_list;
1138e742
KR
3253 /* These are either nil, indicating that before_list or after_list
3254 should be assigned, or the cons cell the cdr of which should be
3255 assigned. */
3256 Lisp_Object beforep = Qnil, afterp = Qnil;
3257 /* 'Parent', likewise, indicates a cons cell or
3258 current_buffer->overlays_before or overlays_after, depending
3259 which loop we're in. */
3260 Lisp_Object tail, parent;
2b1bdf65
KH
3261 int startpos, endpos;
3262
3263 /* This algorithm shifts links around instead of consing and GCing.
3264 The loop invariant is that before_list (resp. after_list) is a
1138e742
KR
3265 well-formed list except that its last element, the CDR of beforep
3266 (resp. afterp) if beforep (afterp) isn't nil or before_list
3267 (after_list) if it is, is still uninitialized. So it's not a bug
3268 that before_list isn't initialized, although it may look
3269 strange. */
3270 for (parent = Qnil, tail = current_buffer->overlays_before; CONSP (tail);)
2b1bdf65 3271 {
1138e742 3272 overlay = XCAR (tail);
2b1bdf65
KH
3273 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3274 if (endpos < start)
3275 break;
3276 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3277 if (endpos < end
3278 || (startpos >= start && startpos < end))
3279 {
3280 /* If the overlay is backwards, fix that now. */
3281 if (startpos > endpos)
3282 {
3283 int tem;
2c99f3ea
RS
3284 Fset_marker (OVERLAY_START (overlay), make_number (endpos),
3285 Qnil);
3286 Fset_marker (OVERLAY_END (overlay), make_number (startpos),
3287 Qnil);
2b1bdf65
KH
3288 tem = startpos; startpos = endpos; endpos = tem;
3289 }
3290 /* Add it to the end of the wrong list. Later on,
3291 recenter_overlay_lists will move it to the right place. */
3292 if (endpos < XINT (current_buffer->overlay_center))
3293 {
1138e742
KR
3294 if (NILP (afterp))
3295 after_list = tail;
3296 else
3297 XSETCDR (afterp, tail);
3298 afterp = tail;
2b1bdf65
KH
3299 }
3300 else
3301 {
1138e742
KR
3302 if (NILP (beforep))
3303 before_list = tail;
3304 else
3305 XSETCDR (beforep, tail);
3306 beforep = tail;
2b1bdf65 3307 }
1138e742
KR
3308 if (NILP (parent))
3309 current_buffer->overlays_before = XCDR (tail);
3310 else
3311 XSETCDR (parent, XCDR (tail));
3312 tail = XCDR (tail);
2b1bdf65
KH
3313 }
3314 else
1138e742 3315 parent = tail, tail = XCDR (parent);
2b1bdf65 3316 }
1138e742 3317 for (parent = Qnil, tail = current_buffer->overlays_after; CONSP (tail);)
2b1bdf65 3318 {
1138e742 3319 overlay = XCAR (tail);
2b1bdf65
KH
3320 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3321 if (startpos >= end)
3322 break;
3323 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3324 if (startpos >= start
3325 || (endpos >= start && endpos < end))
3326 {
3327 if (startpos > endpos)
3328 {
3329 int tem;
2c99f3ea
RS
3330 Fset_marker (OVERLAY_START (overlay), make_number (endpos),
3331 Qnil);
3332 Fset_marker (OVERLAY_END (overlay), make_number (startpos),
3333 Qnil);
2b1bdf65
KH
3334 tem = startpos; startpos = endpos; endpos = tem;
3335 }
3336 if (endpos < XINT (current_buffer->overlay_center))
3337 {
1138e742
KR
3338 if (NILP (afterp))
3339 after_list = tail;
3340 else
3341 XSETCDR (afterp, tail);
3342 afterp = tail;
2b1bdf65
KH
3343 }
3344 else
3345 {
1138e742
KR
3346 if (NILP (beforep))
3347 before_list = tail;
3348 else
3349 XSETCDR (beforep, tail);
3350 beforep = tail;
2b1bdf65 3351 }
1138e742
KR
3352 if (NILP (parent))
3353 current_buffer->overlays_after = XCDR (tail);
3354 else
3355 XSETCDR (parent, XCDR (tail));
3356 tail = XCDR (tail);
2b1bdf65
KH
3357 }
3358 else
1138e742 3359 parent = tail, tail = XCDR (parent);
2b1bdf65
KH
3360 }
3361
3362 /* Splice the constructed (wrong) lists into the buffer's lists,
3363 and let the recenter function make it sane again. */
1138e742
KR
3364 if (!NILP (beforep))
3365 {
3366 XSETCDR (beforep, current_buffer->overlays_before);
3367 current_buffer->overlays_before = before_list;
3368 }
2b1bdf65
KH
3369 recenter_overlay_lists (current_buffer,
3370 XINT (current_buffer->overlay_center));
3371
1138e742
KR
3372 if (!NILP (afterp))
3373 {
3374 XSETCDR (afterp, current_buffer->overlays_after);
3375 current_buffer->overlays_after = after_list;
3376 }
2b1bdf65
KH
3377 recenter_overlay_lists (current_buffer,
3378 XINT (current_buffer->overlay_center));
3379}
3b06f880
KH
3380
3381/* We have two types of overlay: the one whose ending marker is
3382 after-insertion-marker (this is the usual case) and the one whose
3383 ending marker is before-insertion-marker. When `overlays_before'
3384 contains overlays of the latter type and the former type in this
3385 order and both overlays end at inserting position, inserting a text
3386 increases only the ending marker of the latter type, which results
3387 in incorrect ordering of `overlays_before'.
3388
3389 This function fixes ordering of overlays in the slot
3390 `overlays_before' of the buffer *BP. Before the insertion, `point'
3391 was at PREV, and now is at POS. */
3392
01136e9b 3393void
3b06f880
KH
3394fix_overlays_before (bp, prev, pos)
3395 struct buffer *bp;
3396 int prev, pos;
3397{
1138e742
KR
3398 /* If parent is nil, replace overlays_before; otherwise, XCDR(parent). */
3399 Lisp_Object tail = bp->overlays_before, parent = Qnil;
3400 Lisp_Object right_pair;
3b06f880
KH
3401 int end;
3402
3403 /* After the insertion, the several overlays may be in incorrect
3404 order. The possibility is that, in the list `overlays_before',
3405 an overlay which ends at POS appears after an overlay which ends
3406 at PREV. Since POS is greater than PREV, we must fix the
3407 ordering of these overlays, by moving overlays ends at POS before
3408 the overlays ends at PREV. */
3409
3410 /* At first, find a place where disordered overlays should be linked
3411 in. It is where an overlay which end before POS exists. (i.e. an
3412 overlay whose ending marker is after-insertion-marker if disorder
3413 exists). */
1138e742
KR
3414 while (!NILP (tail)
3415 && ((end = OVERLAY_POSITION (OVERLAY_END (XCAR (tail))))
3b06f880 3416 >= pos))
1138e742
KR
3417 {
3418 parent = tail;
3419 tail = XCDR (tail);
3420 }
3b06f880
KH
3421
3422 /* If we don't find such an overlay,
3423 or the found one ends before PREV,
3424 or the found one is the last one in the list,
3425 we don't have to fix anything. */
1138e742 3426 if (NILP (tail)
3b06f880 3427 || end < prev
1138e742 3428 || NILP (XCDR (tail)))
3b06f880
KH
3429 return;
3430
1138e742
KR
3431 right_pair = parent;
3432 parent = tail;
3433 tail = XCDR (tail);
3b06f880 3434
1138e742 3435 /* Now, end position of overlays in the list TAIL should be before
3b06f880 3436 or equal to PREV. In the loop, an overlay which ends at POS is
1138e742
KR
3437 moved ahead to the place indicated by the CDR of RIGHT_PAIR. If
3438 we found an overlay which ends before PREV, the remaining
3439 overlays are in correct order. */
3440 while (!NILP (tail))
3b06f880 3441 {
1138e742 3442 end = OVERLAY_POSITION (OVERLAY_END (XCAR (tail)));
3b06f880
KH
3443
3444 if (end == pos)
3445 { /* This overlay is disordered. */
1138e742 3446 Lisp_Object found = tail;
3b06f880
KH
3447
3448 /* Unlink the found overlay. */
504322ad
KR
3449 tail = XCDR (found);
3450 XSETCDR (parent, tail);
1138e742
KR
3451 /* Move an overlay at RIGHT_PLACE to the next of the found one,
3452 and link it into the right place. */
3453 if (NILP (right_pair))
3454 {
3455 XSETCDR (found, bp->overlays_before);
3456 bp->overlays_before = found;
3457 }
3458 else
3459 {
3460 XSETCDR (found, XCDR (right_pair));
3461 XSETCDR (right_pair, found);
3462 }
3b06f880
KH
3463 }
3464 else if (end == prev)
1138e742
KR
3465 {
3466 parent = tail;
3467 tail = XCDR (tail);
3468 }
3b06f880
KH
3469 else /* No more disordered overlay. */
3470 break;
3471 }
3472}
2eec3b4e 3473\f
52f8ec73 3474DEFUN ("overlayp", Foverlayp, Soverlayp, 1, 1, 0,
7ee72033
MB
3475 doc: /* Return t if OBJECT is an overlay. */)
3476 (object)
52f8ec73
JB
3477 Lisp_Object object;
3478{
3479 return (OVERLAYP (object) ? Qt : Qnil);
3480}
3481
acac2700 3482DEFUN ("make-overlay", Fmake_overlay, Smake_overlay, 2, 5, 0,
7ee72033 3483 doc: /* Create a new overlay with range BEG to END in BUFFER.
018ba359
PJ
3484If omitted, BUFFER defaults to the current buffer.
3485BEG and END may be integers or markers.
3486The fourth arg FRONT-ADVANCE, if non-nil, makes the
3487front delimiter advance when text is inserted there.
3488The fifth arg REAR-ADVANCE, if non-nil, makes the
7ee72033
MB
3489rear delimiter advance when text is inserted there. */)
3490 (beg, end, buffer, front_advance, rear_advance)
5c4f68f1 3491 Lisp_Object beg, end, buffer;
acac2700 3492 Lisp_Object front_advance, rear_advance;
2eec3b4e
RS
3493{
3494 Lisp_Object overlay;
5c4f68f1 3495 struct buffer *b;
2eec3b4e 3496
5c4f68f1 3497 if (NILP (buffer))
67180c6a 3498 XSETBUFFER (buffer, current_buffer);
883047b9 3499 else
b7826503 3500 CHECK_BUFFER (buffer);
883047b9
JB
3501 if (MARKERP (beg)
3502 && ! EQ (Fmarker_buffer (beg), buffer))
3503 error ("Marker points into wrong buffer");
3504 if (MARKERP (end)
3505 && ! EQ (Fmarker_buffer (end), buffer))
3506 error ("Marker points into wrong buffer");
2eec3b4e 3507
b7826503
PJ
3508 CHECK_NUMBER_COERCE_MARKER (beg);
3509 CHECK_NUMBER_COERCE_MARKER (end);
5c4f68f1 3510
883047b9 3511 if (XINT (beg) > XINT (end))
5c4f68f1 3512 {
c99fc30f
KH
3513 Lisp_Object temp;
3514 temp = beg; beg = end; end = temp;
5c4f68f1 3515 }
883047b9
JB
3516
3517 b = XBUFFER (buffer);
3518
3519 beg = Fset_marker (Fmake_marker (), beg, buffer);
3520 end = Fset_marker (Fmake_marker (), end, buffer);
5c4f68f1 3521
acac2700
RS
3522 if (!NILP (front_advance))
3523 XMARKER (beg)->insertion_type = 1;
3524 if (!NILP (rear_advance))
3525 XMARKER (end)->insertion_type = 1;
597dd755 3526
48e2e3ba 3527 overlay = allocate_misc ();
89ca3e1b 3528 XMISCTYPE (overlay) = Lisp_Misc_Overlay;
48e2e3ba
KH
3529 XOVERLAY (overlay)->start = beg;
3530 XOVERLAY (overlay)->end = end;
3531 XOVERLAY (overlay)->plist = Qnil;
2eec3b4e
RS
3532
3533 /* Put the new overlay on the wrong list. */
3534 end = OVERLAY_END (overlay);
5c4f68f1
JB
3535 if (OVERLAY_POSITION (end) < XINT (b->overlay_center))
3536 b->overlays_after = Fcons (overlay, b->overlays_after);
2eec3b4e 3537 else
5c4f68f1 3538 b->overlays_before = Fcons (overlay, b->overlays_before);
2eec3b4e
RS
3539
3540 /* This puts it in the right list, and in the right order. */
5c4f68f1 3541 recenter_overlay_lists (b, XINT (b->overlay_center));
2eec3b4e 3542
b61982dd
JB
3543 /* We don't need to redisplay the region covered by the overlay, because
3544 the overlay has no properties at the moment. */
3545
2eec3b4e
RS
3546 return overlay;
3547}
876aa27c
RS
3548\f
3549/* Mark a section of BUF as needing redisplay because of overlays changes. */
3550
3551static void
3552modify_overlay (buf, start, end)
3553 struct buffer *buf;
3554 int start, end;
3555{
876aa27c
RS
3556 if (start > end)
3557 {
3558 int temp = start;
26f545d7
GM
3559 start = end;
3560 end = temp;
876aa27c
RS
3561 }
3562
481b5054
GM
3563 BUF_COMPUTE_UNCHANGED (buf, start, end);
3564
876aa27c
RS
3565 /* If this is a buffer not in the selected window,
3566 we must do other windows. */
3567 if (buf != XBUFFER (XWINDOW (selected_window)->buffer))
3568 windows_or_buffers_changed = 1;
876aa27c
RS
3569 /* If multiple windows show this buffer, we must do other windows. */
3570 else if (buffer_shared > 1)
3571 windows_or_buffers_changed = 1;
876aa27c 3572
d8b9150f 3573 ++BUF_OVERLAY_MODIFF (buf);
876aa27c 3574}
2eec3b4e 3575
018ba359 3576\f
2e34157c
RS
3577Lisp_Object Fdelete_overlay ();
3578
5c4f68f1 3579DEFUN ("move-overlay", Fmove_overlay, Smove_overlay, 3, 4, 0,
7ee72033 3580 doc: /* Set the endpoints of OVERLAY to BEG and END in BUFFER.
018ba359
PJ
3581If BUFFER is omitted, leave OVERLAY in the same buffer it inhabits now.
3582If BUFFER is omitted, and OVERLAY is in no buffer, put it in the current
7ee72033
MB
3583buffer. */)
3584 (overlay, beg, end, buffer)
5c4f68f1 3585 Lisp_Object overlay, beg, end, buffer;
2eec3b4e 3586{
0a4469c9
RS
3587 struct buffer *b, *ob;
3588 Lisp_Object obuffer;
aed13378 3589 int count = SPECPDL_INDEX ();
5c4f68f1 3590
b7826503 3591 CHECK_OVERLAY (overlay);
5c4f68f1
JB
3592 if (NILP (buffer))
3593 buffer = Fmarker_buffer (OVERLAY_START (overlay));
3ece337a 3594 if (NILP (buffer))
67180c6a 3595 XSETBUFFER (buffer, current_buffer);
b7826503 3596 CHECK_BUFFER (buffer);
883047b9
JB
3597
3598 if (MARKERP (beg)
3599 && ! EQ (Fmarker_buffer (beg), buffer))
3600 error ("Marker points into wrong buffer");
3601 if (MARKERP (end)
3602 && ! EQ (Fmarker_buffer (end), buffer))
3603 error ("Marker points into wrong buffer");
3604
b7826503
PJ
3605 CHECK_NUMBER_COERCE_MARKER (beg);
3606 CHECK_NUMBER_COERCE_MARKER (end);
b61982dd 3607
9d7608b7
KH
3608 if (XINT (beg) == XINT (end) && ! NILP (Foverlay_get (overlay, Qevaporate)))
3609 return Fdelete_overlay (overlay);
0a4469c9 3610
b61982dd
JB
3611 if (XINT (beg) > XINT (end))
3612 {
c99fc30f
KH
3613 Lisp_Object temp;
3614 temp = beg; beg = end; end = temp;
b61982dd
JB
3615 }
3616
9d7608b7
KH
3617 specbind (Qinhibit_quit, Qt);
3618
0a4469c9 3619 obuffer = Fmarker_buffer (OVERLAY_START (overlay));
5c4f68f1 3620 b = XBUFFER (buffer);
8801a864 3621 ob = BUFFERP (obuffer) ? XBUFFER (obuffer) : (struct buffer *) 0;
2eec3b4e 3622
c82ed728 3623 /* If the overlay has changed buffers, do a thorough redisplay. */
0a4469c9 3624 if (!EQ (buffer, obuffer))
50760c4a
RS
3625 {
3626 /* Redisplay where the overlay was. */
3627 if (!NILP (obuffer))
3628 {
2e34157c
RS
3629 int o_beg;
3630 int o_end;
50760c4a 3631
80509f2f
RS
3632 o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
3633 o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
50760c4a 3634
2e34157c 3635 modify_overlay (ob, o_beg, o_end);
50760c4a
RS
3636 }
3637
3638 /* Redisplay where the overlay is going to be. */
876aa27c 3639 modify_overlay (b, XINT (beg), XINT (end));
50760c4a 3640 }
c82ed728
JB
3641 else
3642 /* Redisplay the area the overlay has just left, or just enclosed. */
3643 {
2e34157c 3644 int o_beg, o_end;
c82ed728 3645
80509f2f
RS
3646 o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
3647 o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
c82ed728 3648
2e34157c
RS
3649 if (o_beg == XINT (beg))
3650 modify_overlay (b, o_end, XINT (end));
3651 else if (o_end == XINT (end))
3652 modify_overlay (b, o_beg, XINT (beg));
c82ed728
JB
3653 else
3654 {
2e34157c
RS
3655 if (XINT (beg) < o_beg) o_beg = XINT (beg);
3656 if (XINT (end) > o_end) o_end = XINT (end);
3657 modify_overlay (b, o_beg, o_end);
c82ed728
JB
3658 }
3659 }
b61982dd 3660
0a4469c9
RS
3661 if (!NILP (obuffer))
3662 {
3663 ob->overlays_before = Fdelq (overlay, ob->overlays_before);
3664 ob->overlays_after = Fdelq (overlay, ob->overlays_after);
3665 }
5c4f68f1
JB
3666
3667 Fset_marker (OVERLAY_START (overlay), beg, buffer);
3668 Fset_marker (OVERLAY_END (overlay), end, buffer);
2eec3b4e
RS
3669
3670 /* Put the overlay on the wrong list. */
3671 end = OVERLAY_END (overlay);
5c4f68f1
JB
3672 if (OVERLAY_POSITION (end) < XINT (b->overlay_center))
3673 b->overlays_after = Fcons (overlay, b->overlays_after);
2eec3b4e 3674 else
5c4f68f1 3675 b->overlays_before = Fcons (overlay, b->overlays_before);
2eec3b4e
RS
3676
3677 /* This puts it in the right list, and in the right order. */
5c4f68f1 3678 recenter_overlay_lists (b, XINT (b->overlay_center));
2eec3b4e 3679
0a4469c9 3680 return unbind_to (count, overlay);
2eec3b4e
RS
3681}
3682
3683DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0,
7ee72033
MB
3684 doc: /* Delete the overlay OVERLAY from its buffer. */)
3685 (overlay)
5c4f68f1 3686 Lisp_Object overlay;
2eec3b4e 3687{
0a4469c9 3688 Lisp_Object buffer;
5c4f68f1 3689 struct buffer *b;
aed13378 3690 int count = SPECPDL_INDEX ();
5c4f68f1 3691
b7826503 3692 CHECK_OVERLAY (overlay);
52f8ec73 3693
0a4469c9
RS
3694 buffer = Fmarker_buffer (OVERLAY_START (overlay));
3695 if (NILP (buffer))
3696 return Qnil;
3697
3698 b = XBUFFER (buffer);
0a4469c9 3699 specbind (Qinhibit_quit, Qt);
26f545d7 3700
5c4f68f1 3701 b->overlays_before = Fdelq (overlay, b->overlays_before);
26f545d7 3702 b->overlays_after = Fdelq (overlay, b->overlays_after);
876aa27c 3703 modify_overlay (b,
8231a9aa
RS
3704 marker_position (OVERLAY_START (overlay)),
3705 marker_position (OVERLAY_END (overlay)));
3ece337a
JB
3706 Fset_marker (OVERLAY_START (overlay), Qnil, Qnil);
3707 Fset_marker (OVERLAY_END (overlay), Qnil, Qnil);
3708
e58c389d 3709 /* When deleting an overlay with before or after strings, turn off
26f545d7
GM
3710 display optimizations for the affected buffer, on the basis that
3711 these strings may contain newlines. This is easier to do than to
3712 check for that situation during redisplay. */
3713 if (!windows_or_buffers_changed
3714 && (!NILP (Foverlay_get (overlay, Qbefore_string))
3715 || !NILP (Foverlay_get (overlay, Qafter_string))))
3716 b->prevent_redisplay_optimizations_p = 1;
3717
0a4469c9 3718 return unbind_to (count, Qnil);
2eec3b4e
RS
3719}
3720\f
8ebafa8d
JB
3721/* Overlay dissection functions. */
3722
3723DEFUN ("overlay-start", Foverlay_start, Soverlay_start, 1, 1, 0,
7ee72033
MB
3724 doc: /* Return the position at which OVERLAY starts. */)
3725 (overlay)
8ebafa8d
JB
3726 Lisp_Object overlay;
3727{
b7826503 3728 CHECK_OVERLAY (overlay);
8ebafa8d
JB
3729
3730 return (Fmarker_position (OVERLAY_START (overlay)));
3731}
3732
3733DEFUN ("overlay-end", Foverlay_end, Soverlay_end, 1, 1, 0,
7ee72033
MB
3734 doc: /* Return the position at which OVERLAY ends. */)
3735 (overlay)
8ebafa8d
JB
3736 Lisp_Object overlay;
3737{
b7826503 3738 CHECK_OVERLAY (overlay);
8ebafa8d
JB
3739
3740 return (Fmarker_position (OVERLAY_END (overlay)));
3741}
3742
3743DEFUN ("overlay-buffer", Foverlay_buffer, Soverlay_buffer, 1, 1, 0,
7ee72033
MB
3744 doc: /* Return the buffer OVERLAY belongs to. */)
3745 (overlay)
8ebafa8d
JB
3746 Lisp_Object overlay;
3747{
b7826503 3748 CHECK_OVERLAY (overlay);
8ebafa8d
JB
3749
3750 return Fmarker_buffer (OVERLAY_START (overlay));
3751}
3752
3753DEFUN ("overlay-properties", Foverlay_properties, Soverlay_properties, 1, 1, 0,
7ee72033 3754 doc: /* Return a list of the properties on OVERLAY.
018ba359 3755This is a copy of OVERLAY's plist; modifying its conses has no effect on
7ee72033
MB
3756OVERLAY. */)
3757 (overlay)
8ebafa8d
JB
3758 Lisp_Object overlay;
3759{
b7826503 3760 CHECK_OVERLAY (overlay);
8ebafa8d 3761
48e2e3ba 3762 return Fcopy_sequence (XOVERLAY (overlay)->plist);
8ebafa8d
JB
3763}
3764
3765\f
2eec3b4e 3766DEFUN ("overlays-at", Foverlays_at, Soverlays_at, 1, 1, 0,
7ee72033
MB
3767 doc: /* Return a list of the overlays that contain position POS. */)
3768 (pos)
2eec3b4e
RS
3769 Lisp_Object pos;
3770{
3771 int noverlays;
2eec3b4e
RS
3772 Lisp_Object *overlay_vec;
3773 int len;
3774 Lisp_Object result;
3775
b7826503 3776 CHECK_NUMBER_COERCE_MARKER (pos);
2eec3b4e
RS
3777
3778 len = 10;
a9800ae8 3779 /* We can't use alloca here because overlays_at can call xrealloc. */
2eec3b4e
RS
3780 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
3781
3782 /* Put all the overlays we want in a vector in overlay_vec.
3783 Store the length in len. */
2a77a7d7 3784 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
ac869cf7 3785 (int *) 0, (int *) 0, 0);
2eec3b4e
RS
3786
3787 /* Make a list of them all. */
3788 result = Flist (noverlays, overlay_vec);
3789
9ac0d9e0 3790 xfree (overlay_vec);
2eec3b4e
RS
3791 return result;
3792}
3793
74514898 3794DEFUN ("overlays-in", Foverlays_in, Soverlays_in, 2, 2, 0,
7ee72033 3795 doc: /* Return a list of the overlays that overlap the region BEG ... END.
018ba359
PJ
3796Overlap means that at least one character is contained within the overlay
3797and also contained within the specified region.
3798Empty overlays are included in the result if they are located at BEG
7ee72033
MB
3799or between BEG and END. */)
3800 (beg, end)
74514898
RS
3801 Lisp_Object beg, end;
3802{
3803 int noverlays;
3804 Lisp_Object *overlay_vec;
3805 int len;
3806 Lisp_Object result;
3807
b7826503
PJ
3808 CHECK_NUMBER_COERCE_MARKER (beg);
3809 CHECK_NUMBER_COERCE_MARKER (end);
74514898
RS
3810
3811 len = 10;
3812 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
3813
3814 /* Put all the overlays we want in a vector in overlay_vec.
3815 Store the length in len. */
3816 noverlays = overlays_in (XINT (beg), XINT (end), 1, &overlay_vec, &len,
3817 (int *) 0, (int *) 0);
3818
3819 /* Make a list of them all. */
3820 result = Flist (noverlays, overlay_vec);
3821
3822 xfree (overlay_vec);
3823 return result;
3824}
3825
2eec3b4e 3826DEFUN ("next-overlay-change", Fnext_overlay_change, Snext_overlay_change,
efc7e75f 3827 1, 1, 0,
7ee72033
MB
3828 doc: /* Return the next position after POS where an overlay starts or ends.
3829If there are no more overlay boundaries after POS, return (point-max). */)
3830 (pos)
2eec3b4e
RS
3831 Lisp_Object pos;
3832{
3833 int noverlays;
3834 int endpos;
3835 Lisp_Object *overlay_vec;
3836 int len;
2eec3b4e
RS
3837 int i;
3838
b7826503 3839 CHECK_NUMBER_COERCE_MARKER (pos);
2eec3b4e
RS
3840
3841 len = 10;
3842 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
3843
3844 /* Put all the overlays we want in a vector in overlay_vec.
3845 Store the length in len.
3846 endpos gets the position where the next overlay starts. */
2a77a7d7 3847 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
ac869cf7 3848 &endpos, (int *) 0, 1);
2eec3b4e
RS
3849
3850 /* If any of these overlays ends before endpos,
3851 use its ending point instead. */
3852 for (i = 0; i < noverlays; i++)
3853 {
3854 Lisp_Object oend;
3855 int oendpos;
3856
3857 oend = OVERLAY_END (overlay_vec[i]);
3858 oendpos = OVERLAY_POSITION (oend);
3859 if (oendpos < endpos)
3860 endpos = oendpos;
1ab256cb
RM
3861 }
3862
9ac0d9e0 3863 xfree (overlay_vec);
2eec3b4e
RS
3864 return make_number (endpos);
3865}
239c932b
RS
3866
3867DEFUN ("previous-overlay-change", Fprevious_overlay_change,
3868 Sprevious_overlay_change, 1, 1, 0,
7ee72033
MB
3869 doc: /* Return the previous position before POS where an overlay starts or ends.
3870If there are no more overlay boundaries before POS, return (point-min). */)
3871 (pos)
239c932b
RS
3872 Lisp_Object pos;
3873{
3874 int noverlays;
3875 int prevpos;
3876 Lisp_Object *overlay_vec;
3877 int len;
239c932b 3878
b7826503 3879 CHECK_NUMBER_COERCE_MARKER (pos);
239c932b 3880
624bbdc4
RS
3881 /* At beginning of buffer, we know the answer;
3882 avoid bug subtracting 1 below. */
3883 if (XINT (pos) == BEGV)
3884 return pos;
3885
017f0539
GM
3886 len = 10;
3887 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
3888
239c932b
RS
3889 /* Put all the overlays we want in a vector in overlay_vec.
3890 Store the length in len.
daa1c109 3891 prevpos gets the position of the previous change. */
2a77a7d7 3892 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
ac869cf7 3893 (int *) 0, &prevpos, 1);
239c932b 3894
239c932b
RS
3895 xfree (overlay_vec);
3896 return make_number (prevpos);
3897}
2eec3b4e
RS
3898\f
3899/* These functions are for debugging overlays. */
3900
3901DEFUN ("overlay-lists", Foverlay_lists, Soverlay_lists, 0, 0, 0,
7ee72033 3902 doc: /* Return a pair of lists giving all the overlays of the current buffer.
018ba359
PJ
3903The car has all the overlays before the overlay center;
3904the cdr has all the overlays after the overlay center.
3905Recentering overlays moves overlays between these lists.
3906The lists you get are copies, so that changing them has no effect.
7ee72033
MB
3907However, the overlays you get are the real objects that the buffer uses. */)
3908 ()
2eec3b4e
RS
3909{
3910 Lisp_Object before, after;
3911 before = current_buffer->overlays_before;
3912 if (CONSP (before))
3913 before = Fcopy_sequence (before);
3914 after = current_buffer->overlays_after;
3915 if (CONSP (after))
3916 after = Fcopy_sequence (after);
3917
3918 return Fcons (before, after);
3919}
3920
3921DEFUN ("overlay-recenter", Foverlay_recenter, Soverlay_recenter, 1, 1, 0,
7ee72033
MB
3922 doc: /* Recenter the overlays of the current buffer around position POS. */)
3923 (pos)
2eec3b4e
RS
3924 Lisp_Object pos;
3925{
b7826503 3926 CHECK_NUMBER_COERCE_MARKER (pos);
2eec3b4e 3927
5c4f68f1 3928 recenter_overlay_lists (current_buffer, XINT (pos));
2eec3b4e
RS
3929 return Qnil;
3930}
3931\f
3932DEFUN ("overlay-get", Foverlay_get, Soverlay_get, 2, 2, 0,
7ee72033
MB
3933 doc: /* Get the property of overlay OVERLAY with property name PROP. */)
3934 (overlay, prop)
2eec3b4e
RS
3935 Lisp_Object overlay, prop;
3936{
b7826503 3937 CHECK_OVERLAY (overlay);
9a593927 3938 return lookup_char_property (XOVERLAY (overlay)->plist, prop, 0);
2eec3b4e
RS
3939}
3940
3941DEFUN ("overlay-put", Foverlay_put, Soverlay_put, 3, 3, 0,
7ee72033
MB
3942 doc: /* Set one property of overlay OVERLAY: give property PROP value VALUE. */)
3943 (overlay, prop, value)
2eec3b4e
RS
3944 Lisp_Object overlay, prop, value;
3945{
48e2e3ba 3946 Lisp_Object tail, buffer;
9d7608b7 3947 int changed;
2eec3b4e 3948
b7826503 3949 CHECK_OVERLAY (overlay);
b61982dd 3950
274a9425
RS
3951 buffer = Fmarker_buffer (OVERLAY_START (overlay));
3952
48e2e3ba 3953 for (tail = XOVERLAY (overlay)->plist;
7539e11f
KR
3954 CONSP (tail) && CONSP (XCDR (tail));
3955 tail = XCDR (XCDR (tail)))
3956 if (EQ (XCAR (tail), prop))
274a9425 3957 {
7539e11f 3958 changed = !EQ (XCAR (XCDR (tail)), value);
f3fbd155 3959 XSETCAR (XCDR (tail), value);
9d7608b7 3960 goto found;
274a9425 3961 }
9d7608b7
KH
3962 /* It wasn't in the list, so add it to the front. */
3963 changed = !NILP (value);
48e2e3ba
KH
3964 XOVERLAY (overlay)->plist
3965 = Fcons (prop, Fcons (value, XOVERLAY (overlay)->plist));
9d7608b7
KH
3966 found:
3967 if (! NILP (buffer))
3968 {
3969 if (changed)
876aa27c 3970 modify_overlay (XBUFFER (buffer),
26f545d7
GM
3971 marker_position (OVERLAY_START (overlay)),
3972 marker_position (OVERLAY_END (overlay)));
9d7608b7
KH
3973 if (EQ (prop, Qevaporate) && ! NILP (value)
3974 && (OVERLAY_POSITION (OVERLAY_START (overlay))
3975 == OVERLAY_POSITION (OVERLAY_END (overlay))))
3976 Fdelete_overlay (overlay);
3977 }
2eec3b4e 3978 return value;
1ab256cb
RM
3979}
3980\f
9115729e
KH
3981/* Subroutine of report_overlay_modification. */
3982
3983/* Lisp vector holding overlay hook functions to call.
3984 Vector elements come in pairs.
3985 Each even-index element is a list of hook functions.
3986 The following odd-index element is the overlay they came from.
3987
3988 Before the buffer change, we fill in this vector
3989 as we call overlay hook functions.
3990 After the buffer change, we get the functions to call from this vector.
3991 This way we always call the same functions before and after the change. */
3992static Lisp_Object last_overlay_modification_hooks;
3993
3994/* Number of elements actually used in last_overlay_modification_hooks. */
3995static int last_overlay_modification_hooks_used;
3996
3997/* Add one functionlist/overlay pair
3998 to the end of last_overlay_modification_hooks. */
3999
4000static void
4001add_overlay_mod_hooklist (functionlist, overlay)
4002 Lisp_Object functionlist, overlay;
4003{
4004 int oldsize = XVECTOR (last_overlay_modification_hooks)->size;
4005
4006 if (last_overlay_modification_hooks_used == oldsize)
4007 {
4008 Lisp_Object old;
4009 old = last_overlay_modification_hooks;
4010 last_overlay_modification_hooks
4011 = Fmake_vector (make_number (oldsize * 2), Qnil);
0b1f1b09
RS
4012 bcopy (XVECTOR (old)->contents,
4013 XVECTOR (last_overlay_modification_hooks)->contents,
9115729e
KH
4014 sizeof (Lisp_Object) * oldsize);
4015 }
4016 XVECTOR (last_overlay_modification_hooks)->contents[last_overlay_modification_hooks_used++] = functionlist;
4017 XVECTOR (last_overlay_modification_hooks)->contents[last_overlay_modification_hooks_used++] = overlay;
4018}
4019\f
173f2a64
RS
4020/* Run the modification-hooks of overlays that include
4021 any part of the text in START to END.
9115729e
KH
4022 If this change is an insertion, also
4023 run the insert-before-hooks of overlay starting at END,
930a9140
RS
4024 and the insert-after-hooks of overlay ending at START.
4025
4026 This is called both before and after the modification.
4027 AFTER is nonzero when we call after the modification.
4028
9115729e
KH
4029 ARG1, ARG2, ARG3 are arguments to pass to the hook functions.
4030 When AFTER is nonzero, they are the start position,
4031 the position after the inserted new text,
4032 and the length of deleted or replaced old text. */
173f2a64
RS
4033
4034void
930a9140 4035report_overlay_modification (start, end, after, arg1, arg2, arg3)
173f2a64 4036 Lisp_Object start, end;
930a9140
RS
4037 int after;
4038 Lisp_Object arg1, arg2, arg3;
173f2a64
RS
4039{
4040 Lisp_Object prop, overlay, tail;
9115729e
KH
4041 /* 1 if this change is an insertion. */
4042 int insertion = (after ? XFASTINT (arg3) == 0 : EQ (start, end));
55b48893 4043 int tail_copied;
930a9140 4044 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
55b48893
RS
4045
4046 overlay = Qnil;
4047 tail = Qnil;
930a9140 4048 GCPRO5 (overlay, tail, arg1, arg2, arg3);
173f2a64 4049
9115729e
KH
4050 if (after)
4051 {
4052 /* Call the functions recorded in last_overlay_modification_hooks
4053 rather than scanning the overlays again.
4054 First copy the vector contents, in case some of these hooks
4055 do subsequent modification of the buffer. */
4056 int size = last_overlay_modification_hooks_used;
4057 Lisp_Object *copy = (Lisp_Object *) alloca (size * sizeof (Lisp_Object));
4058 int i;
4059
4060 bcopy (XVECTOR (last_overlay_modification_hooks)->contents,
4061 copy, size * sizeof (Lisp_Object));
4062 gcpro1.var = copy;
4063 gcpro1.nvars = size;
4064
4065 for (i = 0; i < size;)
4066 {
4067 Lisp_Object prop, overlay;
4068 prop = copy[i++];
4069 overlay = copy[i++];
4070 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
4071 }
4072 UNGCPRO;
4073 return;
4074 }
4075
4076 /* We are being called before a change.
4077 Scan the overlays to find the functions to call. */
4078 last_overlay_modification_hooks_used = 0;
55b48893 4079 tail_copied = 0;
173f2a64
RS
4080 for (tail = current_buffer->overlays_before;
4081 CONSP (tail);
7539e11f 4082 tail = XCDR (tail))
173f2a64
RS
4083 {
4084 int startpos, endpos;
be8b1c6b 4085 Lisp_Object ostart, oend;
173f2a64 4086
7539e11f 4087 overlay = XCAR (tail);
173f2a64
RS
4088
4089 ostart = OVERLAY_START (overlay);
4090 oend = OVERLAY_END (overlay);
4091 endpos = OVERLAY_POSITION (oend);
4092 if (XFASTINT (start) > endpos)
4093 break;
4094 startpos = OVERLAY_POSITION (ostart);
9115729e
KH
4095 if (insertion && (XFASTINT (start) == startpos
4096 || XFASTINT (end) == startpos))
173f2a64
RS
4097 {
4098 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
5fb5aa33
RS
4099 if (!NILP (prop))
4100 {
4101 /* Copy TAIL in case the hook recenters the overlay lists. */
55b48893
RS
4102 if (!tail_copied)
4103 tail = Fcopy_sequence (tail);
4104 tail_copied = 1;
930a9140 4105 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
5fb5aa33 4106 }
173f2a64 4107 }
9115729e
KH
4108 if (insertion && (XFASTINT (start) == endpos
4109 || XFASTINT (end) == endpos))
173f2a64
RS
4110 {
4111 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
5fb5aa33
RS
4112 if (!NILP (prop))
4113 {
55b48893
RS
4114 if (!tail_copied)
4115 tail = Fcopy_sequence (tail);
4116 tail_copied = 1;
930a9140 4117 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
5fb5aa33 4118 }
173f2a64 4119 }
3bd13e92
KH
4120 /* Test for intersecting intervals. This does the right thing
4121 for both insertion and deletion. */
4122 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
173f2a64
RS
4123 {
4124 prop = Foverlay_get (overlay, Qmodification_hooks);
5fb5aa33
RS
4125 if (!NILP (prop))
4126 {
55b48893
RS
4127 if (!tail_copied)
4128 tail = Fcopy_sequence (tail);
4129 tail_copied = 1;
930a9140 4130 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
5fb5aa33 4131 }
173f2a64
RS
4132 }
4133 }
4134
55b48893 4135 tail_copied = 0;
173f2a64
RS
4136 for (tail = current_buffer->overlays_after;
4137 CONSP (tail);
7539e11f 4138 tail = XCDR (tail))
173f2a64
RS
4139 {
4140 int startpos, endpos;
be8b1c6b 4141 Lisp_Object ostart, oend;
173f2a64 4142
7539e11f 4143 overlay = XCAR (tail);
173f2a64
RS
4144
4145 ostart = OVERLAY_START (overlay);
4146 oend = OVERLAY_END (overlay);
4147 startpos = OVERLAY_POSITION (ostart);
cdf0b096 4148 endpos = OVERLAY_POSITION (oend);
173f2a64
RS
4149 if (XFASTINT (end) < startpos)
4150 break;
9115729e
KH
4151 if (insertion && (XFASTINT (start) == startpos
4152 || XFASTINT (end) == startpos))
173f2a64
RS
4153 {
4154 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
5fb5aa33
RS
4155 if (!NILP (prop))
4156 {
55b48893
RS
4157 if (!tail_copied)
4158 tail = Fcopy_sequence (tail);
4159 tail_copied = 1;
930a9140 4160 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
5fb5aa33 4161 }
173f2a64 4162 }
9115729e
KH
4163 if (insertion && (XFASTINT (start) == endpos
4164 || XFASTINT (end) == endpos))
173f2a64
RS
4165 {
4166 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
5fb5aa33
RS
4167 if (!NILP (prop))
4168 {
55b48893
RS
4169 if (!tail_copied)
4170 tail = Fcopy_sequence (tail);
4171 tail_copied = 1;
930a9140 4172 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
5fb5aa33 4173 }
173f2a64 4174 }
3bd13e92
KH
4175 /* Test for intersecting intervals. This does the right thing
4176 for both insertion and deletion. */
4177 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
173f2a64
RS
4178 {
4179 prop = Foverlay_get (overlay, Qmodification_hooks);
5fb5aa33
RS
4180 if (!NILP (prop))
4181 {
55b48893
RS
4182 if (!tail_copied)
4183 tail = Fcopy_sequence (tail);
4184 tail_copied = 1;
930a9140 4185 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
5fb5aa33 4186 }
173f2a64
RS
4187 }
4188 }
55b48893
RS
4189
4190 UNGCPRO;
173f2a64
RS
4191}
4192
4193static void
930a9140
RS
4194call_overlay_mod_hooks (list, overlay, after, arg1, arg2, arg3)
4195 Lisp_Object list, overlay;
4196 int after;
4197 Lisp_Object arg1, arg2, arg3;
173f2a64 4198{
930a9140 4199 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
9115729e 4200
930a9140 4201 GCPRO4 (list, arg1, arg2, arg3);
9115729e
KH
4202 if (! after)
4203 add_overlay_mod_hooklist (list, overlay);
4204
173f2a64
RS
4205 while (!NILP (list))
4206 {
930a9140
RS
4207 if (NILP (arg3))
4208 call4 (Fcar (list), overlay, after ? Qt : Qnil, arg1, arg2);
4209 else
4210 call5 (Fcar (list), overlay, after ? Qt : Qnil, arg1, arg2, arg3);
173f2a64
RS
4211 list = Fcdr (list);
4212 }
4213 UNGCPRO;
4214}
9d7608b7
KH
4215
4216/* Delete any zero-sized overlays at position POS, if the `evaporate'
4217 property is set. */
4218void
4219evaporate_overlays (pos)
4220 int pos;
4221{
4222 Lisp_Object tail, overlay, hit_list;
4223
4224 hit_list = Qnil;
4225 if (pos <= XFASTINT (current_buffer->overlay_center))
4226 for (tail = current_buffer->overlays_before; CONSP (tail);
7539e11f 4227 tail = XCDR (tail))
9d7608b7
KH
4228 {
4229 int endpos;
7539e11f 4230 overlay = XCAR (tail);
9d7608b7
KH
4231 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
4232 if (endpos < pos)
4233 break;
4234 if (endpos == pos && OVERLAY_POSITION (OVERLAY_START (overlay)) == pos
c3935f9d 4235 && ! NILP (Foverlay_get (overlay, Qevaporate)))
9d7608b7
KH
4236 hit_list = Fcons (overlay, hit_list);
4237 }
4238 else
4239 for (tail = current_buffer->overlays_after; CONSP (tail);
7539e11f 4240 tail = XCDR (tail))
9d7608b7
KH
4241 {
4242 int startpos;
7539e11f 4243 overlay = XCAR (tail);
9d7608b7
KH
4244 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
4245 if (startpos > pos)
4246 break;
4247 if (startpos == pos && OVERLAY_POSITION (OVERLAY_END (overlay)) == pos
c3935f9d 4248 && ! NILP (Foverlay_get (overlay, Qevaporate)))
9d7608b7
KH
4249 hit_list = Fcons (overlay, hit_list);
4250 }
7539e11f
KR
4251 for (; CONSP (hit_list); hit_list = XCDR (hit_list))
4252 Fdelete_overlay (XCAR (hit_list));
9d7608b7 4253}
173f2a64 4254\f
54dfdeb0 4255/* Somebody has tried to store a value with an unacceptable type
1bf08baf
KH
4256 in the slot with offset OFFSET. */
4257
0fa3ba92 4258void
54dfdeb0
KH
4259buffer_slot_type_mismatch (offset)
4260 int offset;
0fa3ba92 4261{
54dfdeb0 4262 Lisp_Object sym;
0fa3ba92 4263 char *type_name;
7c02e886 4264
7313acd0 4265 switch (XINT (PER_BUFFER_TYPE (offset)))
0fa3ba92 4266 {
7c02e886
GM
4267 case Lisp_Int:
4268 type_name = "integers";
4269 break;
4270
4271 case Lisp_String:
4272 type_name = "strings";
4273 break;
4274
4275 case Lisp_Symbol:
4276 type_name = "symbols";
4277 break;
4278
0fa3ba92
JB
4279 default:
4280 abort ();
4281 }
4282
7313acd0 4283 sym = PER_BUFFER_SYMBOL (offset);
1bf08baf 4284 error ("Only %s should be stored in the buffer-local variable %s",
d5db4077 4285 type_name, SDATA (SYMBOL_NAME (sym)));
0fa3ba92 4286}
7c02e886 4287
0fa3ba92 4288\f
b86af064
GM
4289/***********************************************************************
4290 Allocation with mmap
4291 ***********************************************************************/
4292
4293#ifdef USE_MMAP_FOR_BUFFERS
4294
4295#include <sys/types.h>
4296#include <sys/mman.h>
4297
4298#ifndef MAP_ANON
4299#ifdef MAP_ANONYMOUS
4300#define MAP_ANON MAP_ANONYMOUS
4301#else
4302#define MAP_ANON 0
4303#endif
4304#endif
4305
09dfdf85
GM
4306#ifndef MAP_FAILED
4307#define MAP_FAILED ((void *) -1)
4308#endif
4309
b86af064
GM
4310#include <stdio.h>
4311#include <errno.h>
4312
4313#if MAP_ANON == 0
4314#include <fcntl.h>
4315#endif
4316
4317#include "coding.h"
4318
4319
4320/* Memory is allocated in regions which are mapped using mmap(2).
4321 The current implementation lets the system select mapped
4322 addresses; we're not using MAP_FIXED in general, except when
4323 trying to enlarge regions.
4324
4325 Each mapped region starts with a mmap_region structure, the user
4326 area starts after that structure, aligned to MEM_ALIGN.
4327
4328 +-----------------------+
4329 | struct mmap_info + |
4330 | padding |
4331 +-----------------------+
4332 | user data |
4333 | |
4334 | |
4335 +-----------------------+ */
4336
4337struct mmap_region
4338{
4339 /* User-specified size. */
4340 size_t nbytes_specified;
4341
4342 /* Number of bytes mapped */
4343 size_t nbytes_mapped;
4344
4345 /* Pointer to the location holding the address of the memory
4346 allocated with the mmap'd block. The variable actually points
4347 after this structure. */
4348 POINTER_TYPE **var;
4349
4350 /* Next and previous in list of all mmap'd regions. */
4351 struct mmap_region *next, *prev;
4352};
4353
4354/* Doubly-linked list of mmap'd regions. */
4355
4356static struct mmap_region *mmap_regions;
4357
4358/* File descriptor for mmap. If we don't have anonymous mapping,
4359 /dev/zero will be opened on it. */
4360
4361static int mmap_fd;
4362
4363/* Temporary storage for mmap_set_vars, see there. */
4364
4365static struct mmap_region *mmap_regions_1;
4366static int mmap_fd_1;
4367
4368/* Page size on this system. */
4369
4370static int mmap_page_size;
4371
4372/* 1 means mmap has been intialized. */
4373
4374static int mmap_initialized_p;
4375
4376/* Value is X rounded up to the next multiple of N. */
4377
4378#define ROUND(X, N) (((X) + (N) - 1) / (N) * (N))
4379
4380/* Size of mmap_region structure plus padding. */
4381
4382#define MMAP_REGION_STRUCT_SIZE \
4383 ROUND (sizeof (struct mmap_region), MEM_ALIGN)
4384
4385/* Given a pointer P to the start of the user-visible part of a mapped
4386 region, return a pointer to the start of the region. */
4387
4388#define MMAP_REGION(P) \
4389 ((struct mmap_region *) ((char *) (P) - MMAP_REGION_STRUCT_SIZE))
4390
4391/* Given a pointer P to the start of a mapped region, return a pointer
4392 to the start of the user-visible part of the region. */
4393
4394#define MMAP_USER_AREA(P) \
4395 ((POINTER_TYPE *) ((char *) (P) + MMAP_REGION_STRUCT_SIZE))
4396
4397#define MEM_ALIGN sizeof (double)
4398
08327b22
GM
4399/* Predicate returning true if part of the address range [START ..
4400 END[ is currently mapped. Used to prevent overwriting an existing
4401 memory mapping.
4402
4403 Default is to conservativly assume the address range is occupied by
4404 something else. This can be overridden by system configuration
4405 files if system-specific means to determine this exists. */
4406
4407#ifndef MMAP_ALLOCATED_P
4408#define MMAP_ALLOCATED_P(start, end) 1
4409#endif
4410
b86af064
GM
4411/* Function prototypes. */
4412
4413static int mmap_free_1 P_ ((struct mmap_region *));
4414static int mmap_enlarge P_ ((struct mmap_region *, int));
4415static struct mmap_region *mmap_find P_ ((POINTER_TYPE *, POINTER_TYPE *));
4416static POINTER_TYPE *mmap_alloc P_ ((POINTER_TYPE **, size_t));
4417static POINTER_TYPE *mmap_realloc P_ ((POINTER_TYPE **, size_t));
4418static void mmap_free P_ ((POINTER_TYPE **ptr));
4419static void mmap_init P_ ((void));
4420
4421
4422/* Return a region overlapping address range START...END, or null if
4423 none. END is not including, i.e. the last byte in the range
4424 is at END - 1. */
4425
4426static struct mmap_region *
4427mmap_find (start, end)
4428 POINTER_TYPE *start, *end;
4429{
4430 struct mmap_region *r;
4431 char *s = (char *) start, *e = (char *) end;
4432
4433 for (r = mmap_regions; r; r = r->next)
4434 {
4435 char *rstart = (char *) r;
4436 char *rend = rstart + r->nbytes_mapped;
4437
4438 if (/* First byte of range, i.e. START, in this region? */
4439 (s >= rstart && s < rend)
4440 /* Last byte of range, i.e. END - 1, in this region? */
4441 || (e > rstart && e <= rend)
4442 /* First byte of this region in the range? */
4443 || (rstart >= s && rstart < e)
4444 /* Last byte of this region in the range? */
4445 || (rend > s && rend <= e))
4446 break;
4447 }
4448
4449 return r;
4450}
4451
4452
4453/* Unmap a region. P is a pointer to the start of the user-araa of
4454 the region. Value is non-zero if successful. */
4455
4456static int
4457mmap_free_1 (r)
4458 struct mmap_region *r;
4459{
4460 if (r->next)
4461 r->next->prev = r->prev;
4462 if (r->prev)
4463 r->prev->next = r->next;
4464 else
4465 mmap_regions = r->next;
4466
1a15cca0 4467 if (munmap ((POINTER_TYPE *) r, r->nbytes_mapped) == -1)
b86af064
GM
4468 {
4469 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4470 return 0;
4471 }
4472
4473 return 1;
4474}
4475
4476
4477/* Enlarge region R by NPAGES pages. NPAGES < 0 means shrink R.
4478 Value is non-zero if successful. */
4479
4480static int
4481mmap_enlarge (r, npages)
4482 struct mmap_region *r;
4483 int npages;
4484{
4485 char *region_end = (char *) r + r->nbytes_mapped;
4486 size_t nbytes;
4487 int success = 0;
4488
4489 if (npages < 0)
4490 {
4491 /* Unmap pages at the end of the region. */
4492 nbytes = - npages * mmap_page_size;
4493 if (munmap (region_end - nbytes, nbytes) == -1)
4494 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4495 else
4496 {
4497 r->nbytes_mapped -= nbytes;
4498 success = 1;
4499 }
4500 }
4501 else if (npages > 0)
4502 {
b86af064
GM
4503 nbytes = npages * mmap_page_size;
4504
4505 /* Try to map additional pages at the end of the region. We
4506 cannot do this if the address range is already occupied by
4507 something else because mmap deletes any previous mapping.
4508 I'm not sure this is worth doing, let's see. */
08327b22 4509 if (!MMAP_ALLOCATED_P (region_end, region_end + nbytes))
b86af064
GM
4510 {
4511 POINTER_TYPE *p;
4512
4513 p = mmap (region_end, nbytes, PROT_READ | PROT_WRITE,
4514 MAP_ANON | MAP_PRIVATE | MAP_FIXED, mmap_fd, 0);
4515 if (p == MAP_FAILED)
edaa9aed 4516 ; /* fprintf (stderr, "mmap: %s\n", emacs_strerror (errno)); */
b86af064
GM
4517 else if (p != (POINTER_TYPE *) region_end)
4518 {
4519 /* Kernels are free to choose a different address. In
4520 that case, unmap what we've mapped above; we have
4521 no use for it. */
4522 if (munmap (p, nbytes) == -1)
4523 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4524 }
4525 else
4526 {
4527 r->nbytes_mapped += nbytes;
4528 success = 1;
4529 }
4530 }
4531 }
4532
4533 return success;
4534}
4535
4536
4537/* Set or reset variables holding references to mapped regions. If
4538 RESTORE_P is zero, set all variables to null. If RESTORE_P is
4539 non-zero, set all variables to the start of the user-areas
4540 of mapped regions.
4541
4542 This function is called from Fdump_emacs to ensure that the dumped
4543 Emacs doesn't contain references to memory that won't be mapped
4544 when Emacs starts. */
4545
4546void
4547mmap_set_vars (restore_p)
4548 int restore_p;
4549{
4550 struct mmap_region *r;
4551
4552 if (restore_p)
4553 {
4554 mmap_regions = mmap_regions_1;
4555 mmap_fd = mmap_fd_1;
4556 for (r = mmap_regions; r; r = r->next)
4557 *r->var = MMAP_USER_AREA (r);
4558 }
4559 else
4560 {
4561 for (r = mmap_regions; r; r = r->next)
4562 *r->var = NULL;
4563 mmap_regions_1 = mmap_regions;
4564 mmap_regions = NULL;
4565 mmap_fd_1 = mmap_fd;
4566 mmap_fd = -1;
4567 }
4568}
4569
4570
4571/* Allocate a block of storage large enough to hold NBYTES bytes of
4572 data. A pointer to the data is returned in *VAR. VAR is thus the
4573 address of some variable which will use the data area.
4574
4575 The allocation of 0 bytes is valid.
4576
4577 If we can't allocate the necessary memory, set *VAR to null, and
4578 return null. */
4579
4580static POINTER_TYPE *
4581mmap_alloc (var, nbytes)
4582 POINTER_TYPE **var;
4583 size_t nbytes;
4584{
4585 void *p;
4586 size_t map;
4587
4588 mmap_init ();
4589
4590 map = ROUND (nbytes + MMAP_REGION_STRUCT_SIZE, mmap_page_size);
4591 p = mmap (NULL, map, PROT_READ | PROT_WRITE, MAP_ANON | MAP_PRIVATE,
4592 mmap_fd, 0);
4593
4594 if (p == MAP_FAILED)
4595 {
4596 if (errno != ENOMEM)
4597 fprintf (stderr, "mmap: %s\n", emacs_strerror (errno));
4598 p = NULL;
4599 }
4600 else
4601 {
4602 struct mmap_region *r = (struct mmap_region *) p;
4603
4604 r->nbytes_specified = nbytes;
4605 r->nbytes_mapped = map;
4606 r->var = var;
4607 r->prev = NULL;
4608 r->next = mmap_regions;
4609 if (r->next)
4610 r->next->prev = r;
4611 mmap_regions = r;
4612
4613 p = MMAP_USER_AREA (p);
4614 }
4615
4616 return *var = p;
4617}
4618
4619
4620/* Given a pointer at address VAR to data allocated with mmap_alloc,
4621 resize it to size NBYTES. Change *VAR to reflect the new block,
4622 and return this value. If more memory cannot be allocated, then
4623 leave *VAR unchanged, and return null. */
4624
4625static POINTER_TYPE *
4626mmap_realloc (var, nbytes)
4627 POINTER_TYPE **var;
4628 size_t nbytes;
4629{
4630 POINTER_TYPE *result;
4631
4632 mmap_init ();
4633
4634 if (*var == NULL)
4635 result = mmap_alloc (var, nbytes);
4636 else if (nbytes == 0)
4637 {
4638 mmap_free (var);
4639 result = mmap_alloc (var, nbytes);
4640 }
4641 else
4642 {
4643 struct mmap_region *r = MMAP_REGION (*var);
4644 size_t room = r->nbytes_mapped - MMAP_REGION_STRUCT_SIZE;
4645
4646 if (room < nbytes)
4647 {
4648 /* Must enlarge. */
4649 POINTER_TYPE *old_ptr = *var;
4650
4651 /* Try to map additional pages at the end of the region.
4652 If that fails, allocate a new region, copy data
4653 from the old region, then free it. */
4654 if (mmap_enlarge (r, (ROUND (nbytes - room, mmap_page_size)
4655 / mmap_page_size)))
4656 {
4657 r->nbytes_specified = nbytes;
4658 *var = result = old_ptr;
4659 }
4660 else if (mmap_alloc (var, nbytes))
4661 {
4662 bcopy (old_ptr, *var, r->nbytes_specified);
4663 mmap_free_1 (MMAP_REGION (old_ptr));
4664 result = *var;
4665 r = MMAP_REGION (result);
4666 r->nbytes_specified = nbytes;
4667 }
4668 else
4669 {
4670 *var = old_ptr;
4671 result = NULL;
4672 }
4673 }
4674 else if (room - nbytes >= mmap_page_size)
4675 {
4676 /* Shrinking by at least a page. Let's give some
4677 memory back to the system. */
4678 mmap_enlarge (r, - (room - nbytes) / mmap_page_size);
4679 result = *var;
4680 r->nbytes_specified = nbytes;
4681 }
4682 else
4683 {
4684 /* Leave it alone. */
4685 result = *var;
4686 r->nbytes_specified = nbytes;
4687 }
4688 }
4689
4690 return result;
4691}
4692
4693
4694/* Free a block of relocatable storage whose data is pointed to by
4695 PTR. Store 0 in *PTR to show there's no block allocated. */
4696
4697static void
4698mmap_free (var)
4699 POINTER_TYPE **var;
4700{
4701 mmap_init ();
4702
4703 if (*var)
4704 {
4705 mmap_free_1 (MMAP_REGION (*var));
4706 *var = NULL;
4707 }
4708}
4709
4710
4711/* Perform necessary intializations for the use of mmap. */
4712
4713static void
4714mmap_init ()
4715{
4716#if MAP_ANON == 0
4717 /* The value of mmap_fd is initially 0 in temacs, and -1
4718 in a dumped Emacs. */
4719 if (mmap_fd <= 0)
4720 {
4721 /* No anonymous mmap -- we need the file descriptor. */
4722 mmap_fd = open ("/dev/zero", O_RDONLY);
4723 if (mmap_fd == -1)
4724 fatal ("Cannot open /dev/zero: %s", emacs_strerror (errno));
4725 }
4726#endif /* MAP_ANON == 0 */
4727
4728 if (mmap_initialized_p)
4729 return;
4730 mmap_initialized_p = 1;
4731
4732#if MAP_ANON != 0
4733 mmap_fd = -1;
4734#endif
4735
4736 mmap_page_size = getpagesize ();
4737}
4738
4739#endif /* USE_MMAP_FOR_BUFFERS */
4740
4741
4742\f
4743/***********************************************************************
4744 Buffer-text Allocation
4745 ***********************************************************************/
4746
4747#ifdef REL_ALLOC
4748extern POINTER_TYPE *r_alloc P_ ((POINTER_TYPE **, size_t));
4749extern POINTER_TYPE *r_re_alloc P_ ((POINTER_TYPE **, size_t));
4750extern void r_alloc_free P_ ((POINTER_TYPE **ptr));
4751#endif /* REL_ALLOC */
4752
4753
4754/* Allocate NBYTES bytes for buffer B's text buffer. */
4755
4756static void
4757alloc_buffer_text (b, nbytes)
4758 struct buffer *b;
4759 size_t nbytes;
4760{
4761 POINTER_TYPE *p;
4762
4763 BLOCK_INPUT;
4764#if defined USE_MMAP_FOR_BUFFERS
4765 p = mmap_alloc ((POINTER_TYPE **) &b->text->beg, nbytes);
4766#elif defined REL_ALLOC
4767 p = r_alloc ((POINTER_TYPE **) &b->text->beg, nbytes);
4768#else
815add84 4769 p = xmalloc (nbytes);
b86af064
GM
4770#endif
4771
4772 if (p == NULL)
4773 {
4774 UNBLOCK_INPUT;
4775 memory_full ();
4776 }
4777
4778 b->text->beg = (unsigned char *) p;
4779 UNBLOCK_INPUT;
4780}
4781
4782/* Enlarge buffer B's text buffer by DELTA bytes. DELTA < 0 means
4783 shrink it. */
4784
4785void
4786enlarge_buffer_text (b, delta)
4787 struct buffer *b;
4788 int delta;
4789{
4790 POINTER_TYPE *p;
4791 size_t nbytes = (BUF_Z_BYTE (b) - BUF_BEG_BYTE (b) + BUF_GAP_SIZE (b) + 1
4792 + delta);
4793 BLOCK_INPUT;
4794#if defined USE_MMAP_FOR_BUFFERS
4795 p = mmap_realloc ((POINTER_TYPE **) &b->text->beg, nbytes);
4796#elif defined REL_ALLOC
4797 p = r_re_alloc ((POINTER_TYPE **) &b->text->beg, nbytes);
4798#else
4799 p = xrealloc (b->text->beg, nbytes);
4800#endif
4801
4802 if (p == NULL)
4803 {
4804 UNBLOCK_INPUT;
4805 memory_full ();
4806 }
4807
4808 BUF_BEG_ADDR (b) = (unsigned char *) p;
4809 UNBLOCK_INPUT;
4810}
4811
4812
4813/* Free buffer B's text buffer. */
4814
4815static void
4816free_buffer_text (b)
4817 struct buffer *b;
4818{
4819 BLOCK_INPUT;
4820
4821#if defined USE_MMAP_FOR_BUFFERS
4822 mmap_free ((POINTER_TYPE **) &b->text->beg);
4823#elif defined REL_ALLOC
4824 r_alloc_free ((POINTER_TYPE **) &b->text->beg);
4825#else
4826 xfree (b->text->beg);
4827#endif
4828
4829 BUF_BEG_ADDR (b) = NULL;
4830 UNBLOCK_INPUT;
4831}
4832
4833
4834\f
4835/***********************************************************************
4836 Initialization
4837 ***********************************************************************/
4838
dfcf069d 4839void
1ab256cb
RM
4840init_buffer_once ()
4841{
7c02e886
GM
4842 int idx;
4843
4844 bzero (buffer_permanent_local_flags, sizeof buffer_permanent_local_flags);
13de9290 4845
1ab256cb
RM
4846 /* Make sure all markable slots in buffer_defaults
4847 are initialized reasonably, so mark_buffer won't choke. */
4848 reset_buffer (&buffer_defaults);
13de9290 4849 reset_buffer_local_variables (&buffer_defaults, 1);
1ab256cb 4850 reset_buffer (&buffer_local_symbols);
13de9290 4851 reset_buffer_local_variables (&buffer_local_symbols, 1);
336cd056
RS
4852 /* Prevent GC from getting confused. */
4853 buffer_defaults.text = &buffer_defaults.own_text;
4854 buffer_local_symbols.text = &buffer_local_symbols.own_text;
336cd056
RS
4855 BUF_INTERVALS (&buffer_defaults) = 0;
4856 BUF_INTERVALS (&buffer_local_symbols) = 0;
67180c6a
KH
4857 XSETBUFFER (Vbuffer_defaults, &buffer_defaults);
4858 XSETBUFFER (Vbuffer_local_symbols, &buffer_local_symbols);
1ab256cb
RM
4859
4860 /* Set up the default values of various buffer slots. */
4861 /* Must do these before making the first buffer! */
4862
f532dca0 4863 /* real setup is done in bindings.el */
1ab256cb 4864 buffer_defaults.mode_line_format = build_string ("%-");
045dee35 4865 buffer_defaults.header_line_format = Qnil;
1ab256cb
RM
4866 buffer_defaults.abbrev_mode = Qnil;
4867 buffer_defaults.overwrite_mode = Qnil;
4868 buffer_defaults.case_fold_search = Qt;
4869 buffer_defaults.auto_fill_function = Qnil;
4870 buffer_defaults.selective_display = Qnil;
4871#ifndef old
4872 buffer_defaults.selective_display_ellipses = Qt;
4873#endif
4874 buffer_defaults.abbrev_table = Qnil;
4875 buffer_defaults.display_table = Qnil;
1ab256cb 4876 buffer_defaults.undo_list = Qnil;
c48f61ef 4877 buffer_defaults.mark_active = Qnil;
be9aafdd 4878 buffer_defaults.file_format = Qnil;
2eec3b4e
RS
4879 buffer_defaults.overlays_before = Qnil;
4880 buffer_defaults.overlays_after = Qnil;
bbbe9545 4881 XSETFASTINT (buffer_defaults.overlay_center, BEG);
1ab256cb 4882
8d7a4592 4883 XSETFASTINT (buffer_defaults.tab_width, 8);
1ab256cb
RM
4884 buffer_defaults.truncate_lines = Qnil;
4885 buffer_defaults.ctl_arrow = Qt;
3b06f880 4886 buffer_defaults.direction_reversed = Qnil;
bb2ec976 4887 buffer_defaults.cursor_type = Qt;
a3bbced0 4888 buffer_defaults.extra_line_spacing = Qnil;
1ab256cb 4889
f7975d07 4890#ifdef DOS_NT
0776cb1b 4891 buffer_defaults.buffer_file_type = Qnil; /* TEXT */
54ad07d3 4892#endif
a1a17b61 4893 buffer_defaults.enable_multibyte_characters = Qt;
c71b5d9b 4894 buffer_defaults.buffer_file_coding_system = Qnil;
8d7a4592
KH
4895 XSETFASTINT (buffer_defaults.fill_column, 70);
4896 XSETFASTINT (buffer_defaults.left_margin, 0);
28e969dd 4897 buffer_defaults.cache_long_line_scans = Qnil;
f6ed2e84 4898 buffer_defaults.file_truename = Qnil;
7962a441 4899 XSETFASTINT (buffer_defaults.display_count, 0);
0552666b
GM
4900 buffer_defaults.indicate_empty_lines = Qnil;
4901 buffer_defaults.scroll_up_aggressively = Qnil;
4902 buffer_defaults.scroll_down_aggressively = Qnil;
3fd364db 4903 buffer_defaults.display_time = Qnil;
1ab256cb
RM
4904
4905 /* Assign the local-flags to the slots that have default values.
4906 The local flag is a bit that is used in the buffer
4907 to say that it has its own local value for the slot.
4908 The local flag bits are in the local_var_flags slot of the buffer. */
4909
4910 /* Nothing can work if this isn't true */
4d2f1389 4911 if (sizeof (EMACS_INT) != sizeof (Lisp_Object)) abort ();
1ab256cb
RM
4912
4913 /* 0 means not a lisp var, -1 means always local, else mask */
4914 bzero (&buffer_local_flags, sizeof buffer_local_flags);
aab80822
KH
4915 XSETINT (buffer_local_flags.filename, -1);
4916 XSETINT (buffer_local_flags.directory, -1);
4917 XSETINT (buffer_local_flags.backed_up, -1);
4918 XSETINT (buffer_local_flags.save_length, -1);
4919 XSETINT (buffer_local_flags.auto_save_file_name, -1);
4920 XSETINT (buffer_local_flags.read_only, -1);
4921 XSETINT (buffer_local_flags.major_mode, -1);
4922 XSETINT (buffer_local_flags.mode_name, -1);
4923 XSETINT (buffer_local_flags.undo_list, -1);
4924 XSETINT (buffer_local_flags.mark_active, -1);
943e065b 4925 XSETINT (buffer_local_flags.point_before_scroll, -1);
f6ed2e84 4926 XSETINT (buffer_local_flags.file_truename, -1);
3cb719bd 4927 XSETINT (buffer_local_flags.invisibility_spec, -1);
55ac8536 4928 XSETINT (buffer_local_flags.file_format, -1);
7962a441 4929 XSETINT (buffer_local_flags.display_count, -1);
3fd364db 4930 XSETINT (buffer_local_flags.display_time, -1);
1bf08baf 4931 XSETINT (buffer_local_flags.enable_multibyte_characters, -1);
8d7a4592 4932
7c02e886
GM
4933 idx = 1;
4934 XSETFASTINT (buffer_local_flags.mode_line_format, idx); ++idx;
4935 XSETFASTINT (buffer_local_flags.abbrev_mode, idx); ++idx;
4936 XSETFASTINT (buffer_local_flags.overwrite_mode, idx); ++idx;
4937 XSETFASTINT (buffer_local_flags.case_fold_search, idx); ++idx;
4938 XSETFASTINT (buffer_local_flags.auto_fill_function, idx); ++idx;
4939 XSETFASTINT (buffer_local_flags.selective_display, idx); ++idx;
1ab256cb 4940#ifndef old
7c02e886 4941 XSETFASTINT (buffer_local_flags.selective_display_ellipses, idx); ++idx;
1ab256cb 4942#endif
7c02e886
GM
4943 XSETFASTINT (buffer_local_flags.tab_width, idx); ++idx;
4944 XSETFASTINT (buffer_local_flags.truncate_lines, idx); ++idx;
4945 XSETFASTINT (buffer_local_flags.ctl_arrow, idx); ++idx;
4946 XSETFASTINT (buffer_local_flags.fill_column, idx); ++idx;
4947 XSETFASTINT (buffer_local_flags.left_margin, idx); ++idx;
4948 XSETFASTINT (buffer_local_flags.abbrev_table, idx); ++idx;
4949 XSETFASTINT (buffer_local_flags.display_table, idx); ++idx;
f7975d07 4950#ifdef DOS_NT
7c02e886 4951 XSETFASTINT (buffer_local_flags.buffer_file_type, idx);
13de9290 4952 /* Make this one a permanent local. */
7c02e886 4953 buffer_permanent_local_flags[idx++] = 1;
54ad07d3 4954#endif
7c02e886
GM
4955 XSETFASTINT (buffer_local_flags.syntax_table, idx); ++idx;
4956 XSETFASTINT (buffer_local_flags.cache_long_line_scans, idx); ++idx;
4957 XSETFASTINT (buffer_local_flags.category_table, idx); ++idx;
4958 XSETFASTINT (buffer_local_flags.direction_reversed, idx); ++idx;
4959 XSETFASTINT (buffer_local_flags.buffer_file_coding_system, idx);
a1a17b61 4960 /* Make this one a permanent local. */
7c02e886
GM
4961 buffer_permanent_local_flags[idx++] = 1;
4962 XSETFASTINT (buffer_local_flags.left_margin_width, idx); ++idx;
4963 XSETFASTINT (buffer_local_flags.right_margin_width, idx); ++idx;
4964 XSETFASTINT (buffer_local_flags.indicate_empty_lines, idx); ++idx;
4965 XSETFASTINT (buffer_local_flags.scroll_up_aggressively, idx); ++idx;
4966 XSETFASTINT (buffer_local_flags.scroll_down_aggressively, idx); ++idx;
4967 XSETFASTINT (buffer_local_flags.header_line_format, idx); ++idx;
bd96bd79 4968 XSETFASTINT (buffer_local_flags.cursor_type, idx); ++idx;
a3bbced0 4969 XSETFASTINT (buffer_local_flags.extra_line_spacing, idx); ++idx;
7c02e886
GM
4970
4971 /* Need more room? */
7313acd0 4972 if (idx >= MAX_PER_BUFFER_VARS)
7c02e886 4973 abort ();
7313acd0 4974 last_per_buffer_idx = idx;
c71b5d9b 4975
1ab256cb
RM
4976 Vbuffer_alist = Qnil;
4977 current_buffer = 0;
4978 all_buffers = 0;
4979
4980 QSFundamental = build_string ("Fundamental");
4981
4982 Qfundamental_mode = intern ("fundamental-mode");
4983 buffer_defaults.major_mode = Qfundamental_mode;
4984
4985 Qmode_class = intern ("mode-class");
4986
4987 Qprotected_field = intern ("protected-field");
4988
4989 Qpermanent_local = intern ("permanent-local");
4990
4991 Qkill_buffer_hook = intern ("kill-buffer-hook");
4992
4993 Vprin1_to_string_buffer = Fget_buffer_create (build_string (" prin1"));
000f8083 4994
1ab256cb
RM
4995 /* super-magic invisible buffer */
4996 Vbuffer_alist = Qnil;
4997
ffd56f97 4998 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
7775635d
KH
4999
5000 inhibit_modification_hooks = 0;
1ab256cb
RM
5001}
5002
dfcf069d 5003void
1ab256cb
RM
5004init_buffer ()
5005{
93c27ef1 5006 char buf[MAXPATHLEN + 1];
2381d133
JB
5007 char *pwd;
5008 struct stat dotstat, pwdstat;
136351b7 5009 Lisp_Object temp;
f7975d07 5010 int rc;
1ab256cb 5011
b86af064 5012#ifdef USE_MMAP_FOR_BUFFERS
93c27ef1
GM
5013 {
5014 /* When using the ralloc implementation based on mmap(2), buffer
5015 text pointers will have been set to null in the dumped Emacs.
5016 Map new memory. */
5017 struct buffer *b;
5018
93c27ef1
GM
5019 for (b = all_buffers; b; b = b->next)
5020 if (b->text->beg == NULL)
b86af064 5021 enlarge_buffer_text (b, 0);
93c27ef1 5022 }
b86af064 5023#endif /* USE_MMAP_FOR_BUFFERS */
93c27ef1 5024
1ab256cb 5025 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
3d871c85
RS
5026 if (NILP (buffer_defaults.enable_multibyte_characters))
5027 Fset_buffer_multibyte (Qnil);
2381d133 5028
314dbe9a
PE
5029 /* If PWD is accurate, use it instead of calling getwd. PWD is
5030 sometimes a nicer name, and using it may avoid a fatal error if a
5031 parent directory is searchable but not readable. */
309f2a6e
RS
5032 if ((pwd = getenv ("PWD")) != 0
5033 && (IS_DIRECTORY_SEP (*pwd) || (*pwd && IS_DEVICE_SEP (pwd[1])))
2381d133
JB
5034 && stat (pwd, &pwdstat) == 0
5035 && stat (".", &dotstat) == 0
5036 && dotstat.st_ino == pwdstat.st_ino
5037 && dotstat.st_dev == pwdstat.st_dev
5038 && strlen (pwd) < MAXPATHLEN)
5039 strcpy (buf, pwd);
6335beb0
RS
5040#ifdef HAVE_GETCWD
5041 else if (getcwd (buf, MAXPATHLEN+1) == 0)
9dde47f5 5042 fatal ("`getcwd' failed: %s\n", strerror (errno));
6335beb0 5043#else
2381d133 5044 else if (getwd (buf) == 0)
cf1e6391 5045 fatal ("`getwd' failed: %s\n", buf);
6335beb0 5046#endif
1ab256cb
RM
5047
5048#ifndef VMS
5049 /* Maybe this should really use some standard subroutine
5050 whose definition is filename syntax dependent. */
f7975d07
RS
5051 rc = strlen (buf);
5052 if (!(IS_DIRECTORY_SEP (buf[rc - 1])))
5053 {
5054 buf[rc] = DIRECTORY_SEP;
5055 buf[rc + 1] = '\0';
5056 }
1ab256cb 5057#endif /* not VMS */
0995fa35 5058
1ab256cb 5059 current_buffer->directory = build_string (buf);
136351b7 5060
0995fa35
RS
5061 /* Add /: to the front of the name
5062 if it would otherwise be treated as magic. */
5063 temp = Ffind_file_name_handler (current_buffer->directory, Qt);
81ab2e07
KH
5064 if (! NILP (temp)
5065 /* If the default dir is just /, TEMP is non-nil
5066 because of the ange-ftp completion handler.
5067 However, it is not necessary to turn / into /:/.
5068 So avoid doing that. */
d5db4077 5069 && strcmp ("/", SDATA (current_buffer->directory)))
0995fa35
RS
5070 current_buffer->directory
5071 = concat2 (build_string ("/:"), current_buffer->directory);
5072
136351b7
RS
5073 temp = get_minibuffer (0);
5074 XBUFFER (temp)->directory = current_buffer->directory;
1ab256cb
RM
5075}
5076
5077/* initialize the buffer routines */
dfcf069d 5078void
1ab256cb
RM
5079syms_of_buffer ()
5080{
9115729e
KH
5081 staticpro (&last_overlay_modification_hooks);
5082 last_overlay_modification_hooks
5083 = Fmake_vector (make_number (10), Qnil);
5084
1ab256cb
RM
5085 staticpro (&Vbuffer_defaults);
5086 staticpro (&Vbuffer_local_symbols);
5087 staticpro (&Qfundamental_mode);
5088 staticpro (&Qmode_class);
5089 staticpro (&QSFundamental);
5090 staticpro (&Vbuffer_alist);
5091 staticpro (&Qprotected_field);
5092 staticpro (&Qpermanent_local);
5093 staticpro (&Qkill_buffer_hook);
22378665 5094 Qoverlayp = intern ("overlayp");
52f8ec73 5095 staticpro (&Qoverlayp);
9d7608b7
KH
5096 Qevaporate = intern ("evaporate");
5097 staticpro (&Qevaporate);
294d215f 5098 Qmodification_hooks = intern ("modification-hooks");
22378665 5099 staticpro (&Qmodification_hooks);
294d215f 5100 Qinsert_in_front_hooks = intern ("insert-in-front-hooks");
22378665 5101 staticpro (&Qinsert_in_front_hooks);
294d215f 5102 Qinsert_behind_hooks = intern ("insert-behind-hooks");
22378665 5103 staticpro (&Qinsert_behind_hooks);
5fe0b67e 5104 Qget_file_buffer = intern ("get-file-buffer");
22378665 5105 staticpro (&Qget_file_buffer);
5985d248
KH
5106 Qpriority = intern ("priority");
5107 staticpro (&Qpriority);
5108 Qwindow = intern ("window");
5109 staticpro (&Qwindow);
bbbe9545
KH
5110 Qbefore_string = intern ("before-string");
5111 staticpro (&Qbefore_string);
5112 Qafter_string = intern ("after-string");
5113 staticpro (&Qafter_string);
22378665
RS
5114 Qfirst_change_hook = intern ("first-change-hook");
5115 staticpro (&Qfirst_change_hook);
5116 Qbefore_change_functions = intern ("before-change-functions");
5117 staticpro (&Qbefore_change_functions);
5118 Qafter_change_functions = intern ("after-change-functions");
5119 staticpro (&Qafter_change_functions);
1ab256cb
RM
5120
5121 Fput (Qprotected_field, Qerror_conditions,
5122 Fcons (Qprotected_field, Fcons (Qerror, Qnil)));
5123 Fput (Qprotected_field, Qerror_message,
5124 build_string ("Attempt to modify a protected field"));
5125
5126 /* All these use DEFVAR_LISP_NOPRO because the slots in
5127 buffer_defaults will all be marked via Vbuffer_defaults. */
5128
5129 DEFVAR_LISP_NOPRO ("default-mode-line-format",
7ee72033
MB
5130 &buffer_defaults.mode_line_format,
5131 doc: /* Default value of `mode-line-format' for buffers that don't override it.
018ba359 5132This is the same as (default-value 'mode-line-format). */);
1ab256cb 5133
045dee35 5134 DEFVAR_LISP_NOPRO ("default-header-line-format",
7ee72033
MB
5135 &buffer_defaults.header_line_format,
5136 doc: /* Default value of `header-line-format' for buffers that don't override it.
018ba359 5137This is the same as (default-value 'header-line-format). */);
0552666b 5138
7ee72033
MB
5139 DEFVAR_LISP_NOPRO ("default-cursor-type", &buffer_defaults.cursor_type,
5140 doc: /* Default value of `cursor-type' for buffers that don't override it.
018ba359 5141This is the same as (default-value 'cursor-type). */);
bd96bd79 5142
a3bbced0 5143 DEFVAR_LISP_NOPRO ("default-line-spacing",
7ee72033
MB
5144 &buffer_defaults.extra_line_spacing,
5145 doc: /* Default value of `line-spacing' for buffers that don't override it.
018ba359 5146This is the same as (default-value 'line-spacing). */);
a3bbced0 5147
1ab256cb 5148 DEFVAR_LISP_NOPRO ("default-abbrev-mode",
efc7e75f 5149 &buffer_defaults.abbrev_mode,
7ee72033 5150 doc: /* Default value of `abbrev-mode' for buffers that do not override it.
018ba359 5151This is the same as (default-value 'abbrev-mode). */);
1ab256cb
RM
5152
5153 DEFVAR_LISP_NOPRO ("default-ctl-arrow",
efc7e75f 5154 &buffer_defaults.ctl_arrow,
7ee72033 5155 doc: /* Default value of `ctl-arrow' for buffers that do not override it.
018ba359 5156This is the same as (default-value 'ctl-arrow). */);
1ab256cb 5157
3b06f880 5158 DEFVAR_LISP_NOPRO ("default-direction-reversed",
efc7e75f 5159 &buffer_defaults.direction_reversed,
7ee72033 5160 doc: /* Default value of `direction_reversed' for buffers that do not override it.
018ba359 5161This is the same as (default-value 'direction-reversed). */);
3b06f880 5162
a1a17b61 5163 DEFVAR_LISP_NOPRO ("default-enable-multibyte-characters",
efc7e75f 5164 &buffer_defaults.enable_multibyte_characters,
7ee72033 5165 doc: /* *Default value of `enable-multibyte-characters' for buffers not overriding it.
018ba359 5166This is the same as (default-value 'enable-multibyte-characters). */);
a1a17b61 5167
c71b5d9b 5168 DEFVAR_LISP_NOPRO ("default-buffer-file-coding-system",
efc7e75f 5169 &buffer_defaults.buffer_file_coding_system,
7ee72033 5170 doc: /* Default value of `buffer-file-coding-system' for buffers not overriding it.
018ba359 5171This is the same as (default-value 'buffer-file-coding-system). */);
c71b5d9b 5172
1ab256cb 5173 DEFVAR_LISP_NOPRO ("default-truncate-lines",
efc7e75f
PJ
5174 &buffer_defaults.truncate_lines,
5175 doc: /* Default value of `truncate-lines' for buffers that do not override it.
018ba359 5176This is the same as (default-value 'truncate-lines). */);
1ab256cb
RM
5177
5178 DEFVAR_LISP_NOPRO ("default-fill-column",
efc7e75f
PJ
5179 &buffer_defaults.fill_column,
5180 doc: /* Default value of `fill-column' for buffers that do not override it.
018ba359 5181This is the same as (default-value 'fill-column). */);
1ab256cb
RM
5182
5183 DEFVAR_LISP_NOPRO ("default-left-margin",
efc7e75f
PJ
5184 &buffer_defaults.left_margin,
5185 doc: /* Default value of `left-margin' for buffers that do not override it.
018ba359 5186This is the same as (default-value 'left-margin). */);
1ab256cb
RM
5187
5188 DEFVAR_LISP_NOPRO ("default-tab-width",
7ee72033
MB
5189 &buffer_defaults.tab_width,
5190 doc: /* Default value of `tab-width' for buffers that do not override it.
018ba359 5191This is the same as (default-value 'tab-width). */);
1ab256cb
RM
5192
5193 DEFVAR_LISP_NOPRO ("default-case-fold-search",
efc7e75f
PJ
5194 &buffer_defaults.case_fold_search,
5195 doc: /* Default value of `case-fold-search' for buffers that don't override it.
018ba359 5196This is the same as (default-value 'case-fold-search). */);
1ab256cb 5197
f7975d07 5198#ifdef DOS_NT
54ad07d3 5199 DEFVAR_LISP_NOPRO ("default-buffer-file-type",
7ee72033 5200 &buffer_defaults.buffer_file_type,
efc7e75f 5201 doc: /* Default file type for buffers that do not override it.
018ba359
PJ
5202This is the same as (default-value 'buffer-file-type).
5203The file type is nil for text, t for binary. */);
54ad07d3
RS
5204#endif
5205
0552666b 5206 DEFVAR_LISP_NOPRO ("default-left-margin-width",
efc7e75f
PJ
5207 &buffer_defaults.left_margin_width,
5208 doc: /* Default value of `left-margin-width' for buffers that don't override it.
018ba359 5209This is the same as (default-value 'left-margin-width). */);
0552666b
GM
5210
5211 DEFVAR_LISP_NOPRO ("default-right-margin-width",
efc7e75f
PJ
5212 &buffer_defaults.right_margin_width,
5213 doc: /* Default value of `right_margin_width' for buffers that don't override it.
018ba359 5214This is the same as (default-value 'right-margin-width). */);
0552666b
GM
5215
5216 DEFVAR_LISP_NOPRO ("default-indicate-empty-lines",
efc7e75f
PJ
5217 &buffer_defaults.indicate_empty_lines,
5218 doc: /* Default value of `indicate-empty-lines' for buffers that don't override it.
018ba359 5219This is the same as (default-value 'indicate-empty-lines). */);
0552666b
GM
5220
5221 DEFVAR_LISP_NOPRO ("default-scroll-up-aggressively",
efc7e75f 5222 &buffer_defaults.scroll_up_aggressively,
7614d762
RS
5223 doc: /* Default value of `scroll-up-aggressively'.
5224This value applies in buffers that don't have their own local values.
5225This variable is an alias for (default-value 'scroll-up-aggressively). */);
0552666b
GM
5226
5227 DEFVAR_LISP_NOPRO ("default-scroll-down-aggressively",
efc7e75f 5228 &buffer_defaults.scroll_down_aggressively,
7614d762
RS
5229 doc: /* Default value of `scroll-down-aggressively'.
5230This value applies in buffers that don't have their own local values.
5231This variable is an alias for (default-value 'scroll-down-aggressively). */);
0552666b 5232
045dee35 5233 DEFVAR_PER_BUFFER ("header-line-format",
018ba359 5234 &current_buffer->header_line_format,
7ee72033 5235 Qnil,
7614d762
RS
5236 doc: /* Analogous to `mode-line-format', but controls the header line.
5237The header line appears, optionally, at the top of a window;
5238the mode line appears at the bottom. */);
0552666b 5239
1ab256cb 5240 DEFVAR_PER_BUFFER ("mode-line-format", &current_buffer->mode_line_format,
efc7e75f
PJ
5241 Qnil,
5242 doc: /* Template for displaying mode line for current buffer.
018ba359
PJ
5243Each buffer has its own value of this variable.
5244Value may be nil, a string, a symbol or a list or cons cell.
5245A value of nil means don't display a mode line.
5246For a symbol, its value is used (but it is ignored if t or nil).
5247 A string appearing directly as the value of a symbol is processed verbatim
5248 in that the %-constructs below are not recognized.
5249For a list of the form `(:eval FORM)', FORM is evaluated and the result
5250 is used as a mode line element.
5251For a list whose car is a symbol, the symbol's value is taken,
5252 and if that is non-nil, the cadr of the list is processed recursively.
5253 Otherwise, the caddr of the list (if there is one) is processed.
5254For a list whose car is a string or list, each element is processed
5255 recursively and the results are effectively concatenated.
5256For a list whose car is an integer, the cdr of the list is processed
5257 and padded (if the number is positive) or truncated (if negative)
5258 to the width specified by that number.
5259A string is printed verbatim in the mode line except for %-constructs:
5260 (%-constructs are allowed when the string is the entire mode-line-format
5261 or when it is found in a cons-cell or a list)
5262 %b -- print buffer name. %f -- print visited file name.
5263 %F -- print frame name.
5264 %* -- print %, * or hyphen. %+ -- print *, % or hyphen.
5265 %& is like %*, but ignore read-only-ness.
5266 % means buffer is read-only and * means it is modified.
5267 For a modified read-only buffer, %* gives % and %+ gives *.
5268 %s -- print process status. %l -- print the current line number.
5269 %c -- print the current column number (this makes editing slower).
5270 To make the column number update correctly in all cases,
5271 `column-number-mode' must be non-nil.
5272 %p -- print percent of buffer above top of window, or Top, Bot or All.
5273 %P -- print percent of buffer above bottom of window, perhaps plus Top,
5274 or print Bottom or All.
5275 %m -- print the mode name.
5276 %n -- print Narrow if appropriate.
5277 %z -- print mnemonics of buffer, terminal, and keyboard coding systems.
5278 %Z -- like %z, but including the end-of-line format.
5279 %[ -- print one [ for each recursive editing level. %] similar.
5280 %% -- print %. %- -- print infinitely many dashes.
5281Decimal digits after the % specify field width to which to pad. */);
5282
7ee72033 5283 DEFVAR_LISP_NOPRO ("default-major-mode", &buffer_defaults.major_mode,
efc7e75f 5284 doc: /* *Major mode for new buffers. Defaults to `fundamental-mode'.
018ba359 5285nil here means use current buffer's major mode. */);
1ab256cb
RM
5286
5287 DEFVAR_PER_BUFFER ("major-mode", &current_buffer->major_mode,
7ee72033 5288 make_number (Lisp_Symbol),
efc7e75f 5289 doc: /* Symbol for current buffer's major mode. */);
1ab256cb
RM
5290
5291 DEFVAR_PER_BUFFER ("mode-name", &current_buffer->mode_name,
c01d0677 5292 Qnil,
efc7e75f 5293 doc: /* Pretty name of current buffer's major mode (a string). */);
1ab256cb 5294
7ee72033 5295 DEFVAR_PER_BUFFER ("abbrev-mode", &current_buffer->abbrev_mode, Qnil,
efc7e75f 5296 doc: /* Non-nil turns on automatic expansion of abbrevs as they are inserted. */);
1ab256cb
RM
5297
5298 DEFVAR_PER_BUFFER ("case-fold-search", &current_buffer->case_fold_search,
7ee72033 5299 Qnil,
efc7e75f 5300 doc: /* *Non-nil if searches and matches should ignore case. */);
1ab256cb
RM
5301
5302 DEFVAR_PER_BUFFER ("fill-column", &current_buffer->fill_column,
7ee72033 5303 make_number (Lisp_Int),
efc7e75f 5304 doc: /* *Column beyond which automatic line-wrapping should happen. */);
1ab256cb
RM
5305
5306 DEFVAR_PER_BUFFER ("left-margin", &current_buffer->left_margin,
7ee72033 5307 make_number (Lisp_Int),
efc7e75f 5308 doc: /* *Column for the default indent-line-function to indent to.
018ba359 5309Linefeed indents to this column in Fundamental mode. */);
1ab256cb
RM
5310
5311 DEFVAR_PER_BUFFER ("tab-width", &current_buffer->tab_width,
7ee72033 5312 make_number (Lisp_Int),
efc7e75f 5313 doc: /* *Distance between tab stops (for display of tab characters), in columns. */);
1ab256cb 5314
7ee72033 5315 DEFVAR_PER_BUFFER ("ctl-arrow", &current_buffer->ctl_arrow, Qnil,
efc7e75f 5316 doc: /* *Non-nil means display control chars with uparrow.
018ba359
PJ
5317A value of nil means use backslash and octal digits.
5318This variable does not apply to characters whose display is specified
5319in the current display table (if there is one). */);
1ab256cb 5320
3b06f880 5321 DEFVAR_PER_BUFFER ("enable-multibyte-characters",
1bf08baf 5322 &current_buffer->enable_multibyte_characters,
7ee72033 5323 make_number (-1),
efc7e75f 5324 doc: /* Non-nil means the buffer contents are regarded as multi-byte characters.
018ba359
PJ
5325Otherwise they are regarded as unibyte. This affects the display,
5326file I/O and the behavior of various editing commands.
5327
5328This variable is buffer-local but you cannot set it directly;
5329use the function `set-buffer-multibyte' to change a buffer's representation.
5330Changing its default value with `setq-default' is supported.
5331See also variable `default-enable-multibyte-characters' and Info node
5332`(elisp)Text Representations'. */);
3b06f880 5333
c71b5d9b 5334 DEFVAR_PER_BUFFER ("buffer-file-coding-system",
7ee72033 5335 &current_buffer->buffer_file_coding_system, Qnil,
efc7e75f 5336 doc: /* Coding system to be used for encoding the buffer contents on saving.
018ba359
PJ
5337This variable applies to saving the buffer, and also to `write-region'
5338and other functions that use `write-region'.
5339It does not apply to sending output to subprocesses, however.
5340
5341If this is nil, the buffer is saved without any code conversion
5342unless some coding system is specified in `file-coding-system-alist'
5343for the buffer file.
5344
31a6cb06
EZ
5345If the text to be saved cannot be encoded as specified by this variable,
5346an alternative encoding is selected by `select-safe-coding-system', which see.
5347
018ba359
PJ
5348The variable `coding-system-for-write', if non-nil, overrides this variable.
5349
5350This variable is never applied to a way of decoding a file while reading it. */);
c71b5d9b 5351
3b06f880 5352 DEFVAR_PER_BUFFER ("direction-reversed", &current_buffer->direction_reversed,
7ee72033 5353 Qnil,
efc7e75f 5354 doc: /* *Non-nil means lines in the buffer are displayed right to left. */);
3b06f880 5355
7ee72033 5356 DEFVAR_PER_BUFFER ("truncate-lines", &current_buffer->truncate_lines, Qnil,
7614d762
RS
5357 doc: /* *Non-nil means do not display continuation lines.
5358Instead, give each line of text just one screen line.
018ba359
PJ
5359
5360Note that this is overridden by the variable
5361`truncate-partial-width-windows' if that variable is non-nil
5362and this buffer is not full-frame width. */);
1ab256cb 5363
f7975d07 5364#ifdef DOS_NT
54ad07d3 5365 DEFVAR_PER_BUFFER ("buffer-file-type", &current_buffer->buffer_file_type,
7ee72033 5366 Qnil,
efc7e75f 5367 doc: /* Non-nil if the visited file is a binary file.
018ba359
PJ
5368This variable is meaningful on MS-DOG and Windows NT.
5369On those systems, it is automatically local in every buffer.
5370On other systems, this variable is normally always nil. */);
54ad07d3
RS
5371#endif
5372
1ab256cb 5373 DEFVAR_PER_BUFFER ("default-directory", &current_buffer->directory,
7ee72033 5374 make_number (Lisp_String),
efc7e75f 5375 doc: /* Name of default directory of current buffer. Should end with slash.
018ba359 5376To interactively change the default directory, use command `cd'. */);
1ab256cb
RM
5377
5378 DEFVAR_PER_BUFFER ("auto-fill-function", &current_buffer->auto_fill_function,
7ee72033 5379 Qnil,
efc7e75f 5380 doc: /* Function called (if non-nil) to perform auto-fill.
018ba359
PJ
5381It is called after self-inserting any character specified in
5382the `auto-fill-chars' table.
5383NOTE: This variable is not a hook;
5384its value may not be a list of functions. */);
1ab256cb
RM
5385
5386 DEFVAR_PER_BUFFER ("buffer-file-name", &current_buffer->filename,
7ee72033 5387 make_number (Lisp_String),
efc7e75f 5388 doc: /* Name of file visited in current buffer, or nil if not visiting a file. */);
1ab256cb 5389
f6ed2e84 5390 DEFVAR_PER_BUFFER ("buffer-file-truename", &current_buffer->file_truename,
7ee72033 5391 make_number (Lisp_String),
efc7e75f 5392 doc: /* Abbreviated truename of file visited in current buffer, or nil if none.
018ba359
PJ
5393The truename of a file is calculated by `file-truename'
5394and then abbreviated with `abbreviate-file-name'. */);
f6ed2e84 5395
1ab256cb 5396 DEFVAR_PER_BUFFER ("buffer-auto-save-file-name",
3f5fcd47 5397 &current_buffer->auto_save_file_name,
7ee72033 5398 make_number (Lisp_String),
7614d762
RS
5399 doc: /* Name of file for auto-saving current buffer.
5400If it is nil, that means don't auto-save this buffer. */);
1ab256cb 5401
7ee72033 5402 DEFVAR_PER_BUFFER ("buffer-read-only", &current_buffer->read_only, Qnil,
efc7e75f 5403 doc: /* Non-nil if this buffer is read-only. */);
1ab256cb 5404
7ee72033 5405 DEFVAR_PER_BUFFER ("buffer-backed-up", &current_buffer->backed_up, Qnil,
efc7e75f 5406 doc: /* Non-nil if this buffer's file has been backed up.
018ba359 5407Backing up is done before the first time the file is saved. */);
1ab256cb
RM
5408
5409 DEFVAR_PER_BUFFER ("buffer-saved-size", &current_buffer->save_length,
7ee72033 5410 make_number (Lisp_Int),
efc7e75f 5411 doc: /* Length of current buffer when last read in, saved or auto-saved.
018ba359 54120 initially. */);
1ab256cb
RM
5413
5414 DEFVAR_PER_BUFFER ("selective-display", &current_buffer->selective_display,
7ee72033 5415 Qnil,
7614d762
RS
5416 doc: /* Non-nil enables selective display.
5417An Integer N as value means display only lines
5418that start with less than n columns of space.
5419A value of t means that the character ^M makes itself and
5420all the rest of the line invisible; also, when saving the buffer
5421in a file, save the ^M as a newline. */);
1ab256cb
RM
5422
5423#ifndef old
5424 DEFVAR_PER_BUFFER ("selective-display-ellipses",
5425 &current_buffer->selective_display_ellipses,
7ee72033 5426 Qnil,
3f676284 5427 doc: /* Non-nil means display ... on previous line when a line is invisible. */);
1ab256cb
RM
5428#endif
5429
7ee72033 5430 DEFVAR_PER_BUFFER ("overwrite-mode", &current_buffer->overwrite_mode, Qnil,
efc7e75f 5431 doc: /* Non-nil if self-insertion should replace existing text.
018ba359
PJ
5432The value should be one of `overwrite-mode-textual',
5433`overwrite-mode-binary', or nil.
5434If it is `overwrite-mode-textual', self-insertion still
5435inserts at the end of a line, and inserts when point is before a tab,
5436until the tab is filled in.
5437If `overwrite-mode-binary', self-insertion replaces newlines and tabs too. */);
5438
54939090 5439 DEFVAR_PER_BUFFER ("buffer-display-table", &current_buffer->display_table,
7ee72033 5440 Qnil,
efc7e75f 5441 doc: /* Display table that controls display of the contents of current buffer.
018ba359
PJ
5442
5443If this variable is nil, the value of `standard-display-table' is used.
5444Each window can have its own, overriding display table, see
5445`set-window-display-table' and `window-display-table'.
5446
5447The display table is a char-table created with `make-display-table'.
5448A char-table is an array indexed by character codes. Normal array
5449primitives `aref' and `aset' can be used to access elements of a char-table.
5450
5451Each of the char-table elements control how to display the corresponding
5452text character: the element at index C in the table says how to display
5453the character whose code is C. Each element should be a vector of
5454characters or nil. nil means display the character in the default fashion;
5455otherwise, the characters from the vector are delivered to the screen
5456instead of the original character.
5457
5458For example, (aset buffer-display-table ?X ?Y) will cause Emacs to display
5459a capital Y instead of each X character.
5460
5461In addition, a char-table has six extra slots to control the display of:
5462
5463 the end of a truncated screen line (extra-slot 0, a single character);
5464 the end of a continued line (extra-slot 1, a single character);
5465 the escape character used to display character codes in octal
5466 (extra-slot 2, a single character);
5467 the character used as an arrow for control characters (extra-slot 3,
5468 a single character);
5469 the decoration indicating the presence of invisible lines (extra-slot 4,
5470 a vector of characters);
5471 the character used to draw the border between side-by-side windows
5472 (extra-slot 5, a single character).
5473
5474See also the functions `display-table-slot' and `set-display-table-slot'. */);
1ab256cb 5475
0552666b 5476 DEFVAR_PER_BUFFER ("left-margin-width", &current_buffer->left_margin_width,
7ee72033 5477 Qnil,
efc7e75f 5478 doc: /* *Width of left marginal area for display of a buffer.
018ba359 5479A value of nil means no marginal area. */);
0552666b
GM
5480
5481 DEFVAR_PER_BUFFER ("right-margin-width", &current_buffer->right_margin_width,
7ee72033 5482 Qnil,
efc7e75f 5483 doc: /* *Width of right marginal area for display of a buffer.
018ba359 5484A value of nil means no marginal area. */);
0552666b
GM
5485
5486 DEFVAR_PER_BUFFER ("indicate-empty-lines",
7ee72033 5487 &current_buffer->indicate_empty_lines, Qnil,
efc7e75f 5488 doc: /* *Visually indicate empty lines after the buffer end.
018ba359
PJ
5489If non-nil, a bitmap is displayed in the left fringe of a window on
5490window-systems. */);
0552666b
GM
5491
5492 DEFVAR_PER_BUFFER ("scroll-up-aggressively",
7ee72033 5493 &current_buffer->scroll_up_aggressively, Qnil,
efc7e75f 5494 doc: /* *If a number, scroll display up aggressively.
6524d955 5495If scrolling a window because point is below the window end, choose
018ba359 5496a new window start so that point ends up that fraction of the window's
6524d955 5497height from the bottom of the window. */);
0552666b
GM
5498
5499 DEFVAR_PER_BUFFER ("scroll-down-aggressively",
7ee72033 5500 &current_buffer->scroll_down_aggressively, Qnil,
efc7e75f 5501 doc: /* *If a number, scroll display down aggressively.
6524d955 5502If scrolling a window because point is above the window start, choose
018ba359 5503a new window start so that point ends up that fraction of the window's
6524d955 5504height from the top of the window. */);
0552666b 5505
1ab256cb
RM
5506/*DEFVAR_LISP ("debug-check-symbol", &Vcheck_symbol,
5507 "Don't ask.");
5508*/
1ab256cb 5509
7ee72033
MB
5510 DEFVAR_LISP ("before-change-functions", &Vbefore_change_functions,
5511 doc: /* List of functions to call before each text change.
018ba359
PJ
5512Two arguments are passed to each function: the positions of
5513the beginning and end of the range of old text to be changed.
5514\(For an insertion, the beginning and end are at the same place.)
5515No information is given about the length of the text after the change.
5516
5517Buffer changes made while executing the `before-change-functions'
5518don't call any before-change or after-change functions.
5519That's because these variables are temporarily set to nil.
5520As a result, a hook function cannot straightforwardly alter the value of
5521these variables. See the Emacs Lisp manual for a way of
5522accomplishing an equivalent result by using other variables.
5523
5524If an unhandled error happens in running these functions,
5525the variable's value remains nil. That prevents the error
5526from happening repeatedly and making Emacs nonfunctional. */);
5f079267
RS
5527 Vbefore_change_functions = Qnil;
5528
7ee72033 5529 DEFVAR_LISP ("after-change-functions", &Vafter_change_functions,
eacdfade 5530 doc: /* List of functions to call after each text change.
018ba359
PJ
5531Three arguments are passed to each function: the positions of
5532the beginning and end of the range of changed text,
5533and the length in bytes of the pre-change text replaced by that range.
5534\(For an insertion, the pre-change length is zero;
5535for a deletion, that length is the number of bytes deleted,
5536and the post-change beginning and end are at the same place.)
5537
5538Buffer changes made while executing the `after-change-functions'
5539don't call any before-change or after-change functions.
5540That's because these variables are temporarily set to nil.
5541As a result, a hook function cannot straightforwardly alter the value of
5542these variables. See the Emacs Lisp manual for a way of
5543accomplishing an equivalent result by using other variables.
5544
5545If an unhandled error happens in running these functions,
5546the variable's value remains nil. That prevents the error
5547from happening repeatedly and making Emacs nonfunctional. */);
5f079267
RS
5548 Vafter_change_functions = Qnil;
5549
7ee72033 5550 DEFVAR_LISP ("first-change-hook", &Vfirst_change_hook,
efc7e75f 5551 doc: /* A list of functions to call before changing a buffer which is unmodified.
018ba359 5552The functions are run using the `run-hooks' function. */);
dbc4e1c1 5553 Vfirst_change_hook = Qnil;
1ab256cb 5554
7ee72033
MB
5555 DEFVAR_PER_BUFFER ("buffer-undo-list", &current_buffer->undo_list, Qnil,
5556 doc: /* List of undo entries in current buffer.
018ba359
PJ
5557Recent changes come first; older changes follow newer.
5558
5559An entry (BEG . END) represents an insertion which begins at
5560position BEG and ends at position END.
5561
5562An entry (TEXT . POSITION) represents the deletion of the string TEXT
5563from (abs POSITION). If POSITION is positive, point was at the front
5564of the text being deleted; if negative, point was at the end.
5565
5566An entry (t HIGH . LOW) indicates that the buffer previously had
5567\"unmodified\" status. HIGH and LOW are the high and low 16-bit portions
5568of the visited file's modification time, as of that time. If the
5569modification time of the most recent save is different, this entry is
5570obsolete.
5571
5572An entry (nil PROPERTY VALUE BEG . END) indicates that a text property
5573was modified between BEG and END. PROPERTY is the property name,
5574and VALUE is the old value.
5575
5576An entry (MARKER . DISTANCE) indicates that the marker MARKER
5577was adjusted in position by the offset DISTANCE (an integer).
5578
5579An entry of the form POSITION indicates that point was at the buffer
5580location given by the integer. Undoing an entry of this form places
5581point at POSITION.
5582
5583nil marks undo boundaries. The undo command treats the changes
5584between two undo boundaries as a single step to be undone.
5585
5586If the value of the variable is t, undo information is not recorded. */);
5587
7ee72033
MB
5588 DEFVAR_PER_BUFFER ("mark-active", &current_buffer->mark_active, Qnil,
5589 doc: /* Non-nil means the mark and region are currently active in this buffer. */);
018ba359 5590
7ee72033
MB
5591 DEFVAR_PER_BUFFER ("cache-long-line-scans", &current_buffer->cache_long_line_scans, Qnil,
5592 doc: /* Non-nil means that Emacs should use caches to handle long lines more quickly.
018ba359
PJ
5593
5594Normally, the line-motion functions work by scanning the buffer for
5595newlines. Columnar operations (like move-to-column and
5596compute-motion) also work by scanning the buffer, summing character
5597widths as they go. This works well for ordinary text, but if the
5598buffer's lines are very long (say, more than 500 characters), these
5599motion functions will take longer to execute. Emacs may also take
5600longer to update the display.
5601
5602If cache-long-line-scans is non-nil, these motion functions cache the
5603results of their scans, and consult the cache to avoid rescanning
5604regions of the buffer until the text is modified. The caches are most
5605beneficial when they prevent the most searching---that is, when the
5606buffer contains long lines and large regions of characters with the
5607same, fixed screen width.
5608
5609When cache-long-line-scans is non-nil, processing short lines will
5610become slightly slower (because of the overhead of consulting the
5611cache), and the caches will use memory roughly proportional to the
5612number of newlines and characters whose screen width varies.
5613
5614The caches require no explicit maintenance; their accuracy is
5615maintained internally by the Emacs primitives. Enabling or disabling
5616the cache should not affect the behavior of any of the motion
5617functions; it should only affect their performance. */);
5618
7ee72033
MB
5619 DEFVAR_PER_BUFFER ("point-before-scroll", &current_buffer->point_before_scroll, Qnil,
5620 doc: /* Value of point before the last series of scroll operations, or nil. */);
018ba359 5621
7ee72033
MB
5622 DEFVAR_PER_BUFFER ("buffer-file-format", &current_buffer->file_format, Qnil,
5623 doc: /* List of formats to use when saving this buffer.
018ba359
PJ
5624Formats are defined by `format-alist'. This variable is
5625set when a file is visited. Automatically local in all buffers. */);
be9aafdd 5626
3cb719bd 5627 DEFVAR_PER_BUFFER ("buffer-invisibility-spec",
7ee72033
MB
5628 &current_buffer->invisibility_spec, Qnil,
5629 doc: /* Invisibility spec of this buffer.
018ba359
PJ
5630The default is t, which means that text is invisible
5631if it has a non-nil `invisible' property.
5632If the value is a list, a text character is invisible if its `invisible'
5633property is an element in that list.
5634If an element is a cons cell of the form (PROP . ELLIPSIS),
5635then characters with property value PROP are invisible,
5636and they have an ellipsis as well if ELLIPSIS is non-nil. */);
3cb719bd 5637
7962a441 5638 DEFVAR_PER_BUFFER ("buffer-display-count",
7ee72033
MB
5639 &current_buffer->display_count, Qnil,
5640 doc: /* A number incremented each time this buffer is displayed in a window.
018ba359 5641The function `set-window-buffer' increments it. */);
3fd364db
RS
5642
5643 DEFVAR_PER_BUFFER ("buffer-display-time",
7ee72033
MB
5644 &current_buffer->display_time, Qnil,
5645 doc: /* Time stamp updated each time this buffer is displayed in a window.
018ba359
PJ
5646The function `set-window-buffer' updates this variable
5647to the value obtained by calling `current-time'.
5648If the buffer has never been shown in a window, the value is nil. */);
5649
7ee72033
MB
5650 DEFVAR_LISP ("transient-mark-mode", &Vtransient_mark_mode,
5651 doc: /* *Non-nil means deactivate the mark when the buffer contents change.
018ba359
PJ
5652Non-nil also enables highlighting of the region whenever the mark is active.
5653The variable `highlight-nonselected-windows' controls whether to highlight
5654all windows or just the selected window. */);
c48f61ef
RS
5655 Vtransient_mark_mode = Qnil;
5656
7ee72033
MB
5657 DEFVAR_LISP ("inhibit-read-only", &Vinhibit_read_only,
5658 doc: /* *Non-nil means disregard read-only status of buffers or characters.
018ba359
PJ
5659If the value is t, disregard `buffer-read-only' and all `read-only'
5660text properties. If the value is a list, disregard `buffer-read-only'
5661and disregard a `read-only' text property if the property value
5662is a member of the list. */);
a96b68f1
RS
5663 Vinhibit_read_only = Qnil;
5664
7ee72033 5665 DEFVAR_PER_BUFFER ("cursor-type", &current_buffer->cursor_type, Qnil,
cd8d5236 5666 doc: /* Cursor to use when this buffer is in the selected window.
018ba359
PJ
5667Values are interpreted as follows:
5668
cd8d5236
RS
5669 t use the cursor specified for the frame
5670 nil don't display a cursor
5671 bar display a bar cursor with default width
5672 (bar . WIDTH) display a bar cursor with width WIDTH
5673 ANYTHING ELSE display a box cursor.
5674
5675When the buffer is displayed in a nonselected window,
5676this variable has no effect; the cursor appears as a hollow box. */);
bb2ec976 5677
a3bbced0 5678 DEFVAR_PER_BUFFER ("line-spacing",
7ee72033
MB
5679 &current_buffer->extra_line_spacing, Qnil,
5680 doc: /* Additional space to put between lines when displaying a buffer.
018ba359 5681The space is measured in pixels, and put below lines on window systems. */);
a3bbced0 5682
7ee72033 5683 DEFVAR_LISP ("kill-buffer-query-functions", &Vkill_buffer_query_functions,
efc7e75f 5684 doc: /* List of functions called with no args to query before killing a buffer. */);
dcdffbf6
RS
5685 Vkill_buffer_query_functions = Qnil;
5686
0dc88e60 5687 defsubr (&Sbuffer_live_p);
1ab256cb
RM
5688 defsubr (&Sbuffer_list);
5689 defsubr (&Sget_buffer);
5690 defsubr (&Sget_file_buffer);
5691 defsubr (&Sget_buffer_create);
336cd056 5692 defsubr (&Smake_indirect_buffer);
01050cb5 5693 defsubr (&Sgenerate_new_buffer_name);
1ab256cb
RM
5694 defsubr (&Sbuffer_name);
5695/*defsubr (&Sbuffer_number);*/
5696 defsubr (&Sbuffer_file_name);
336cd056 5697 defsubr (&Sbuffer_base_buffer);
79aa712d 5698 defsubr (&Sbuffer_local_value);
1ab256cb
RM
5699 defsubr (&Sbuffer_local_variables);
5700 defsubr (&Sbuffer_modified_p);
5701 defsubr (&Sset_buffer_modified_p);
5702 defsubr (&Sbuffer_modified_tick);
5703 defsubr (&Srename_buffer);
5704 defsubr (&Sother_buffer);
5705 defsubr (&Sbuffer_disable_undo);
5706 defsubr (&Sbuffer_enable_undo);
5707 defsubr (&Skill_buffer);
a9ee7a59 5708 defsubr (&Sset_buffer_major_mode);
1ab256cb
RM
5709 defsubr (&Sswitch_to_buffer);
5710 defsubr (&Spop_to_buffer);
5711 defsubr (&Scurrent_buffer);
5712 defsubr (&Sset_buffer);
5713 defsubr (&Sbarf_if_buffer_read_only);
5714 defsubr (&Sbury_buffer);
3ac81adb
RS
5715 defsubr (&Serase_buffer);
5716 defsubr (&Sset_buffer_multibyte);
1ab256cb 5717 defsubr (&Skill_all_local_variables);
2eec3b4e 5718
52f8ec73 5719 defsubr (&Soverlayp);
2eec3b4e
RS
5720 defsubr (&Smake_overlay);
5721 defsubr (&Sdelete_overlay);
5722 defsubr (&Smove_overlay);
8ebafa8d
JB
5723 defsubr (&Soverlay_start);
5724 defsubr (&Soverlay_end);
5725 defsubr (&Soverlay_buffer);
5726 defsubr (&Soverlay_properties);
2eec3b4e 5727 defsubr (&Soverlays_at);
74514898 5728 defsubr (&Soverlays_in);
2eec3b4e 5729 defsubr (&Snext_overlay_change);
239c932b 5730 defsubr (&Sprevious_overlay_change);
2eec3b4e
RS
5731 defsubr (&Soverlay_recenter);
5732 defsubr (&Soverlay_lists);
5733 defsubr (&Soverlay_get);
5734 defsubr (&Soverlay_put);
a8c21b48 5735 defsubr (&Srestore_buffer_modified_p);
1ab256cb
RM
5736}
5737
dfcf069d 5738void
1ab256cb
RM
5739keys_of_buffer ()
5740{
5741 initial_define_key (control_x_map, 'b', "switch-to-buffer");
5742 initial_define_key (control_x_map, 'k', "kill-buffer");
4158c17d
RM
5743
5744 /* This must not be in syms_of_buffer, because Qdisabled is not
5745 initialized when that function gets called. */
5746 Fput (intern ("erase-buffer"), Qdisabled, Qt);
1ab256cb 5747}