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