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