(overlays_in): Declare static.
[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,
7ee72033
MB
3947 doc: /* Recenter the overlays of the current buffer around position POS. */)
3948 (pos)
2eec3b4e
RS
3949 Lisp_Object pos;
3950{
b7826503 3951 CHECK_NUMBER_COERCE_MARKER (pos);
2eec3b4e 3952
5c4f68f1 3953 recenter_overlay_lists (current_buffer, XINT (pos));
2eec3b4e
RS
3954 return Qnil;
3955}
3956\f
3957DEFUN ("overlay-get", Foverlay_get, Soverlay_get, 2, 2, 0,
7ee72033
MB
3958 doc: /* Get the property of overlay OVERLAY with property name PROP. */)
3959 (overlay, prop)
2eec3b4e
RS
3960 Lisp_Object overlay, prop;
3961{
b7826503 3962 CHECK_OVERLAY (overlay);
9a593927 3963 return lookup_char_property (XOVERLAY (overlay)->plist, prop, 0);
2eec3b4e
RS
3964}
3965
3966DEFUN ("overlay-put", Foverlay_put, Soverlay_put, 3, 3, 0,
7ee72033
MB
3967 doc: /* Set one property of overlay OVERLAY: give property PROP value VALUE. */)
3968 (overlay, prop, value)
2eec3b4e
RS
3969 Lisp_Object overlay, prop, value;
3970{
48e2e3ba 3971 Lisp_Object tail, buffer;
9d7608b7 3972 int changed;
2eec3b4e 3973
b7826503 3974 CHECK_OVERLAY (overlay);
b61982dd 3975
274a9425
RS
3976 buffer = Fmarker_buffer (OVERLAY_START (overlay));
3977
48e2e3ba 3978 for (tail = XOVERLAY (overlay)->plist;
7539e11f
KR
3979 CONSP (tail) && CONSP (XCDR (tail));
3980 tail = XCDR (XCDR (tail)))
3981 if (EQ (XCAR (tail), prop))
274a9425 3982 {
7539e11f 3983 changed = !EQ (XCAR (XCDR (tail)), value);
f3fbd155 3984 XSETCAR (XCDR (tail), value);
9d7608b7 3985 goto found;
274a9425 3986 }
9d7608b7
KH
3987 /* It wasn't in the list, so add it to the front. */
3988 changed = !NILP (value);
48e2e3ba
KH
3989 XOVERLAY (overlay)->plist
3990 = Fcons (prop, Fcons (value, XOVERLAY (overlay)->plist));
9d7608b7
KH
3991 found:
3992 if (! NILP (buffer))
3993 {
3994 if (changed)
876aa27c 3995 modify_overlay (XBUFFER (buffer),
26f545d7
GM
3996 marker_position (OVERLAY_START (overlay)),
3997 marker_position (OVERLAY_END (overlay)));
9d7608b7
KH
3998 if (EQ (prop, Qevaporate) && ! NILP (value)
3999 && (OVERLAY_POSITION (OVERLAY_START (overlay))
4000 == OVERLAY_POSITION (OVERLAY_END (overlay))))
4001 Fdelete_overlay (overlay);
4002 }
2eec3b4e 4003 return value;
1ab256cb
RM
4004}
4005\f
9115729e
KH
4006/* Subroutine of report_overlay_modification. */
4007
4008/* Lisp vector holding overlay hook functions to call.
4009 Vector elements come in pairs.
4010 Each even-index element is a list of hook functions.
4011 The following odd-index element is the overlay they came from.
4012
4013 Before the buffer change, we fill in this vector
4014 as we call overlay hook functions.
4015 After the buffer change, we get the functions to call from this vector.
4016 This way we always call the same functions before and after the change. */
4017static Lisp_Object last_overlay_modification_hooks;
4018
4019/* Number of elements actually used in last_overlay_modification_hooks. */
4020static int last_overlay_modification_hooks_used;
4021
4022/* Add one functionlist/overlay pair
4023 to the end of last_overlay_modification_hooks. */
4024
4025static void
4026add_overlay_mod_hooklist (functionlist, overlay)
4027 Lisp_Object functionlist, overlay;
4028{
4029 int oldsize = XVECTOR (last_overlay_modification_hooks)->size;
4030
4031 if (last_overlay_modification_hooks_used == oldsize)
4032 {
4033 Lisp_Object old;
4034 old = last_overlay_modification_hooks;
4035 last_overlay_modification_hooks
4036 = Fmake_vector (make_number (oldsize * 2), Qnil);
0b1f1b09
RS
4037 bcopy (XVECTOR (old)->contents,
4038 XVECTOR (last_overlay_modification_hooks)->contents,
9115729e
KH
4039 sizeof (Lisp_Object) * oldsize);
4040 }
4041 XVECTOR (last_overlay_modification_hooks)->contents[last_overlay_modification_hooks_used++] = functionlist;
4042 XVECTOR (last_overlay_modification_hooks)->contents[last_overlay_modification_hooks_used++] = overlay;
4043}
4044\f
173f2a64
RS
4045/* Run the modification-hooks of overlays that include
4046 any part of the text in START to END.
9115729e
KH
4047 If this change is an insertion, also
4048 run the insert-before-hooks of overlay starting at END,
930a9140
RS
4049 and the insert-after-hooks of overlay ending at START.
4050
4051 This is called both before and after the modification.
4052 AFTER is nonzero when we call after the modification.
4053
9115729e
KH
4054 ARG1, ARG2, ARG3 are arguments to pass to the hook functions.
4055 When AFTER is nonzero, they are the start position,
4056 the position after the inserted new text,
4057 and the length of deleted or replaced old text. */
173f2a64
RS
4058
4059void
930a9140 4060report_overlay_modification (start, end, after, arg1, arg2, arg3)
173f2a64 4061 Lisp_Object start, end;
930a9140
RS
4062 int after;
4063 Lisp_Object arg1, arg2, arg3;
173f2a64
RS
4064{
4065 Lisp_Object prop, overlay, tail;
9115729e
KH
4066 /* 1 if this change is an insertion. */
4067 int insertion = (after ? XFASTINT (arg3) == 0 : EQ (start, end));
55b48893 4068 int tail_copied;
930a9140 4069 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
55b48893
RS
4070
4071 overlay = Qnil;
4072 tail = Qnil;
930a9140 4073 GCPRO5 (overlay, tail, arg1, arg2, arg3);
173f2a64 4074
9115729e
KH
4075 if (after)
4076 {
4077 /* Call the functions recorded in last_overlay_modification_hooks
4078 rather than scanning the overlays again.
4079 First copy the vector contents, in case some of these hooks
4080 do subsequent modification of the buffer. */
4081 int size = last_overlay_modification_hooks_used;
4082 Lisp_Object *copy = (Lisp_Object *) alloca (size * sizeof (Lisp_Object));
4083 int i;
4084
4085 bcopy (XVECTOR (last_overlay_modification_hooks)->contents,
4086 copy, size * sizeof (Lisp_Object));
4087 gcpro1.var = copy;
4088 gcpro1.nvars = size;
4089
4090 for (i = 0; i < size;)
4091 {
4092 Lisp_Object prop, overlay;
4093 prop = copy[i++];
4094 overlay = copy[i++];
4095 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
4096 }
4097 UNGCPRO;
4098 return;
4099 }
4100
4101 /* We are being called before a change.
4102 Scan the overlays to find the functions to call. */
4103 last_overlay_modification_hooks_used = 0;
55b48893 4104 tail_copied = 0;
173f2a64
RS
4105 for (tail = current_buffer->overlays_before;
4106 CONSP (tail);
7539e11f 4107 tail = XCDR (tail))
173f2a64
RS
4108 {
4109 int startpos, endpos;
be8b1c6b 4110 Lisp_Object ostart, oend;
173f2a64 4111
7539e11f 4112 overlay = XCAR (tail);
173f2a64
RS
4113
4114 ostart = OVERLAY_START (overlay);
4115 oend = OVERLAY_END (overlay);
4116 endpos = OVERLAY_POSITION (oend);
4117 if (XFASTINT (start) > endpos)
4118 break;
4119 startpos = OVERLAY_POSITION (ostart);
9115729e
KH
4120 if (insertion && (XFASTINT (start) == startpos
4121 || XFASTINT (end) == startpos))
173f2a64
RS
4122 {
4123 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
5fb5aa33
RS
4124 if (!NILP (prop))
4125 {
4126 /* Copy TAIL in case the hook recenters the overlay lists. */
55b48893
RS
4127 if (!tail_copied)
4128 tail = Fcopy_sequence (tail);
4129 tail_copied = 1;
930a9140 4130 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
5fb5aa33 4131 }
173f2a64 4132 }
9115729e
KH
4133 if (insertion && (XFASTINT (start) == endpos
4134 || XFASTINT (end) == endpos))
173f2a64
RS
4135 {
4136 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
5fb5aa33
RS
4137 if (!NILP (prop))
4138 {
55b48893
RS
4139 if (!tail_copied)
4140 tail = Fcopy_sequence (tail);
4141 tail_copied = 1;
930a9140 4142 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
5fb5aa33 4143 }
173f2a64 4144 }
3bd13e92
KH
4145 /* Test for intersecting intervals. This does the right thing
4146 for both insertion and deletion. */
4147 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
173f2a64
RS
4148 {
4149 prop = Foverlay_get (overlay, Qmodification_hooks);
5fb5aa33
RS
4150 if (!NILP (prop))
4151 {
55b48893
RS
4152 if (!tail_copied)
4153 tail = Fcopy_sequence (tail);
4154 tail_copied = 1;
930a9140 4155 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
5fb5aa33 4156 }
173f2a64
RS
4157 }
4158 }
4159
55b48893 4160 tail_copied = 0;
173f2a64
RS
4161 for (tail = current_buffer->overlays_after;
4162 CONSP (tail);
7539e11f 4163 tail = XCDR (tail))
173f2a64
RS
4164 {
4165 int startpos, endpos;
be8b1c6b 4166 Lisp_Object ostart, oend;
173f2a64 4167
7539e11f 4168 overlay = XCAR (tail);
173f2a64
RS
4169
4170 ostart = OVERLAY_START (overlay);
4171 oend = OVERLAY_END (overlay);
4172 startpos = OVERLAY_POSITION (ostart);
cdf0b096 4173 endpos = OVERLAY_POSITION (oend);
173f2a64
RS
4174 if (XFASTINT (end) < startpos)
4175 break;
9115729e
KH
4176 if (insertion && (XFASTINT (start) == startpos
4177 || XFASTINT (end) == startpos))
173f2a64
RS
4178 {
4179 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
5fb5aa33
RS
4180 if (!NILP (prop))
4181 {
55b48893
RS
4182 if (!tail_copied)
4183 tail = Fcopy_sequence (tail);
4184 tail_copied = 1;
930a9140 4185 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
5fb5aa33 4186 }
173f2a64 4187 }
9115729e
KH
4188 if (insertion && (XFASTINT (start) == endpos
4189 || XFASTINT (end) == endpos))
173f2a64
RS
4190 {
4191 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
5fb5aa33
RS
4192 if (!NILP (prop))
4193 {
55b48893
RS
4194 if (!tail_copied)
4195 tail = Fcopy_sequence (tail);
4196 tail_copied = 1;
930a9140 4197 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
5fb5aa33 4198 }
173f2a64 4199 }
3bd13e92
KH
4200 /* Test for intersecting intervals. This does the right thing
4201 for both insertion and deletion. */
4202 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
173f2a64
RS
4203 {
4204 prop = Foverlay_get (overlay, Qmodification_hooks);
5fb5aa33
RS
4205 if (!NILP (prop))
4206 {
55b48893
RS
4207 if (!tail_copied)
4208 tail = Fcopy_sequence (tail);
4209 tail_copied = 1;
930a9140 4210 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
5fb5aa33 4211 }
173f2a64
RS
4212 }
4213 }
55b48893
RS
4214
4215 UNGCPRO;
173f2a64
RS
4216}
4217
4218static void
930a9140
RS
4219call_overlay_mod_hooks (list, overlay, after, arg1, arg2, arg3)
4220 Lisp_Object list, overlay;
4221 int after;
4222 Lisp_Object arg1, arg2, arg3;
173f2a64 4223{
930a9140 4224 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
9115729e 4225
930a9140 4226 GCPRO4 (list, arg1, arg2, arg3);
9115729e
KH
4227 if (! after)
4228 add_overlay_mod_hooklist (list, overlay);
4229
6d70a280 4230 while (CONSP (list))
173f2a64 4231 {
930a9140 4232 if (NILP (arg3))
6d70a280 4233 call4 (XCAR (list), overlay, after ? Qt : Qnil, arg1, arg2);
930a9140 4234 else
6d70a280
SM
4235 call5 (XCAR (list), overlay, after ? Qt : Qnil, arg1, arg2, arg3);
4236 list = XCDR (list);
173f2a64
RS
4237 }
4238 UNGCPRO;
4239}
9d7608b7
KH
4240
4241/* Delete any zero-sized overlays at position POS, if the `evaporate'
4242 property is set. */
4243void
4244evaporate_overlays (pos)
4245 int pos;
4246{
4247 Lisp_Object tail, overlay, hit_list;
4248
4249 hit_list = Qnil;
4250 if (pos <= XFASTINT (current_buffer->overlay_center))
4251 for (tail = current_buffer->overlays_before; CONSP (tail);
7539e11f 4252 tail = XCDR (tail))
9d7608b7
KH
4253 {
4254 int endpos;
7539e11f 4255 overlay = XCAR (tail);
9d7608b7
KH
4256 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
4257 if (endpos < pos)
4258 break;
4259 if (endpos == pos && OVERLAY_POSITION (OVERLAY_START (overlay)) == pos
c3935f9d 4260 && ! NILP (Foverlay_get (overlay, Qevaporate)))
9d7608b7
KH
4261 hit_list = Fcons (overlay, hit_list);
4262 }
4263 else
4264 for (tail = current_buffer->overlays_after; CONSP (tail);
7539e11f 4265 tail = XCDR (tail))
9d7608b7
KH
4266 {
4267 int startpos;
7539e11f 4268 overlay = XCAR (tail);
9d7608b7
KH
4269 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
4270 if (startpos > pos)
4271 break;
4272 if (startpos == pos && OVERLAY_POSITION (OVERLAY_END (overlay)) == pos
c3935f9d 4273 && ! NILP (Foverlay_get (overlay, Qevaporate)))
9d7608b7
KH
4274 hit_list = Fcons (overlay, hit_list);
4275 }
7539e11f
KR
4276 for (; CONSP (hit_list); hit_list = XCDR (hit_list))
4277 Fdelete_overlay (XCAR (hit_list));
9d7608b7 4278}
173f2a64 4279\f
54dfdeb0 4280/* Somebody has tried to store a value with an unacceptable type
1bf08baf
KH
4281 in the slot with offset OFFSET. */
4282
0fa3ba92 4283void
54dfdeb0
KH
4284buffer_slot_type_mismatch (offset)
4285 int offset;
0fa3ba92 4286{
54dfdeb0 4287 Lisp_Object sym;
0fa3ba92 4288 char *type_name;
177c0ea7 4289
7313acd0 4290 switch (XINT (PER_BUFFER_TYPE (offset)))
0fa3ba92 4291 {
7c02e886
GM
4292 case Lisp_Int:
4293 type_name = "integers";
4294 break;
177c0ea7 4295
7c02e886
GM
4296 case Lisp_String:
4297 type_name = "strings";
4298 break;
177c0ea7 4299
7c02e886
GM
4300 case Lisp_Symbol:
4301 type_name = "symbols";
4302 break;
177c0ea7 4303
0fa3ba92
JB
4304 default:
4305 abort ();
4306 }
4307
7313acd0 4308 sym = PER_BUFFER_SYMBOL (offset);
1bf08baf 4309 error ("Only %s should be stored in the buffer-local variable %s",
d5db4077 4310 type_name, SDATA (SYMBOL_NAME (sym)));
0fa3ba92 4311}
7c02e886 4312
0fa3ba92 4313\f
b86af064
GM
4314/***********************************************************************
4315 Allocation with mmap
4316 ***********************************************************************/
4317
4318#ifdef USE_MMAP_FOR_BUFFERS
4319
4320#include <sys/types.h>
4321#include <sys/mman.h>
4322
4323#ifndef MAP_ANON
4324#ifdef MAP_ANONYMOUS
4325#define MAP_ANON MAP_ANONYMOUS
4326#else
4327#define MAP_ANON 0
4328#endif
4329#endif
4330
09dfdf85
GM
4331#ifndef MAP_FAILED
4332#define MAP_FAILED ((void *) -1)
4333#endif
4334
b86af064
GM
4335#include <stdio.h>
4336#include <errno.h>
4337
4338#if MAP_ANON == 0
4339#include <fcntl.h>
4340#endif
4341
4342#include "coding.h"
4343
4344
4345/* Memory is allocated in regions which are mapped using mmap(2).
4346 The current implementation lets the system select mapped
4347 addresses; we're not using MAP_FIXED in general, except when
4348 trying to enlarge regions.
4349
4350 Each mapped region starts with a mmap_region structure, the user
4351 area starts after that structure, aligned to MEM_ALIGN.
4352
4353 +-----------------------+
4354 | struct mmap_info + |
4355 | padding |
4356 +-----------------------+
4357 | user data |
4358 | |
4359 | |
4360 +-----------------------+ */
4361
4362struct mmap_region
4363{
4364 /* User-specified size. */
4365 size_t nbytes_specified;
177c0ea7 4366
b86af064
GM
4367 /* Number of bytes mapped */
4368 size_t nbytes_mapped;
4369
4370 /* Pointer to the location holding the address of the memory
4371 allocated with the mmap'd block. The variable actually points
4372 after this structure. */
4373 POINTER_TYPE **var;
4374
4375 /* Next and previous in list of all mmap'd regions. */
4376 struct mmap_region *next, *prev;
4377};
4378
4379/* Doubly-linked list of mmap'd regions. */
4380
4381static struct mmap_region *mmap_regions;
4382
4383/* File descriptor for mmap. If we don't have anonymous mapping,
4384 /dev/zero will be opened on it. */
4385
4386static int mmap_fd;
4387
4388/* Temporary storage for mmap_set_vars, see there. */
4389
4390static struct mmap_region *mmap_regions_1;
4391static int mmap_fd_1;
4392
4393/* Page size on this system. */
4394
4395static int mmap_page_size;
4396
4397/* 1 means mmap has been intialized. */
4398
4399static int mmap_initialized_p;
4400
4401/* Value is X rounded up to the next multiple of N. */
4402
4403#define ROUND(X, N) (((X) + (N) - 1) / (N) * (N))
4404
4405/* Size of mmap_region structure plus padding. */
4406
4407#define MMAP_REGION_STRUCT_SIZE \
4408 ROUND (sizeof (struct mmap_region), MEM_ALIGN)
4409
4410/* Given a pointer P to the start of the user-visible part of a mapped
4411 region, return a pointer to the start of the region. */
4412
4413#define MMAP_REGION(P) \
4414 ((struct mmap_region *) ((char *) (P) - MMAP_REGION_STRUCT_SIZE))
4415
4416/* Given a pointer P to the start of a mapped region, return a pointer
4417 to the start of the user-visible part of the region. */
4418
4419#define MMAP_USER_AREA(P) \
4420 ((POINTER_TYPE *) ((char *) (P) + MMAP_REGION_STRUCT_SIZE))
4421
4422#define MEM_ALIGN sizeof (double)
4423
7273faa1
DL
4424/* Predicate returning true if part of the address range [START .. END]
4425 is currently mapped. Used to prevent overwriting an existing
08327b22
GM
4426 memory mapping.
4427
4428 Default is to conservativly assume the address range is occupied by
4429 something else. This can be overridden by system configuration
4430 files if system-specific means to determine this exists. */
4431
4432#ifndef MMAP_ALLOCATED_P
4433#define MMAP_ALLOCATED_P(start, end) 1
4434#endif
4435
b86af064
GM
4436/* Function prototypes. */
4437
4438static int mmap_free_1 P_ ((struct mmap_region *));
4439static int mmap_enlarge P_ ((struct mmap_region *, int));
4440static struct mmap_region *mmap_find P_ ((POINTER_TYPE *, POINTER_TYPE *));
4441static POINTER_TYPE *mmap_alloc P_ ((POINTER_TYPE **, size_t));
4442static POINTER_TYPE *mmap_realloc P_ ((POINTER_TYPE **, size_t));
4443static void mmap_free P_ ((POINTER_TYPE **ptr));
4444static void mmap_init P_ ((void));
4445
4446
4447/* Return a region overlapping address range START...END, or null if
4448 none. END is not including, i.e. the last byte in the range
4449 is at END - 1. */
4450
4451static struct mmap_region *
4452mmap_find (start, end)
4453 POINTER_TYPE *start, *end;
4454{
4455 struct mmap_region *r;
4456 char *s = (char *) start, *e = (char *) end;
177c0ea7 4457
b86af064
GM
4458 for (r = mmap_regions; r; r = r->next)
4459 {
4460 char *rstart = (char *) r;
4461 char *rend = rstart + r->nbytes_mapped;
4462
4463 if (/* First byte of range, i.e. START, in this region? */
4464 (s >= rstart && s < rend)
4465 /* Last byte of range, i.e. END - 1, in this region? */
4466 || (e > rstart && e <= rend)
4467 /* First byte of this region in the range? */
4468 || (rstart >= s && rstart < e)
4469 /* Last byte of this region in the range? */
4470 || (rend > s && rend <= e))
4471 break;
4472 }
4473
4474 return r;
4475}
4476
4477
4478/* Unmap a region. P is a pointer to the start of the user-araa of
4479 the region. Value is non-zero if successful. */
4480
4481static int
4482mmap_free_1 (r)
4483 struct mmap_region *r;
4484{
4485 if (r->next)
4486 r->next->prev = r->prev;
4487 if (r->prev)
4488 r->prev->next = r->next;
4489 else
4490 mmap_regions = r->next;
177c0ea7 4491
1a15cca0 4492 if (munmap ((POINTER_TYPE *) r, r->nbytes_mapped) == -1)
b86af064
GM
4493 {
4494 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4495 return 0;
4496 }
4497
4498 return 1;
4499}
4500
4501
4502/* Enlarge region R by NPAGES pages. NPAGES < 0 means shrink R.
4503 Value is non-zero if successful. */
4504
4505static int
4506mmap_enlarge (r, npages)
4507 struct mmap_region *r;
4508 int npages;
4509{
4510 char *region_end = (char *) r + r->nbytes_mapped;
4511 size_t nbytes;
4512 int success = 0;
4513
4514 if (npages < 0)
4515 {
4516 /* Unmap pages at the end of the region. */
4517 nbytes = - npages * mmap_page_size;
4518 if (munmap (region_end - nbytes, nbytes) == -1)
4519 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4520 else
4521 {
4522 r->nbytes_mapped -= nbytes;
4523 success = 1;
4524 }
4525 }
4526 else if (npages > 0)
4527 {
b86af064 4528 nbytes = npages * mmap_page_size;
177c0ea7 4529
b86af064
GM
4530 /* Try to map additional pages at the end of the region. We
4531 cannot do this if the address range is already occupied by
4532 something else because mmap deletes any previous mapping.
4533 I'm not sure this is worth doing, let's see. */
08327b22 4534 if (!MMAP_ALLOCATED_P (region_end, region_end + nbytes))
b86af064
GM
4535 {
4536 POINTER_TYPE *p;
177c0ea7 4537
b86af064
GM
4538 p = mmap (region_end, nbytes, PROT_READ | PROT_WRITE,
4539 MAP_ANON | MAP_PRIVATE | MAP_FIXED, mmap_fd, 0);
4540 if (p == MAP_FAILED)
edaa9aed 4541 ; /* fprintf (stderr, "mmap: %s\n", emacs_strerror (errno)); */
b86af064
GM
4542 else if (p != (POINTER_TYPE *) region_end)
4543 {
4544 /* Kernels are free to choose a different address. In
4545 that case, unmap what we've mapped above; we have
4546 no use for it. */
4547 if (munmap (p, nbytes) == -1)
4548 fprintf (stderr, "munmap: %s\n", emacs_strerror (errno));
4549 }
4550 else
4551 {
4552 r->nbytes_mapped += nbytes;
4553 success = 1;
4554 }
4555 }
4556 }
4557
4558 return success;
4559}
4560
4561
4562/* Set or reset variables holding references to mapped regions. If
4563 RESTORE_P is zero, set all variables to null. If RESTORE_P is
4564 non-zero, set all variables to the start of the user-areas
4565 of mapped regions.
4566
4567 This function is called from Fdump_emacs to ensure that the dumped
4568 Emacs doesn't contain references to memory that won't be mapped
4569 when Emacs starts. */
4570
4571void
4572mmap_set_vars (restore_p)
4573 int restore_p;
4574{
4575 struct mmap_region *r;
4576
4577 if (restore_p)
4578 {
4579 mmap_regions = mmap_regions_1;
4580 mmap_fd = mmap_fd_1;
4581 for (r = mmap_regions; r; r = r->next)
4582 *r->var = MMAP_USER_AREA (r);
4583 }
4584 else
4585 {
4586 for (r = mmap_regions; r; r = r->next)
4587 *r->var = NULL;
4588 mmap_regions_1 = mmap_regions;
4589 mmap_regions = NULL;
4590 mmap_fd_1 = mmap_fd;
4591 mmap_fd = -1;
4592 }
4593}
4594
4595
4596/* Allocate a block of storage large enough to hold NBYTES bytes of
4597 data. A pointer to the data is returned in *VAR. VAR is thus the
4598 address of some variable which will use the data area.
4599
4600 The allocation of 0 bytes is valid.
4601
4602 If we can't allocate the necessary memory, set *VAR to null, and
4603 return null. */
4604
4605static POINTER_TYPE *
4606mmap_alloc (var, nbytes)
4607 POINTER_TYPE **var;
4608 size_t nbytes;
4609{
4610 void *p;
4611 size_t map;
4612
4613 mmap_init ();
4614
4615 map = ROUND (nbytes + MMAP_REGION_STRUCT_SIZE, mmap_page_size);
4616 p = mmap (NULL, map, PROT_READ | PROT_WRITE, MAP_ANON | MAP_PRIVATE,
4617 mmap_fd, 0);
177c0ea7 4618
b86af064
GM
4619 if (p == MAP_FAILED)
4620 {
4621 if (errno != ENOMEM)
4622 fprintf (stderr, "mmap: %s\n", emacs_strerror (errno));
4623 p = NULL;
4624 }
4625 else
4626 {
4627 struct mmap_region *r = (struct mmap_region *) p;
177c0ea7 4628
b86af064
GM
4629 r->nbytes_specified = nbytes;
4630 r->nbytes_mapped = map;
4631 r->var = var;
4632 r->prev = NULL;
4633 r->next = mmap_regions;
4634 if (r->next)
4635 r->next->prev = r;
4636 mmap_regions = r;
177c0ea7 4637
b86af064
GM
4638 p = MMAP_USER_AREA (p);
4639 }
177c0ea7 4640
b86af064
GM
4641 return *var = p;
4642}
4643
4644
4645/* Given a pointer at address VAR to data allocated with mmap_alloc,
4646 resize it to size NBYTES. Change *VAR to reflect the new block,
4647 and return this value. If more memory cannot be allocated, then
4648 leave *VAR unchanged, and return null. */
4649
4650static POINTER_TYPE *
4651mmap_realloc (var, nbytes)
4652 POINTER_TYPE **var;
4653 size_t nbytes;
4654{
4655 POINTER_TYPE *result;
177c0ea7 4656
b86af064
GM
4657 mmap_init ();
4658
4659 if (*var == NULL)
4660 result = mmap_alloc (var, nbytes);
177c0ea7 4661 else if (nbytes == 0)
b86af064
GM
4662 {
4663 mmap_free (var);
4664 result = mmap_alloc (var, nbytes);
4665 }
4666 else
4667 {
4668 struct mmap_region *r = MMAP_REGION (*var);
4669 size_t room = r->nbytes_mapped - MMAP_REGION_STRUCT_SIZE;
177c0ea7 4670
b86af064
GM
4671 if (room < nbytes)
4672 {
4673 /* Must enlarge. */
4674 POINTER_TYPE *old_ptr = *var;
4675
4676 /* Try to map additional pages at the end of the region.
4677 If that fails, allocate a new region, copy data
4678 from the old region, then free it. */
4679 if (mmap_enlarge (r, (ROUND (nbytes - room, mmap_page_size)
4680 / mmap_page_size)))
4681 {
4682 r->nbytes_specified = nbytes;
4683 *var = result = old_ptr;
4684 }
4685 else if (mmap_alloc (var, nbytes))
4686 {
4687 bcopy (old_ptr, *var, r->nbytes_specified);
4688 mmap_free_1 (MMAP_REGION (old_ptr));
4689 result = *var;
4690 r = MMAP_REGION (result);
4691 r->nbytes_specified = nbytes;
4692 }
4693 else
4694 {
4695 *var = old_ptr;
4696 result = NULL;
4697 }
4698 }
4699 else if (room - nbytes >= mmap_page_size)
4700 {
4701 /* Shrinking by at least a page. Let's give some
6bcdeb8c
KR
4702 memory back to the system.
4703
4704 The extra parens are to make the division happens first,
4705 on positive values, so we know it will round towards
4706 zero. */
bb63c5c9 4707 mmap_enlarge (r, - ((room - nbytes) / mmap_page_size));
b86af064
GM
4708 result = *var;
4709 r->nbytes_specified = nbytes;
4710 }
4711 else
4712 {
4713 /* Leave it alone. */
4714 result = *var;
4715 r->nbytes_specified = nbytes;
4716 }
4717 }
4718
4719 return result;
4720}
4721
4722
4723/* Free a block of relocatable storage whose data is pointed to by
4724 PTR. Store 0 in *PTR to show there's no block allocated. */
4725
4726static void
4727mmap_free (var)
4728 POINTER_TYPE **var;
4729{
4730 mmap_init ();
177c0ea7 4731
b86af064
GM
4732 if (*var)
4733 {
4734 mmap_free_1 (MMAP_REGION (*var));
4735 *var = NULL;
4736 }
4737}
4738
4739
4740/* Perform necessary intializations for the use of mmap. */
4741
4742static void
4743mmap_init ()
4744{
4745#if MAP_ANON == 0
4746 /* The value of mmap_fd is initially 0 in temacs, and -1
4747 in a dumped Emacs. */
4748 if (mmap_fd <= 0)
4749 {
4750 /* No anonymous mmap -- we need the file descriptor. */
4751 mmap_fd = open ("/dev/zero", O_RDONLY);
4752 if (mmap_fd == -1)
4753 fatal ("Cannot open /dev/zero: %s", emacs_strerror (errno));
4754 }
4755#endif /* MAP_ANON == 0 */
4756
4757 if (mmap_initialized_p)
4758 return;
4759 mmap_initialized_p = 1;
177c0ea7 4760
b86af064
GM
4761#if MAP_ANON != 0
4762 mmap_fd = -1;
4763#endif
177c0ea7 4764
b86af064
GM
4765 mmap_page_size = getpagesize ();
4766}
4767
4768#endif /* USE_MMAP_FOR_BUFFERS */
4769
4770
4771\f
4772/***********************************************************************
4773 Buffer-text Allocation
4774 ***********************************************************************/
4775
4776#ifdef REL_ALLOC
4777extern POINTER_TYPE *r_alloc P_ ((POINTER_TYPE **, size_t));
4778extern POINTER_TYPE *r_re_alloc P_ ((POINTER_TYPE **, size_t));
4779extern void r_alloc_free P_ ((POINTER_TYPE **ptr));
4780#endif /* REL_ALLOC */
4781
4782
4783/* Allocate NBYTES bytes for buffer B's text buffer. */
4784
4785static void
4786alloc_buffer_text (b, nbytes)
4787 struct buffer *b;
4788 size_t nbytes;
4789{
4790 POINTER_TYPE *p;
177c0ea7 4791
b86af064
GM
4792 BLOCK_INPUT;
4793#if defined USE_MMAP_FOR_BUFFERS
4794 p = mmap_alloc ((POINTER_TYPE **) &b->text->beg, nbytes);
4795#elif defined REL_ALLOC
4796 p = r_alloc ((POINTER_TYPE **) &b->text->beg, nbytes);
4797#else
815add84 4798 p = xmalloc (nbytes);
b86af064 4799#endif
177c0ea7 4800
b86af064
GM
4801 if (p == NULL)
4802 {
4803 UNBLOCK_INPUT;
4804 memory_full ();
4805 }
4806
4807 b->text->beg = (unsigned char *) p;
4808 UNBLOCK_INPUT;
4809}
4810
4811/* Enlarge buffer B's text buffer by DELTA bytes. DELTA < 0 means
4812 shrink it. */
4813
4814void
4815enlarge_buffer_text (b, delta)
4816 struct buffer *b;
4817 int delta;
4818{
4819 POINTER_TYPE *p;
4820 size_t nbytes = (BUF_Z_BYTE (b) - BUF_BEG_BYTE (b) + BUF_GAP_SIZE (b) + 1
4821 + delta);
4822 BLOCK_INPUT;
4823#if defined USE_MMAP_FOR_BUFFERS
4824 p = mmap_realloc ((POINTER_TYPE **) &b->text->beg, nbytes);
4825#elif defined REL_ALLOC
4826 p = r_re_alloc ((POINTER_TYPE **) &b->text->beg, nbytes);
4827#else
4828 p = xrealloc (b->text->beg, nbytes);
4829#endif
177c0ea7 4830
b86af064
GM
4831 if (p == NULL)
4832 {
4833 UNBLOCK_INPUT;
4834 memory_full ();
4835 }
4836
4837 BUF_BEG_ADDR (b) = (unsigned char *) p;
4838 UNBLOCK_INPUT;
4839}
4840
4841
4842/* Free buffer B's text buffer. */
4843
4844static void
4845free_buffer_text (b)
4846 struct buffer *b;
4847{
4848 BLOCK_INPUT;
4849
4850#if defined USE_MMAP_FOR_BUFFERS
4851 mmap_free ((POINTER_TYPE **) &b->text->beg);
4852#elif defined REL_ALLOC
4853 r_alloc_free ((POINTER_TYPE **) &b->text->beg);
4854#else
4855 xfree (b->text->beg);
4856#endif
177c0ea7 4857
b86af064
GM
4858 BUF_BEG_ADDR (b) = NULL;
4859 UNBLOCK_INPUT;
4860}
4861
4862
4863\f
4864/***********************************************************************
4865 Initialization
4866 ***********************************************************************/
4867
dfcf069d 4868void
1ab256cb
RM
4869init_buffer_once ()
4870{
7c02e886
GM
4871 int idx;
4872
4873 bzero (buffer_permanent_local_flags, sizeof buffer_permanent_local_flags);
13de9290 4874
1ab256cb
RM
4875 /* Make sure all markable slots in buffer_defaults
4876 are initialized reasonably, so mark_buffer won't choke. */
4877 reset_buffer (&buffer_defaults);
13de9290 4878 reset_buffer_local_variables (&buffer_defaults, 1);
1ab256cb 4879 reset_buffer (&buffer_local_symbols);
13de9290 4880 reset_buffer_local_variables (&buffer_local_symbols, 1);
336cd056
RS
4881 /* Prevent GC from getting confused. */
4882 buffer_defaults.text = &buffer_defaults.own_text;
4883 buffer_local_symbols.text = &buffer_local_symbols.own_text;
336cd056
RS
4884 BUF_INTERVALS (&buffer_defaults) = 0;
4885 BUF_INTERVALS (&buffer_local_symbols) = 0;
67180c6a
KH
4886 XSETBUFFER (Vbuffer_defaults, &buffer_defaults);
4887 XSETBUFFER (Vbuffer_local_symbols, &buffer_local_symbols);
1ab256cb
RM
4888
4889 /* Set up the default values of various buffer slots. */
4890 /* Must do these before making the first buffer! */
4891
f532dca0 4892 /* real setup is done in bindings.el */
1ab256cb 4893 buffer_defaults.mode_line_format = build_string ("%-");
045dee35 4894 buffer_defaults.header_line_format = Qnil;
1ab256cb
RM
4895 buffer_defaults.abbrev_mode = Qnil;
4896 buffer_defaults.overwrite_mode = Qnil;
4897 buffer_defaults.case_fold_search = Qt;
4898 buffer_defaults.auto_fill_function = Qnil;
4899 buffer_defaults.selective_display = Qnil;
4900#ifndef old
4901 buffer_defaults.selective_display_ellipses = Qt;
4902#endif
4903 buffer_defaults.abbrev_table = Qnil;
4904 buffer_defaults.display_table = Qnil;
1ab256cb 4905 buffer_defaults.undo_list = Qnil;
c48f61ef 4906 buffer_defaults.mark_active = Qnil;
be9aafdd 4907 buffer_defaults.file_format = Qnil;
2eec3b4e
RS
4908 buffer_defaults.overlays_before = Qnil;
4909 buffer_defaults.overlays_after = Qnil;
bbbe9545 4910 XSETFASTINT (buffer_defaults.overlay_center, BEG);
1ab256cb 4911
8d7a4592 4912 XSETFASTINT (buffer_defaults.tab_width, 8);
1ab256cb
RM
4913 buffer_defaults.truncate_lines = Qnil;
4914 buffer_defaults.ctl_arrow = Qt;
3b06f880 4915 buffer_defaults.direction_reversed = Qnil;
bb2ec976 4916 buffer_defaults.cursor_type = Qt;
a3bbced0 4917 buffer_defaults.extra_line_spacing = Qnil;
1ab256cb 4918
f7975d07 4919#ifdef DOS_NT
0776cb1b 4920 buffer_defaults.buffer_file_type = Qnil; /* TEXT */
54ad07d3 4921#endif
a1a17b61 4922 buffer_defaults.enable_multibyte_characters = Qt;
c71b5d9b 4923 buffer_defaults.buffer_file_coding_system = Qnil;
8d7a4592
KH
4924 XSETFASTINT (buffer_defaults.fill_column, 70);
4925 XSETFASTINT (buffer_defaults.left_margin, 0);
28e969dd 4926 buffer_defaults.cache_long_line_scans = Qnil;
f6ed2e84 4927 buffer_defaults.file_truename = Qnil;
7962a441 4928 XSETFASTINT (buffer_defaults.display_count, 0);
0552666b
GM
4929 buffer_defaults.indicate_empty_lines = Qnil;
4930 buffer_defaults.scroll_up_aggressively = Qnil;
4931 buffer_defaults.scroll_down_aggressively = Qnil;
3fd364db 4932 buffer_defaults.display_time = Qnil;
1ab256cb
RM
4933
4934 /* Assign the local-flags to the slots that have default values.
4935 The local flag is a bit that is used in the buffer
4936 to say that it has its own local value for the slot.
4937 The local flag bits are in the local_var_flags slot of the buffer. */
4938
4939 /* Nothing can work if this isn't true */
4d2f1389 4940 if (sizeof (EMACS_INT) != sizeof (Lisp_Object)) abort ();
1ab256cb
RM
4941
4942 /* 0 means not a lisp var, -1 means always local, else mask */
4943 bzero (&buffer_local_flags, sizeof buffer_local_flags);
aab80822
KH
4944 XSETINT (buffer_local_flags.filename, -1);
4945 XSETINT (buffer_local_flags.directory, -1);
4946 XSETINT (buffer_local_flags.backed_up, -1);
4947 XSETINT (buffer_local_flags.save_length, -1);
4948 XSETINT (buffer_local_flags.auto_save_file_name, -1);
4949 XSETINT (buffer_local_flags.read_only, -1);
4950 XSETINT (buffer_local_flags.major_mode, -1);
4951 XSETINT (buffer_local_flags.mode_name, -1);
4952 XSETINT (buffer_local_flags.undo_list, -1);
4953 XSETINT (buffer_local_flags.mark_active, -1);
943e065b 4954 XSETINT (buffer_local_flags.point_before_scroll, -1);
f6ed2e84 4955 XSETINT (buffer_local_flags.file_truename, -1);
3cb719bd 4956 XSETINT (buffer_local_flags.invisibility_spec, -1);
55ac8536 4957 XSETINT (buffer_local_flags.file_format, -1);
7962a441 4958 XSETINT (buffer_local_flags.display_count, -1);
3fd364db 4959 XSETINT (buffer_local_flags.display_time, -1);
1bf08baf 4960 XSETINT (buffer_local_flags.enable_multibyte_characters, -1);
8d7a4592 4961
7c02e886
GM
4962 idx = 1;
4963 XSETFASTINT (buffer_local_flags.mode_line_format, idx); ++idx;
4964 XSETFASTINT (buffer_local_flags.abbrev_mode, idx); ++idx;
4965 XSETFASTINT (buffer_local_flags.overwrite_mode, idx); ++idx;
4966 XSETFASTINT (buffer_local_flags.case_fold_search, idx); ++idx;
4967 XSETFASTINT (buffer_local_flags.auto_fill_function, idx); ++idx;
4968 XSETFASTINT (buffer_local_flags.selective_display, idx); ++idx;
1ab256cb 4969#ifndef old
7c02e886 4970 XSETFASTINT (buffer_local_flags.selective_display_ellipses, idx); ++idx;
1ab256cb 4971#endif
7c02e886
GM
4972 XSETFASTINT (buffer_local_flags.tab_width, idx); ++idx;
4973 XSETFASTINT (buffer_local_flags.truncate_lines, idx); ++idx;
4974 XSETFASTINT (buffer_local_flags.ctl_arrow, idx); ++idx;
4975 XSETFASTINT (buffer_local_flags.fill_column, idx); ++idx;
4976 XSETFASTINT (buffer_local_flags.left_margin, idx); ++idx;
4977 XSETFASTINT (buffer_local_flags.abbrev_table, idx); ++idx;
4978 XSETFASTINT (buffer_local_flags.display_table, idx); ++idx;
f7975d07 4979#ifdef DOS_NT
7c02e886 4980 XSETFASTINT (buffer_local_flags.buffer_file_type, idx);
13de9290 4981 /* Make this one a permanent local. */
7c02e886 4982 buffer_permanent_local_flags[idx++] = 1;
54ad07d3 4983#endif
7c02e886
GM
4984 XSETFASTINT (buffer_local_flags.syntax_table, idx); ++idx;
4985 XSETFASTINT (buffer_local_flags.cache_long_line_scans, idx); ++idx;
4986 XSETFASTINT (buffer_local_flags.category_table, idx); ++idx;
4987 XSETFASTINT (buffer_local_flags.direction_reversed, idx); ++idx;
177c0ea7 4988 XSETFASTINT (buffer_local_flags.buffer_file_coding_system, idx);
a1a17b61 4989 /* Make this one a permanent local. */
7c02e886
GM
4990 buffer_permanent_local_flags[idx++] = 1;
4991 XSETFASTINT (buffer_local_flags.left_margin_width, idx); ++idx;
4992 XSETFASTINT (buffer_local_flags.right_margin_width, idx); ++idx;
4993 XSETFASTINT (buffer_local_flags.indicate_empty_lines, idx); ++idx;
4994 XSETFASTINT (buffer_local_flags.scroll_up_aggressively, idx); ++idx;
4995 XSETFASTINT (buffer_local_flags.scroll_down_aggressively, idx); ++idx;
4996 XSETFASTINT (buffer_local_flags.header_line_format, idx); ++idx;
bd96bd79 4997 XSETFASTINT (buffer_local_flags.cursor_type, idx); ++idx;
a3bbced0 4998 XSETFASTINT (buffer_local_flags.extra_line_spacing, idx); ++idx;
7c02e886
GM
4999
5000 /* Need more room? */
7313acd0 5001 if (idx >= MAX_PER_BUFFER_VARS)
7c02e886 5002 abort ();
7313acd0 5003 last_per_buffer_idx = idx;
177c0ea7 5004
1ab256cb
RM
5005 Vbuffer_alist = Qnil;
5006 current_buffer = 0;
5007 all_buffers = 0;
5008
5009 QSFundamental = build_string ("Fundamental");
5010
5011 Qfundamental_mode = intern ("fundamental-mode");
5012 buffer_defaults.major_mode = Qfundamental_mode;
5013
5014 Qmode_class = intern ("mode-class");
5015
5016 Qprotected_field = intern ("protected-field");
5017
5018 Qpermanent_local = intern ("permanent-local");
5019
5020 Qkill_buffer_hook = intern ("kill-buffer-hook");
5021
48265e61
DL
5022 Qucs_set_table_for_input = intern ("ucs-set-table-for-input");
5023
1ab256cb 5024 Vprin1_to_string_buffer = Fget_buffer_create (build_string (" prin1"));
000f8083 5025
1ab256cb
RM
5026 /* super-magic invisible buffer */
5027 Vbuffer_alist = Qnil;
5028
ffd56f97 5029 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
7775635d
KH
5030
5031 inhibit_modification_hooks = 0;
1ab256cb
RM
5032}
5033
dfcf069d 5034void
1ab256cb
RM
5035init_buffer ()
5036{
93c27ef1 5037 char buf[MAXPATHLEN + 1];
2381d133
JB
5038 char *pwd;
5039 struct stat dotstat, pwdstat;
136351b7 5040 Lisp_Object temp;
f7975d07 5041 int rc;
1ab256cb 5042
b86af064 5043#ifdef USE_MMAP_FOR_BUFFERS
93c27ef1
GM
5044 {
5045 /* When using the ralloc implementation based on mmap(2), buffer
5046 text pointers will have been set to null in the dumped Emacs.
5047 Map new memory. */
5048 struct buffer *b;
177c0ea7 5049
93c27ef1
GM
5050 for (b = all_buffers; b; b = b->next)
5051 if (b->text->beg == NULL)
b86af064 5052 enlarge_buffer_text (b, 0);
93c27ef1 5053 }
b86af064 5054#endif /* USE_MMAP_FOR_BUFFERS */
177c0ea7 5055
1ab256cb 5056 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
3d871c85
RS
5057 if (NILP (buffer_defaults.enable_multibyte_characters))
5058 Fset_buffer_multibyte (Qnil);
2381d133 5059
314dbe9a
PE
5060 /* If PWD is accurate, use it instead of calling getwd. PWD is
5061 sometimes a nicer name, and using it may avoid a fatal error if a
5062 parent directory is searchable but not readable. */
309f2a6e
RS
5063 if ((pwd = getenv ("PWD")) != 0
5064 && (IS_DIRECTORY_SEP (*pwd) || (*pwd && IS_DEVICE_SEP (pwd[1])))
2381d133
JB
5065 && stat (pwd, &pwdstat) == 0
5066 && stat (".", &dotstat) == 0
5067 && dotstat.st_ino == pwdstat.st_ino
5068 && dotstat.st_dev == pwdstat.st_dev
5069 && strlen (pwd) < MAXPATHLEN)
5070 strcpy (buf, pwd);
6335beb0
RS
5071#ifdef HAVE_GETCWD
5072 else if (getcwd (buf, MAXPATHLEN+1) == 0)
9dde47f5 5073 fatal ("`getcwd' failed: %s\n", strerror (errno));
6335beb0 5074#else
2381d133 5075 else if (getwd (buf) == 0)
cf1e6391 5076 fatal ("`getwd' failed: %s\n", buf);
6335beb0 5077#endif
1ab256cb
RM
5078
5079#ifndef VMS
5080 /* Maybe this should really use some standard subroutine
5081 whose definition is filename syntax dependent. */
f7975d07
RS
5082 rc = strlen (buf);
5083 if (!(IS_DIRECTORY_SEP (buf[rc - 1])))
5084 {
5085 buf[rc] = DIRECTORY_SEP;
5086 buf[rc + 1] = '\0';
5087 }
1ab256cb 5088#endif /* not VMS */
0995fa35 5089
1ab256cb 5090 current_buffer->directory = build_string (buf);
136351b7 5091
0995fa35
RS
5092 /* Add /: to the front of the name
5093 if it would otherwise be treated as magic. */
5094 temp = Ffind_file_name_handler (current_buffer->directory, Qt);
81ab2e07
KH
5095 if (! NILP (temp)
5096 /* If the default dir is just /, TEMP is non-nil
5097 because of the ange-ftp completion handler.
5098 However, it is not necessary to turn / into /:/.
5099 So avoid doing that. */
d5db4077 5100 && strcmp ("/", SDATA (current_buffer->directory)))
0995fa35
RS
5101 current_buffer->directory
5102 = concat2 (build_string ("/:"), current_buffer->directory);
5103
136351b7
RS
5104 temp = get_minibuffer (0);
5105 XBUFFER (temp)->directory = current_buffer->directory;
1ab256cb
RM
5106}
5107
5108/* initialize the buffer routines */
dfcf069d 5109void
1ab256cb
RM
5110syms_of_buffer ()
5111{
9115729e
KH
5112 staticpro (&last_overlay_modification_hooks);
5113 last_overlay_modification_hooks
5114 = Fmake_vector (make_number (10), Qnil);
5115
1ab256cb
RM
5116 staticpro (&Vbuffer_defaults);
5117 staticpro (&Vbuffer_local_symbols);
5118 staticpro (&Qfundamental_mode);
5119 staticpro (&Qmode_class);
5120 staticpro (&QSFundamental);
5121 staticpro (&Vbuffer_alist);
5122 staticpro (&Qprotected_field);
5123 staticpro (&Qpermanent_local);
5124 staticpro (&Qkill_buffer_hook);
22378665 5125 Qoverlayp = intern ("overlayp");
52f8ec73 5126 staticpro (&Qoverlayp);
9d7608b7
KH
5127 Qevaporate = intern ("evaporate");
5128 staticpro (&Qevaporate);
294d215f 5129 Qmodification_hooks = intern ("modification-hooks");
22378665 5130 staticpro (&Qmodification_hooks);
294d215f 5131 Qinsert_in_front_hooks = intern ("insert-in-front-hooks");
22378665 5132 staticpro (&Qinsert_in_front_hooks);
294d215f 5133 Qinsert_behind_hooks = intern ("insert-behind-hooks");
22378665 5134 staticpro (&Qinsert_behind_hooks);
5fe0b67e 5135 Qget_file_buffer = intern ("get-file-buffer");
22378665 5136 staticpro (&Qget_file_buffer);
5985d248
KH
5137 Qpriority = intern ("priority");
5138 staticpro (&Qpriority);
5139 Qwindow = intern ("window");
5140 staticpro (&Qwindow);
bbbe9545
KH
5141 Qbefore_string = intern ("before-string");
5142 staticpro (&Qbefore_string);
5143 Qafter_string = intern ("after-string");
5144 staticpro (&Qafter_string);
22378665
RS
5145 Qfirst_change_hook = intern ("first-change-hook");
5146 staticpro (&Qfirst_change_hook);
5147 Qbefore_change_functions = intern ("before-change-functions");
5148 staticpro (&Qbefore_change_functions);
5149 Qafter_change_functions = intern ("after-change-functions");
5150 staticpro (&Qafter_change_functions);
48265e61 5151 staticpro (&Qucs_set_table_for_input);
1ab256cb 5152
5b20caf0
RS
5153 Qkill_buffer_query_functions = intern ("kill-buffer-query-functions");
5154 staticpro (&Qkill_buffer_query_functions);
5155
1ab256cb
RM
5156 Fput (Qprotected_field, Qerror_conditions,
5157 Fcons (Qprotected_field, Fcons (Qerror, Qnil)));
5158 Fput (Qprotected_field, Qerror_message,
5159 build_string ("Attempt to modify a protected field"));
5160
5161 /* All these use DEFVAR_LISP_NOPRO because the slots in
5162 buffer_defaults will all be marked via Vbuffer_defaults. */
5163
5164 DEFVAR_LISP_NOPRO ("default-mode-line-format",
7ee72033
MB
5165 &buffer_defaults.mode_line_format,
5166 doc: /* Default value of `mode-line-format' for buffers that don't override it.
018ba359 5167This is the same as (default-value 'mode-line-format). */);
1ab256cb 5168
045dee35 5169 DEFVAR_LISP_NOPRO ("default-header-line-format",
7ee72033
MB
5170 &buffer_defaults.header_line_format,
5171 doc: /* Default value of `header-line-format' for buffers that don't override it.
018ba359 5172This is the same as (default-value 'header-line-format). */);
0552666b 5173
7ee72033
MB
5174 DEFVAR_LISP_NOPRO ("default-cursor-type", &buffer_defaults.cursor_type,
5175 doc: /* Default value of `cursor-type' for buffers that don't override it.
018ba359 5176This is the same as (default-value 'cursor-type). */);
bd96bd79 5177
a3bbced0 5178 DEFVAR_LISP_NOPRO ("default-line-spacing",
7ee72033
MB
5179 &buffer_defaults.extra_line_spacing,
5180 doc: /* Default value of `line-spacing' for buffers that don't override it.
018ba359 5181This is the same as (default-value 'line-spacing). */);
a3bbced0 5182
1ab256cb 5183 DEFVAR_LISP_NOPRO ("default-abbrev-mode",
efc7e75f 5184 &buffer_defaults.abbrev_mode,
7ee72033 5185 doc: /* Default value of `abbrev-mode' for buffers that do not override it.
018ba359 5186This is the same as (default-value 'abbrev-mode). */);
1ab256cb
RM
5187
5188 DEFVAR_LISP_NOPRO ("default-ctl-arrow",
efc7e75f 5189 &buffer_defaults.ctl_arrow,
7ee72033 5190 doc: /* Default value of `ctl-arrow' for buffers that do not override it.
018ba359 5191This is the same as (default-value 'ctl-arrow). */);
1ab256cb 5192
3b06f880 5193 DEFVAR_LISP_NOPRO ("default-direction-reversed",
efc7e75f 5194 &buffer_defaults.direction_reversed,
7ee72033 5195 doc: /* Default value of `direction_reversed' for buffers that do not override it.
018ba359 5196This is the same as (default-value 'direction-reversed). */);
177c0ea7 5197
a1a17b61 5198 DEFVAR_LISP_NOPRO ("default-enable-multibyte-characters",
efc7e75f 5199 &buffer_defaults.enable_multibyte_characters,
7ee72033 5200 doc: /* *Default value of `enable-multibyte-characters' for buffers not overriding it.
018ba359 5201This is the same as (default-value 'enable-multibyte-characters). */);
177c0ea7 5202
c71b5d9b 5203 DEFVAR_LISP_NOPRO ("default-buffer-file-coding-system",
efc7e75f 5204 &buffer_defaults.buffer_file_coding_system,
7ee72033 5205 doc: /* Default value of `buffer-file-coding-system' for buffers not overriding it.
018ba359 5206This is the same as (default-value 'buffer-file-coding-system). */);
177c0ea7 5207
1ab256cb 5208 DEFVAR_LISP_NOPRO ("default-truncate-lines",
efc7e75f
PJ
5209 &buffer_defaults.truncate_lines,
5210 doc: /* Default value of `truncate-lines' for buffers that do not override it.
018ba359 5211This is the same as (default-value 'truncate-lines). */);
1ab256cb
RM
5212
5213 DEFVAR_LISP_NOPRO ("default-fill-column",
efc7e75f
PJ
5214 &buffer_defaults.fill_column,
5215 doc: /* Default value of `fill-column' for buffers that do not override it.
018ba359 5216This is the same as (default-value 'fill-column). */);
1ab256cb
RM
5217
5218 DEFVAR_LISP_NOPRO ("default-left-margin",
efc7e75f
PJ
5219 &buffer_defaults.left_margin,
5220 doc: /* Default value of `left-margin' for buffers that do not override it.
018ba359 5221This is the same as (default-value 'left-margin). */);
1ab256cb
RM
5222
5223 DEFVAR_LISP_NOPRO ("default-tab-width",
7ee72033
MB
5224 &buffer_defaults.tab_width,
5225 doc: /* Default value of `tab-width' for buffers that do not override it.
018ba359 5226This is the same as (default-value 'tab-width). */);
1ab256cb
RM
5227
5228 DEFVAR_LISP_NOPRO ("default-case-fold-search",
efc7e75f
PJ
5229 &buffer_defaults.case_fold_search,
5230 doc: /* Default value of `case-fold-search' for buffers that don't override it.
018ba359 5231This is the same as (default-value 'case-fold-search). */);
1ab256cb 5232
f7975d07 5233#ifdef DOS_NT
177c0ea7 5234 DEFVAR_LISP_NOPRO ("default-buffer-file-type",
7ee72033 5235 &buffer_defaults.buffer_file_type,
efc7e75f 5236 doc: /* Default file type for buffers that do not override it.
018ba359
PJ
5237This is the same as (default-value 'buffer-file-type).
5238The file type is nil for text, t for binary. */);
54ad07d3
RS
5239#endif
5240
0552666b 5241 DEFVAR_LISP_NOPRO ("default-left-margin-width",
efc7e75f
PJ
5242 &buffer_defaults.left_margin_width,
5243 doc: /* Default value of `left-margin-width' for buffers that don't override it.
018ba359 5244This is the same as (default-value 'left-margin-width). */);
0552666b
GM
5245
5246 DEFVAR_LISP_NOPRO ("default-right-margin-width",
efc7e75f
PJ
5247 &buffer_defaults.right_margin_width,
5248 doc: /* Default value of `right_margin_width' for buffers that don't override it.
018ba359 5249This is the same as (default-value 'right-margin-width). */);
177c0ea7 5250
0552666b 5251 DEFVAR_LISP_NOPRO ("default-indicate-empty-lines",
efc7e75f
PJ
5252 &buffer_defaults.indicate_empty_lines,
5253 doc: /* Default value of `indicate-empty-lines' for buffers that don't override it.
018ba359 5254This is the same as (default-value 'indicate-empty-lines). */);
177c0ea7 5255
0552666b 5256 DEFVAR_LISP_NOPRO ("default-scroll-up-aggressively",
efc7e75f 5257 &buffer_defaults.scroll_up_aggressively,
7614d762
RS
5258 doc: /* Default value of `scroll-up-aggressively'.
5259This value applies in buffers that don't have their own local values.
5260This variable is an alias for (default-value 'scroll-up-aggressively). */);
177c0ea7 5261
0552666b 5262 DEFVAR_LISP_NOPRO ("default-scroll-down-aggressively",
efc7e75f 5263 &buffer_defaults.scroll_down_aggressively,
7614d762
RS
5264 doc: /* Default value of `scroll-down-aggressively'.
5265This value applies in buffers that don't have their own local values.
5266This variable is an alias for (default-value 'scroll-down-aggressively). */);
177c0ea7 5267
045dee35 5268 DEFVAR_PER_BUFFER ("header-line-format",
018ba359 5269 &current_buffer->header_line_format,
7ee72033 5270 Qnil,
7614d762
RS
5271 doc: /* Analogous to `mode-line-format', but controls the header line.
5272The header line appears, optionally, at the top of a window;
5273the mode line appears at the bottom. */);
177c0ea7 5274
1ab256cb 5275 DEFVAR_PER_BUFFER ("mode-line-format", &current_buffer->mode_line_format,
efc7e75f
PJ
5276 Qnil,
5277 doc: /* Template for displaying mode line for current buffer.
018ba359
PJ
5278Each buffer has its own value of this variable.
5279Value may be nil, a string, a symbol or a list or cons cell.
5280A value of nil means don't display a mode line.
5281For a symbol, its value is used (but it is ignored if t or nil).
5282 A string appearing directly as the value of a symbol is processed verbatim
5283 in that the %-constructs below are not recognized.
ed463255 5284 Note that unless the symbol is marked as a `risky-local-variable', all
177c0ea7 5285 properties in any strings, as well as all :eval and :propertize forms
ed463255 5286 in the value of that symbol will be ignored.
018ba359 5287For a list of the form `(:eval FORM)', FORM is evaluated and the result
9c3eecf3
RS
5288 is used as a mode line element. Be careful--FORM should not load any files,
5289 because that can cause an infinite recursion.
ed463255
KS
5290For a list of the form `(:propertize ELT PROPS...)', ELT is displayed
5291 with the specified properties PROPS applied.
018ba359
PJ
5292For a list whose car is a symbol, the symbol's value is taken,
5293 and if that is non-nil, the cadr of the list is processed recursively.
5294 Otherwise, the caddr of the list (if there is one) is processed.
5295For a list whose car is a string or list, each element is processed
5296 recursively and the results are effectively concatenated.
5297For a list whose car is an integer, the cdr of the list is processed
5298 and padded (if the number is positive) or truncated (if negative)
5299 to the width specified by that number.
5300A string is printed verbatim in the mode line except for %-constructs:
5301 (%-constructs are allowed when the string is the entire mode-line-format
5302 or when it is found in a cons-cell or a list)
5303 %b -- print buffer name. %f -- print visited file name.
5304 %F -- print frame name.
5305 %* -- print %, * or hyphen. %+ -- print *, % or hyphen.
5306 %& is like %*, but ignore read-only-ness.
5307 % means buffer is read-only and * means it is modified.
5308 For a modified read-only buffer, %* gives % and %+ gives *.
5309 %s -- print process status. %l -- print the current line number.
5310 %c -- print the current column number (this makes editing slower).
5311 To make the column number update correctly in all cases,
5312 `column-number-mode' must be non-nil.
5313 %p -- print percent of buffer above top of window, or Top, Bot or All.
5314 %P -- print percent of buffer above bottom of window, perhaps plus Top,
5315 or print Bottom or All.
5316 %m -- print the mode name.
5317 %n -- print Narrow if appropriate.
5318 %z -- print mnemonics of buffer, terminal, and keyboard coding systems.
5319 %Z -- like %z, but including the end-of-line format.
5320 %[ -- print one [ for each recursive editing level. %] similar.
5321 %% -- print %. %- -- print infinitely many dashes.
5322Decimal digits after the % specify field width to which to pad. */);
5323
7ee72033 5324 DEFVAR_LISP_NOPRO ("default-major-mode", &buffer_defaults.major_mode,
efc7e75f 5325 doc: /* *Major mode for new buffers. Defaults to `fundamental-mode'.
018ba359 5326nil here means use current buffer's major mode. */);
1ab256cb
RM
5327
5328 DEFVAR_PER_BUFFER ("major-mode", &current_buffer->major_mode,
7ee72033 5329 make_number (Lisp_Symbol),
efc7e75f 5330 doc: /* Symbol for current buffer's major mode. */);
1ab256cb
RM
5331
5332 DEFVAR_PER_BUFFER ("mode-name", &current_buffer->mode_name,
c01d0677 5333 Qnil,
efc7e75f 5334 doc: /* Pretty name of current buffer's major mode (a string). */);
1ab256cb 5335
7ee72033 5336 DEFVAR_PER_BUFFER ("abbrev-mode", &current_buffer->abbrev_mode, Qnil,
efc7e75f 5337 doc: /* Non-nil turns on automatic expansion of abbrevs as they are inserted. */);
1ab256cb
RM
5338
5339 DEFVAR_PER_BUFFER ("case-fold-search", &current_buffer->case_fold_search,
7ee72033 5340 Qnil,
efc7e75f 5341 doc: /* *Non-nil if searches and matches should ignore case. */);
1ab256cb
RM
5342
5343 DEFVAR_PER_BUFFER ("fill-column", &current_buffer->fill_column,
7ee72033 5344 make_number (Lisp_Int),
1ac5826d
RS
5345 doc: /* *Column beyond which automatic line-wrapping should happen.
5346Interactively, you can set this using \\[set-fill-column]. */);
1ab256cb
RM
5347
5348 DEFVAR_PER_BUFFER ("left-margin", &current_buffer->left_margin,
7ee72033 5349 make_number (Lisp_Int),
efc7e75f 5350 doc: /* *Column for the default indent-line-function to indent to.
018ba359 5351Linefeed indents to this column in Fundamental mode. */);
1ab256cb
RM
5352
5353 DEFVAR_PER_BUFFER ("tab-width", &current_buffer->tab_width,
7ee72033 5354 make_number (Lisp_Int),
efc7e75f 5355 doc: /* *Distance between tab stops (for display of tab characters), in columns. */);
1ab256cb 5356
7ee72033 5357 DEFVAR_PER_BUFFER ("ctl-arrow", &current_buffer->ctl_arrow, Qnil,
efc7e75f 5358 doc: /* *Non-nil means display control chars with uparrow.
018ba359
PJ
5359A value of nil means use backslash and octal digits.
5360This variable does not apply to characters whose display is specified
5361in the current display table (if there is one). */);
1ab256cb 5362
3b06f880 5363 DEFVAR_PER_BUFFER ("enable-multibyte-characters",
1bf08baf 5364 &current_buffer->enable_multibyte_characters,
a9b9a780 5365 Qnil,
efc7e75f 5366 doc: /* Non-nil means the buffer contents are regarded as multi-byte characters.
018ba359
PJ
5367Otherwise they are regarded as unibyte. This affects the display,
5368file I/O and the behavior of various editing commands.
5369
5370This variable is buffer-local but you cannot set it directly;
5371use the function `set-buffer-multibyte' to change a buffer's representation.
5372Changing its default value with `setq-default' is supported.
5373See also variable `default-enable-multibyte-characters' and Info node
5374`(elisp)Text Representations'. */);
a9b9a780 5375 XSYMBOL (intern ("enable-multibyte-characters"))->constant = 1;
3b06f880 5376
c71b5d9b 5377 DEFVAR_PER_BUFFER ("buffer-file-coding-system",
7ee72033 5378 &current_buffer->buffer_file_coding_system, Qnil,
efc7e75f 5379 doc: /* Coding system to be used for encoding the buffer contents on saving.
018ba359
PJ
5380This variable applies to saving the buffer, and also to `write-region'
5381and other functions that use `write-region'.
5382It does not apply to sending output to subprocesses, however.
5383
5384If this is nil, the buffer is saved without any code conversion
5385unless some coding system is specified in `file-coding-system-alist'
5386for the buffer file.
5387
31a6cb06
EZ
5388If the text to be saved cannot be encoded as specified by this variable,
5389an alternative encoding is selected by `select-safe-coding-system', which see.
5390
018ba359
PJ
5391The variable `coding-system-for-write', if non-nil, overrides this variable.
5392
5393This variable is never applied to a way of decoding a file while reading it. */);
c71b5d9b 5394
3b06f880 5395 DEFVAR_PER_BUFFER ("direction-reversed", &current_buffer->direction_reversed,
7ee72033 5396 Qnil,
efc7e75f 5397 doc: /* *Non-nil means lines in the buffer are displayed right to left. */);
3b06f880 5398
7ee72033 5399 DEFVAR_PER_BUFFER ("truncate-lines", &current_buffer->truncate_lines, Qnil,
7614d762
RS
5400 doc: /* *Non-nil means do not display continuation lines.
5401Instead, give each line of text just one screen line.
018ba359
PJ
5402
5403Note that this is overridden by the variable
5404`truncate-partial-width-windows' if that variable is non-nil
5405and this buffer is not full-frame width. */);
1ab256cb 5406
f7975d07 5407#ifdef DOS_NT
54ad07d3 5408 DEFVAR_PER_BUFFER ("buffer-file-type", &current_buffer->buffer_file_type,
7ee72033 5409 Qnil,
efc7e75f 5410 doc: /* Non-nil if the visited file is a binary file.
018ba359
PJ
5411This variable is meaningful on MS-DOG and Windows NT.
5412On those systems, it is automatically local in every buffer.
5413On other systems, this variable is normally always nil. */);
54ad07d3
RS
5414#endif
5415
1ab256cb 5416 DEFVAR_PER_BUFFER ("default-directory", &current_buffer->directory,
7ee72033 5417 make_number (Lisp_String),
efc7e75f 5418 doc: /* Name of default directory of current buffer. Should end with slash.
018ba359 5419To interactively change the default directory, use command `cd'. */);
1ab256cb
RM
5420
5421 DEFVAR_PER_BUFFER ("auto-fill-function", &current_buffer->auto_fill_function,
7ee72033 5422 Qnil,
efc7e75f 5423 doc: /* Function called (if non-nil) to perform auto-fill.
018ba359
PJ
5424It is called after self-inserting any character specified in
5425the `auto-fill-chars' table.
5426NOTE: This variable is not a hook;
5427its value may not be a list of functions. */);
1ab256cb
RM
5428
5429 DEFVAR_PER_BUFFER ("buffer-file-name", &current_buffer->filename,
7ee72033 5430 make_number (Lisp_String),
efc7e75f 5431 doc: /* Name of file visited in current buffer, or nil if not visiting a file. */);
1ab256cb 5432
f6ed2e84 5433 DEFVAR_PER_BUFFER ("buffer-file-truename", &current_buffer->file_truename,
7ee72033 5434 make_number (Lisp_String),
efc7e75f 5435 doc: /* Abbreviated truename of file visited in current buffer, or nil if none.
018ba359
PJ
5436The truename of a file is calculated by `file-truename'
5437and then abbreviated with `abbreviate-file-name'. */);
f6ed2e84 5438
1ab256cb 5439 DEFVAR_PER_BUFFER ("buffer-auto-save-file-name",
3f5fcd47 5440 &current_buffer->auto_save_file_name,
7ee72033 5441 make_number (Lisp_String),
7614d762
RS
5442 doc: /* Name of file for auto-saving current buffer.
5443If it is nil, that means don't auto-save this buffer. */);
1ab256cb 5444
7ee72033 5445 DEFVAR_PER_BUFFER ("buffer-read-only", &current_buffer->read_only, Qnil,
efc7e75f 5446 doc: /* Non-nil if this buffer is read-only. */);
1ab256cb 5447
7ee72033 5448 DEFVAR_PER_BUFFER ("buffer-backed-up", &current_buffer->backed_up, Qnil,
efc7e75f 5449 doc: /* Non-nil if this buffer's file has been backed up.
018ba359 5450Backing up is done before the first time the file is saved. */);
1ab256cb
RM
5451
5452 DEFVAR_PER_BUFFER ("buffer-saved-size", &current_buffer->save_length,
7ee72033 5453 make_number (Lisp_Int),
efc7e75f 5454 doc: /* Length of current buffer when last read in, saved or auto-saved.
018ba359 54550 initially. */);
1ab256cb
RM
5456
5457 DEFVAR_PER_BUFFER ("selective-display", &current_buffer->selective_display,
7ee72033 5458 Qnil,
7614d762
RS
5459 doc: /* Non-nil enables selective display.
5460An Integer N as value means display only lines
5461that start with less than n columns of space.
5462A value of t means that the character ^M makes itself and
5463all the rest of the line invisible; also, when saving the buffer
5464in a file, save the ^M as a newline. */);
1ab256cb
RM
5465
5466#ifndef old
5467 DEFVAR_PER_BUFFER ("selective-display-ellipses",
5468 &current_buffer->selective_display_ellipses,
7ee72033 5469 Qnil,
3f676284 5470 doc: /* Non-nil means display ... on previous line when a line is invisible. */);
1ab256cb
RM
5471#endif
5472
7ee72033 5473 DEFVAR_PER_BUFFER ("overwrite-mode", &current_buffer->overwrite_mode, Qnil,
efc7e75f 5474 doc: /* Non-nil if self-insertion should replace existing text.
018ba359
PJ
5475The value should be one of `overwrite-mode-textual',
5476`overwrite-mode-binary', or nil.
5477If it is `overwrite-mode-textual', self-insertion still
5478inserts at the end of a line, and inserts when point is before a tab,
5479until the tab is filled in.
5480If `overwrite-mode-binary', self-insertion replaces newlines and tabs too. */);
5481
54939090 5482 DEFVAR_PER_BUFFER ("buffer-display-table", &current_buffer->display_table,
7ee72033 5483 Qnil,
efc7e75f 5484 doc: /* Display table that controls display of the contents of current buffer.
018ba359
PJ
5485
5486If this variable is nil, the value of `standard-display-table' is used.
5487Each window can have its own, overriding display table, see
5488`set-window-display-table' and `window-display-table'.
5489
5490The display table is a char-table created with `make-display-table'.
5491A char-table is an array indexed by character codes. Normal array
5492primitives `aref' and `aset' can be used to access elements of a char-table.
5493
5494Each of the char-table elements control how to display the corresponding
5495text character: the element at index C in the table says how to display
5496the character whose code is C. Each element should be a vector of
5497characters or nil. nil means display the character in the default fashion;
5498otherwise, the characters from the vector are delivered to the screen
5499instead of the original character.
5500
5501For example, (aset buffer-display-table ?X ?Y) will cause Emacs to display
5502a capital Y instead of each X character.
5503
5504In addition, a char-table has six extra slots to control the display of:
5505
5506 the end of a truncated screen line (extra-slot 0, a single character);
5507 the end of a continued line (extra-slot 1, a single character);
5508 the escape character used to display character codes in octal
5509 (extra-slot 2, a single character);
5510 the character used as an arrow for control characters (extra-slot 3,
5511 a single character);
5512 the decoration indicating the presence of invisible lines (extra-slot 4,
5513 a vector of characters);
5514 the character used to draw the border between side-by-side windows
5515 (extra-slot 5, a single character).
5516
5517See also the functions `display-table-slot' and `set-display-table-slot'. */);
1ab256cb 5518
0552666b 5519 DEFVAR_PER_BUFFER ("left-margin-width", &current_buffer->left_margin_width,
7ee72033 5520 Qnil,
efc7e75f 5521 doc: /* *Width of left marginal area for display of a buffer.
018ba359 5522A value of nil means no marginal area. */);
177c0ea7 5523
0552666b 5524 DEFVAR_PER_BUFFER ("right-margin-width", &current_buffer->right_margin_width,
7ee72033 5525 Qnil,
efc7e75f 5526 doc: /* *Width of right marginal area for display of a buffer.
018ba359 5527A value of nil means no marginal area. */);
177c0ea7 5528
0552666b 5529 DEFVAR_PER_BUFFER ("indicate-empty-lines",
7ee72033 5530 &current_buffer->indicate_empty_lines, Qnil,
efc7e75f 5531 doc: /* *Visually indicate empty lines after the buffer end.
018ba359
PJ
5532If non-nil, a bitmap is displayed in the left fringe of a window on
5533window-systems. */);
177c0ea7 5534
0552666b 5535 DEFVAR_PER_BUFFER ("scroll-up-aggressively",
7ee72033 5536 &current_buffer->scroll_up_aggressively, Qnil,
4e0692c1
RS
5537 doc: /* How far to scroll windows upward.
5538If you move point off the bottom, the window scrolls automatically.
5539This variable controls how far it scrolls. nil, the default,
5540means scroll to center point. A fraction means scroll to put point
5541that fraction of the window's height from the bottom of the window.
5542When the value is 0.0, point goes at the bottom line, which in the simple
5543case that you moved off with C-f means scrolling just one line. 1.0 means
5544point goes at the top, so that in that simple case, the window
5545window scrolls by a full window height. Meaningful values are
175e9712 5546between 0.0 and 1.0, inclusive. */);
177c0ea7 5547
0552666b 5548 DEFVAR_PER_BUFFER ("scroll-down-aggressively",
7ee72033 5549 &current_buffer->scroll_down_aggressively, Qnil,
4e0692c1
RS
5550 doc: /* How far to scroll windows downward.
5551If you move point off the top, the window scrolls automatically.
5552This variable controls how far it scrolls. nil, the default,
5553means scroll to center point. A fraction means scroll to put point
5554that fraction of the window's height from the top of the window.
5555When the value is 0.0, point goes at the top line, which in the simple
5556case that you moved off with C-b means scrolling just one line. 1.0 means
5557point goes at the bottom, so that in that simple case, the window
5558window scrolls by a full window height. Meaningful values are
175e9712 5559between 0.0 and 1.0, inclusive. */);
177c0ea7 5560
1ab256cb
RM
5561/*DEFVAR_LISP ("debug-check-symbol", &Vcheck_symbol,
5562 "Don't ask.");
5563*/
1ab256cb 5564
7ee72033
MB
5565 DEFVAR_LISP ("before-change-functions", &Vbefore_change_functions,
5566 doc: /* List of functions to call before each text change.
018ba359
PJ
5567Two arguments are passed to each function: the positions of
5568the beginning and end of the range of old text to be changed.
5569\(For an insertion, the beginning and end are at the same place.)
5570No information is given about the length of the text after the change.
5571
5572Buffer changes made while executing the `before-change-functions'
5573don't call any before-change or after-change functions.
5574That's because these variables are temporarily set to nil.
5575As a result, a hook function cannot straightforwardly alter the value of
5576these variables. See the Emacs Lisp manual for a way of
5577accomplishing an equivalent result by using other variables.
5578
5579If an unhandled error happens in running these functions,
5580the variable's value remains nil. That prevents the error
5581from happening repeatedly and making Emacs nonfunctional. */);
5f079267
RS
5582 Vbefore_change_functions = Qnil;
5583
7ee72033 5584 DEFVAR_LISP ("after-change-functions", &Vafter_change_functions,
eacdfade 5585 doc: /* List of functions to call after each text change.
018ba359
PJ
5586Three arguments are passed to each function: the positions of
5587the beginning and end of the range of changed text,
5588and the length in bytes of the pre-change text replaced by that range.
5589\(For an insertion, the pre-change length is zero;
5590for a deletion, that length is the number of bytes deleted,
5591and the post-change beginning and end are at the same place.)
5592
5593Buffer changes made while executing the `after-change-functions'
5594don't call any before-change or after-change functions.
5595That's because these variables are temporarily set to nil.
5596As a result, a hook function cannot straightforwardly alter the value of
5597these variables. See the Emacs Lisp manual for a way of
5598accomplishing an equivalent result by using other variables.
5599
5600If an unhandled error happens in running these functions,
5601the variable's value remains nil. That prevents the error
5602from happening repeatedly and making Emacs nonfunctional. */);
5f079267
RS
5603 Vafter_change_functions = Qnil;
5604
7ee72033 5605 DEFVAR_LISP ("first-change-hook", &Vfirst_change_hook,
efc7e75f 5606 doc: /* A list of functions to call before changing a buffer which is unmodified.
018ba359 5607The functions are run using the `run-hooks' function. */);
dbc4e1c1 5608 Vfirst_change_hook = Qnil;
1ab256cb 5609
7ee72033
MB
5610 DEFVAR_PER_BUFFER ("buffer-undo-list", &current_buffer->undo_list, Qnil,
5611 doc: /* List of undo entries in current buffer.
018ba359
PJ
5612Recent changes come first; older changes follow newer.
5613
5614An entry (BEG . END) represents an insertion which begins at
5615position BEG and ends at position END.
5616
5617An entry (TEXT . POSITION) represents the deletion of the string TEXT
5618from (abs POSITION). If POSITION is positive, point was at the front
5619of the text being deleted; if negative, point was at the end.
5620
5621An entry (t HIGH . LOW) indicates that the buffer previously had
5622\"unmodified\" status. HIGH and LOW are the high and low 16-bit portions
5623of the visited file's modification time, as of that time. If the
5624modification time of the most recent save is different, this entry is
5625obsolete.
5626
5627An entry (nil PROPERTY VALUE BEG . END) indicates that a text property
5628was modified between BEG and END. PROPERTY is the property name,
5629and VALUE is the old value.
5630
5631An entry (MARKER . DISTANCE) indicates that the marker MARKER
5632was adjusted in position by the offset DISTANCE (an integer).
5633
5634An entry of the form POSITION indicates that point was at the buffer
5635location given by the integer. Undoing an entry of this form places
5636point at POSITION.
5637
5638nil marks undo boundaries. The undo command treats the changes
5639between two undo boundaries as a single step to be undone.
5640
5641If the value of the variable is t, undo information is not recorded. */);
5642
7ee72033
MB
5643 DEFVAR_PER_BUFFER ("mark-active", &current_buffer->mark_active, Qnil,
5644 doc: /* Non-nil means the mark and region are currently active in this buffer. */);
018ba359 5645
7ee72033
MB
5646 DEFVAR_PER_BUFFER ("cache-long-line-scans", &current_buffer->cache_long_line_scans, Qnil,
5647 doc: /* Non-nil means that Emacs should use caches to handle long lines more quickly.
018ba359
PJ
5648
5649Normally, the line-motion functions work by scanning the buffer for
5650newlines. Columnar operations (like move-to-column and
5651compute-motion) also work by scanning the buffer, summing character
5652widths as they go. This works well for ordinary text, but if the
5653buffer's lines are very long (say, more than 500 characters), these
5654motion functions will take longer to execute. Emacs may also take
5655longer to update the display.
5656
5657If cache-long-line-scans is non-nil, these motion functions cache the
5658results of their scans, and consult the cache to avoid rescanning
5659regions of the buffer until the text is modified. The caches are most
5660beneficial when they prevent the most searching---that is, when the
5661buffer contains long lines and large regions of characters with the
5662same, fixed screen width.
5663
5664When cache-long-line-scans is non-nil, processing short lines will
5665become slightly slower (because of the overhead of consulting the
5666cache), and the caches will use memory roughly proportional to the
5667number of newlines and characters whose screen width varies.
5668
5669The caches require no explicit maintenance; their accuracy is
5670maintained internally by the Emacs primitives. Enabling or disabling
5671the cache should not affect the behavior of any of the motion
5672functions; it should only affect their performance. */);
5673
7ee72033
MB
5674 DEFVAR_PER_BUFFER ("point-before-scroll", &current_buffer->point_before_scroll, Qnil,
5675 doc: /* Value of point before the last series of scroll operations, or nil. */);
018ba359 5676
7ee72033
MB
5677 DEFVAR_PER_BUFFER ("buffer-file-format", &current_buffer->file_format, Qnil,
5678 doc: /* List of formats to use when saving this buffer.
018ba359 5679Formats are defined by `format-alist'. This variable is
a9b9a780 5680set when a file is visited. */);
be9aafdd 5681
3cb719bd 5682 DEFVAR_PER_BUFFER ("buffer-invisibility-spec",
7ee72033
MB
5683 &current_buffer->invisibility_spec, Qnil,
5684 doc: /* Invisibility spec of this buffer.
018ba359
PJ
5685The default is t, which means that text is invisible
5686if it has a non-nil `invisible' property.
5687If the value is a list, a text character is invisible if its `invisible'
5688property is an element in that list.
5689If an element is a cons cell of the form (PROP . ELLIPSIS),
5690then characters with property value PROP are invisible,
5691and they have an ellipsis as well if ELLIPSIS is non-nil. */);
3cb719bd 5692
7962a441 5693 DEFVAR_PER_BUFFER ("buffer-display-count",
7ee72033
MB
5694 &current_buffer->display_count, Qnil,
5695 doc: /* A number incremented each time this buffer is displayed in a window.
018ba359 5696The function `set-window-buffer' increments it. */);
3fd364db
RS
5697
5698 DEFVAR_PER_BUFFER ("buffer-display-time",
7ee72033
MB
5699 &current_buffer->display_time, Qnil,
5700 doc: /* Time stamp updated each time this buffer is displayed in a window.
018ba359
PJ
5701The function `set-window-buffer' updates this variable
5702to the value obtained by calling `current-time'.
5703If the buffer has never been shown in a window, the value is nil. */);
5704
7ee72033
MB
5705 DEFVAR_LISP ("transient-mark-mode", &Vtransient_mark_mode,
5706 doc: /* *Non-nil means deactivate the mark when the buffer contents change.
018ba359
PJ
5707Non-nil also enables highlighting of the region whenever the mark is active.
5708The variable `highlight-nonselected-windows' controls whether to highlight
5709all windows or just the selected window. */);
c48f61ef
RS
5710 Vtransient_mark_mode = Qnil;
5711
7ee72033
MB
5712 DEFVAR_LISP ("inhibit-read-only", &Vinhibit_read_only,
5713 doc: /* *Non-nil means disregard read-only status of buffers or characters.
018ba359
PJ
5714If the value is t, disregard `buffer-read-only' and all `read-only'
5715text properties. If the value is a list, disregard `buffer-read-only'
5716and disregard a `read-only' text property if the property value
5717is a member of the list. */);
a96b68f1
RS
5718 Vinhibit_read_only = Qnil;
5719
7ee72033 5720 DEFVAR_PER_BUFFER ("cursor-type", &current_buffer->cursor_type, Qnil,
cd8d5236 5721 doc: /* Cursor to use when this buffer is in the selected window.
018ba359
PJ
5722Values are interpreted as follows:
5723
cd8d5236
RS
5724 t use the cursor specified for the frame
5725 nil don't display a cursor
5726 bar display a bar cursor with default width
5727 (bar . WIDTH) display a bar cursor with width WIDTH
5728 ANYTHING ELSE display a box cursor.
5729
5730When the buffer is displayed in a nonselected window,
5731this variable has no effect; the cursor appears as a hollow box. */);
bb2ec976 5732
a3bbced0 5733 DEFVAR_PER_BUFFER ("line-spacing",
7ee72033
MB
5734 &current_buffer->extra_line_spacing, Qnil,
5735 doc: /* Additional space to put between lines when displaying a buffer.
018ba359 5736The space is measured in pixels, and put below lines on window systems. */);
a3bbced0 5737
7ee72033 5738 DEFVAR_LISP ("kill-buffer-query-functions", &Vkill_buffer_query_functions,
efc7e75f 5739 doc: /* List of functions called with no args to query before killing a buffer. */);
dcdffbf6
RS
5740 Vkill_buffer_query_functions = Qnil;
5741
0dc88e60 5742 defsubr (&Sbuffer_live_p);
1ab256cb
RM
5743 defsubr (&Sbuffer_list);
5744 defsubr (&Sget_buffer);
5745 defsubr (&Sget_file_buffer);
5746 defsubr (&Sget_buffer_create);
336cd056 5747 defsubr (&Smake_indirect_buffer);
01050cb5 5748 defsubr (&Sgenerate_new_buffer_name);
1ab256cb
RM
5749 defsubr (&Sbuffer_name);
5750/*defsubr (&Sbuffer_number);*/
5751 defsubr (&Sbuffer_file_name);
336cd056 5752 defsubr (&Sbuffer_base_buffer);
79aa712d 5753 defsubr (&Sbuffer_local_value);
1ab256cb
RM
5754 defsubr (&Sbuffer_local_variables);
5755 defsubr (&Sbuffer_modified_p);
5756 defsubr (&Sset_buffer_modified_p);
5757 defsubr (&Sbuffer_modified_tick);
5758 defsubr (&Srename_buffer);
5759 defsubr (&Sother_buffer);
5760 defsubr (&Sbuffer_disable_undo);
5761 defsubr (&Sbuffer_enable_undo);
5762 defsubr (&Skill_buffer);
a9ee7a59 5763 defsubr (&Sset_buffer_major_mode);
1ab256cb
RM
5764 defsubr (&Sswitch_to_buffer);
5765 defsubr (&Spop_to_buffer);
5766 defsubr (&Scurrent_buffer);
5767 defsubr (&Sset_buffer);
5768 defsubr (&Sbarf_if_buffer_read_only);
5769 defsubr (&Sbury_buffer);
3ac81adb
RS
5770 defsubr (&Serase_buffer);
5771 defsubr (&Sset_buffer_multibyte);
1ab256cb 5772 defsubr (&Skill_all_local_variables);
2eec3b4e 5773
52f8ec73 5774 defsubr (&Soverlayp);
2eec3b4e
RS
5775 defsubr (&Smake_overlay);
5776 defsubr (&Sdelete_overlay);
5777 defsubr (&Smove_overlay);
8ebafa8d
JB
5778 defsubr (&Soverlay_start);
5779 defsubr (&Soverlay_end);
5780 defsubr (&Soverlay_buffer);
5781 defsubr (&Soverlay_properties);
2eec3b4e 5782 defsubr (&Soverlays_at);
74514898 5783 defsubr (&Soverlays_in);
2eec3b4e 5784 defsubr (&Snext_overlay_change);
239c932b 5785 defsubr (&Sprevious_overlay_change);
2eec3b4e
RS
5786 defsubr (&Soverlay_recenter);
5787 defsubr (&Soverlay_lists);
5788 defsubr (&Soverlay_get);
5789 defsubr (&Soverlay_put);
a8c21b48 5790 defsubr (&Srestore_buffer_modified_p);
1ab256cb
RM
5791}
5792
dfcf069d 5793void
1ab256cb
RM
5794keys_of_buffer ()
5795{
5796 initial_define_key (control_x_map, 'b', "switch-to-buffer");
5797 initial_define_key (control_x_map, 'k', "kill-buffer");
4158c17d
RM
5798
5799 /* This must not be in syms_of_buffer, because Qdisabled is not
5800 initialized when that function gets called. */
5801 Fput (intern ("erase-buffer"), Qdisabled, Qt);
1ab256cb 5802}