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