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