(apropos-mode-map): Bind q to quit-window.
[bpt/emacs.git] / src / buffer.c
CommitLineData
1ab256cb 1/* Buffer manipulation primitives for GNU Emacs.
31c8f881 2 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995, 1997, 1998
c922bc55 3 Free Software Foundation, Inc.
1ab256cb
RM
4
5This file is part of GNU Emacs.
6
7GNU Emacs is free software; you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
c922bc55 9the Free Software Foundation; either version 2, or (at your option)
1ab256cb
RM
10any later version.
11
12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along with GNU Emacs; see the file COPYING. If not, write to
3b7ad313
EN
19the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20Boston, MA 02111-1307, USA. */
1ab256cb
RM
21
22
2381d133
JB
23#include <sys/types.h>
24#include <sys/stat.h>
1ab256cb 25#include <sys/param.h>
9dde47f5
RS
26#include <errno.h>
27
28extern int errno;
1ab256cb
RM
29
30#ifndef MAXPATHLEN
31/* in 4.1, param.h fails to define this. */
32#define MAXPATHLEN 1024
33#endif /* not MAXPATHLEN */
34
18160b98 35#include <config.h>
dfcf069d
AS
36#ifdef STDC_HEADERS
37#include <stdlib.h>
38#endif
39#ifdef HAVE_UNISTD_H
40#include <unistd.h>
41#endif
1ab256cb 42#include "lisp.h"
21cf4cf8 43#include "intervals.h"
1ab256cb
RM
44#include "window.h"
45#include "commands.h"
46#include "buffer.h"
3b06f880 47#include "charset.h"
28e969dd 48#include "region-cache.h"
1ab256cb 49#include "indent.h"
d014bf88 50#include "blockinput.h"
08460cd4 51#include "frame.h"
1ab256cb
RM
52
53struct buffer *current_buffer; /* the current buffer */
54
55/* First buffer in chain of all buffers (in reverse order of creation).
56 Threaded through ->next. */
57
58struct buffer *all_buffers;
59
60/* This structure holds the default values of the buffer-local variables
61 defined with DEFVAR_PER_BUFFER, that have special slots in each buffer.
62 The default value occupies the same slot in this structure
63 as an individual buffer's value occupies in that buffer.
64 Setting the default value also goes through the alist of buffers
65 and stores into each buffer that does not say it has a local value. */
66
67struct buffer buffer_defaults;
68
69/* A Lisp_Object pointer to the above, used for staticpro */
70
71static Lisp_Object Vbuffer_defaults;
72
73/* This structure marks which slots in a buffer have corresponding
74 default values in buffer_defaults.
75 Each such slot has a nonzero value in this structure.
76 The value has only one nonzero bit.
77
78 When a buffer has its own local value for a slot,
79 the bit for that slot (found in the same slot in this structure)
80 is turned on in the buffer's local_var_flags slot.
81
82 If a slot in this structure is -1, then even though there may
83 be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
84 and the corresponding slot in buffer_defaults is not used.
85
86 If a slot is -2, then there is no DEFVAR_PER_BUFFER for it,
87 but there is a default value which is copied into each buffer.
88
89 If a slot in this structure is negative, then even though there may
90 be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
91 and the corresponding slot in buffer_defaults is not used.
92
93 If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is
94 zero, that is a bug */
95
96struct buffer buffer_local_flags;
97
98/* This structure holds the names of symbols whose values may be
99 buffer-local. It is indexed and accessed in the same way as the above. */
100
101struct buffer buffer_local_symbols;
102/* A Lisp_Object pointer to the above, used for staticpro */
103static Lisp_Object Vbuffer_local_symbols;
104
0fa3ba92
JB
105/* This structure holds the required types for the values in the
106 buffer-local slots. If a slot contains Qnil, then the
107 corresponding buffer slot may contain a value of any type. If a
108 slot contains an integer, then prospective values' tags must be
1bf08baf
KH
109 equal to that integer (except nil is always allowed).
110 When a tag does not match, the function
111 buffer_slot_type_mismatch will signal an error.
112
113 If a slot here contains -1, the corresponding variable is read-only. */
0fa3ba92
JB
114struct buffer buffer_local_types;
115
13de9290
RS
116/* Flags indicating which built-in buffer-local variables
117 are permanent locals. */
118static int buffer_permanent_local_flags;
119
1ab256cb 120Lisp_Object Fset_buffer ();
01050cb5 121void set_buffer_internal ();
c7aa5005 122void set_buffer_internal_1 ();
173f2a64 123static void call_overlay_mod_hooks ();
2f3f993b 124static void swap_out_buffer_local_variables ();
13de9290 125static void reset_buffer_local_variables ();
1ab256cb
RM
126
127/* Alist of all buffer names vs the buffers. */
128/* This used to be a variable, but is no longer,
129 to prevent lossage due to user rplac'ing this alist or its elements. */
130Lisp_Object Vbuffer_alist;
131
132/* Functions to call before and after each text change. */
133Lisp_Object Vbefore_change_function;
134Lisp_Object Vafter_change_function;
5f079267
RS
135Lisp_Object Vbefore_change_functions;
136Lisp_Object Vafter_change_functions;
1ab256cb 137
c48f61ef
RS
138Lisp_Object Vtransient_mark_mode;
139
a96b68f1
RS
140/* t means ignore all read-only text properties.
141 A list means ignore such a property if its value is a member of the list.
142 Any non-nil value means ignore buffer-read-only. */
143Lisp_Object Vinhibit_read_only;
144
dcdffbf6
RS
145/* List of functions to call that can query about killing a buffer.
146 If any of these functions returns nil, we don't kill it. */
147Lisp_Object Vkill_buffer_query_functions;
148
dbc4e1c1
JB
149/* List of functions to call before changing an unmodified buffer. */
150Lisp_Object Vfirst_change_hook;
22378665 151
dbc4e1c1 152Lisp_Object Qfirst_change_hook;
22378665
RS
153Lisp_Object Qbefore_change_functions;
154Lisp_Object Qafter_change_functions;
1ab256cb
RM
155
156Lisp_Object Qfundamental_mode, Qmode_class, Qpermanent_local;
157
158Lisp_Object Qprotected_field;
159
160Lisp_Object QSFundamental; /* A string "Fundamental" */
161
162Lisp_Object Qkill_buffer_hook;
163
5fe0b67e
RS
164Lisp_Object Qget_file_buffer;
165
52f8ec73
JB
166Lisp_Object Qoverlayp;
167
bbbe9545 168Lisp_Object Qpriority, Qwindow, Qevaporate, Qbefore_string, Qafter_string;
5985d248 169
294d215f
RS
170Lisp_Object Qmodification_hooks;
171Lisp_Object Qinsert_in_front_hooks;
172Lisp_Object Qinsert_behind_hooks;
173
1ab256cb
RM
174/* For debugging; temporary. See set_buffer_internal. */
175/* Lisp_Object Qlisp_mode, Vcheck_symbol; */
176
01136e9b 177void
1ab256cb
RM
178nsberror (spec)
179 Lisp_Object spec;
180{
a7a60ce9 181 if (STRINGP (spec))
1ab256cb
RM
182 error ("No buffer named %s", XSTRING (spec)->data);
183 error ("Invalid buffer argument");
184}
185\f
0dc88e60
RS
186DEFUN ("buffer-live-p", Fbuffer_live_p, Sbuffer_live_p, 1, 1, 0,
187 "Return non-nil if OBJECT is a buffer which has not been killed.\n\
188Value is nil if OBJECT is not a buffer or if it has been killed.")
189 (object)
190 Lisp_Object object;
191{
192 return ((BUFFERP (object) && ! NILP (XBUFFER (object)->name))
193 ? Qt : Qnil);
194}
195
08460cd4
RS
196DEFUN ("buffer-list", Fbuffer_list, Sbuffer_list, 0, 1, 0,
197 "Return a list of all existing live buffers.\n\
198If the optional arg FRAME is a frame, we return that frame's buffer list.")
199 (frame)
200 Lisp_Object frame;
1ab256cb 201{
08460cd4
RS
202 Lisp_Object framelist, general;
203 general = Fmapcar (Qcdr, Vbuffer_alist);
204
205 if (FRAMEP (frame))
206 {
207 Lisp_Object tail;
208
209 CHECK_FRAME (frame, 1);
210
211 framelist = Fcopy_sequence (XFRAME (frame)->buffer_list);
212
213 /* Remove from GENERAL any buffer that duplicates one in FRAMELIST. */
214 tail = framelist;
215 while (! NILP (tail))
216 {
217 general = Fdelq (XCONS (tail)->car, general);
218 tail = XCONS (tail)->cdr;
219 }
220 return nconc2 (framelist, general);
221 }
222
223 return general;
1ab256cb
RM
224}
225
04ae1b48
RS
226/* Like Fassoc, but use Fstring_equal to compare
227 (which ignores text properties),
228 and don't ever QUIT. */
229
230static Lisp_Object
231assoc_ignore_text_properties (key, list)
232 register Lisp_Object key;
233 Lisp_Object list;
234{
235 register Lisp_Object tail;
236 for (tail = list; !NILP (tail); tail = Fcdr (tail))
237 {
238 register Lisp_Object elt, tem;
239 elt = Fcar (tail);
240 tem = Fstring_equal (Fcar (elt), key);
241 if (!NILP (tem))
242 return elt;
243 }
244 return Qnil;
245}
246
1ab256cb
RM
247DEFUN ("get-buffer", Fget_buffer, Sget_buffer, 1, 1, 0,
248 "Return the buffer named NAME (a string).\n\
249If there is no live buffer named NAME, return nil.\n\
250NAME may also be a buffer; if so, the value is that buffer.")
251 (name)
252 register Lisp_Object name;
253{
a7a60ce9 254 if (BUFFERP (name))
1ab256cb
RM
255 return name;
256 CHECK_STRING (name, 0);
257
04ae1b48 258 return Fcdr (assoc_ignore_text_properties (name, Vbuffer_alist));
1ab256cb
RM
259}
260
261DEFUN ("get-file-buffer", Fget_file_buffer, Sget_file_buffer, 1, 1, 0,
262 "Return the buffer visiting file FILENAME (a string).\n\
92194d02 263The buffer's `buffer-file-name' must match exactly the expansion of FILENAME.\n\
11da5363
RS
264If there is no such live buffer, return nil.\n\
265See also `find-buffer-visiting'.")
1ab256cb
RM
266 (filename)
267 register Lisp_Object filename;
268{
269 register Lisp_Object tail, buf, tem;
5fe0b67e
RS
270 Lisp_Object handler;
271
1ab256cb
RM
272 CHECK_STRING (filename, 0);
273 filename = Fexpand_file_name (filename, Qnil);
274
5fe0b67e
RS
275 /* If the file name has special constructs in it,
276 call the corresponding file handler. */
a617e913 277 handler = Ffind_file_name_handler (filename, Qget_file_buffer);
5fe0b67e
RS
278 if (!NILP (handler))
279 return call2 (handler, Qget_file_buffer, filename);
280
1ab256cb
RM
281 for (tail = Vbuffer_alist; CONSP (tail); tail = XCONS (tail)->cdr)
282 {
283 buf = Fcdr (XCONS (tail)->car);
a7a60ce9
KH
284 if (!BUFFERP (buf)) continue;
285 if (!STRINGP (XBUFFER (buf)->filename)) continue;
1ab256cb 286 tem = Fstring_equal (XBUFFER (buf)->filename, filename);
265a9e55 287 if (!NILP (tem))
1ab256cb
RM
288 return buf;
289 }
290 return Qnil;
291}
292
52e01189
RS
293Lisp_Object
294get_truename_buffer (filename)
295 register Lisp_Object filename;
296{
297 register Lisp_Object tail, buf, tem;
298
299 for (tail = Vbuffer_alist; CONSP (tail); tail = XCONS (tail)->cdr)
300 {
301 buf = Fcdr (XCONS (tail)->car);
302 if (!BUFFERP (buf)) continue;
303 if (!STRINGP (XBUFFER (buf)->file_truename)) continue;
304 tem = Fstring_equal (XBUFFER (buf)->file_truename, filename);
305 if (!NILP (tem))
306 return buf;
307 }
308 return Qnil;
309}
310
1ab256cb
RM
311/* Incremented for each buffer created, to assign the buffer number. */
312int buffer_count;
313
314DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 1, 0,
315 "Return the buffer named NAME, or create such a buffer and return it.\n\
316A new buffer is created if there is no live buffer named NAME.\n\
b44895bc 317If NAME starts with a space, the new buffer does not keep undo information.\n\
1ab256cb
RM
318If NAME is a buffer instead of a string, then it is the value returned.\n\
319The value is never nil.")
320 (name)
321 register Lisp_Object name;
322{
a9ee7a59 323 register Lisp_Object buf;
1ab256cb
RM
324 register struct buffer *b;
325
326 buf = Fget_buffer (name);
265a9e55 327 if (!NILP (buf))
1ab256cb
RM
328 return buf;
329
31cd83e9
KH
330 if (XSTRING (name)->size == 0)
331 error ("Empty string for buffer name is not allowed");
332
9ac0d9e0 333 b = (struct buffer *) xmalloc (sizeof (struct buffer));
1ab256cb 334
336cd056
RS
335 b->size = sizeof (struct buffer) / sizeof (EMACS_INT);
336
337 /* An ordinary buffer uses its own struct buffer_text. */
338 b->text = &b->own_text;
339 b->base_buffer = 0;
340
1ab256cb 341 BUF_GAP_SIZE (b) = 20;
9ac0d9e0 342 BLOCK_INPUT;
3b06f880
KH
343 /* We allocate extra 1-byte at the tail and keep it always '\0' for
344 anchoring a search. */
345 BUFFER_ALLOC (BUF_BEG_ADDR (b), (BUF_GAP_SIZE (b) + 1));
9ac0d9e0 346 UNBLOCK_INPUT;
1ab256cb 347 if (! BUF_BEG_ADDR (b))
81841847 348 buffer_memory_full ();
1ab256cb
RM
349
350 BUF_PT (b) = 1;
351 BUF_GPT (b) = 1;
352 BUF_BEGV (b) = 1;
353 BUF_ZV (b) = 1;
354 BUF_Z (b) = 1;
3f236a40
RS
355 BUF_PT_BYTE (b) = 1;
356 BUF_GPT_BYTE (b) = 1;
357 BUF_BEGV_BYTE (b) = 1;
358 BUF_ZV_BYTE (b) = 1;
359 BUF_Z_BYTE (b) = 1;
1ab256cb 360 BUF_MODIFF (b) = 1;
2509d356 361 BUF_OVERLAY_MODIFF (b) = 1;
336cd056
RS
362 BUF_SAVE_MODIFF (b) = 1;
363 BUF_INTERVALS (b) = 0;
3b06f880 364 *(BUF_GPT_ADDR (b)) = *(BUF_Z_ADDR (b)) = 0; /* Put an anchor '\0'. */
1ab256cb 365
28e969dd
JB
366 b->newline_cache = 0;
367 b->width_run_cache = 0;
368 b->width_table = Qnil;
369
1ab256cb
RM
370 /* Put this on the chain of all buffers including killed ones. */
371 b->next = all_buffers;
372 all_buffers = b;
373
336cd056
RS
374 /* An ordinary buffer normally doesn't need markers
375 to handle BEGV and ZV. */
376 b->pt_marker = Qnil;
377 b->begv_marker = Qnil;
378 b->zv_marker = Qnil;
04ae1b48
RS
379
380 name = Fcopy_sequence (name);
381 INITIALIZE_INTERVAL (XSTRING (name), NULL_INTERVAL);
1ab256cb 382 b->name = name;
04ae1b48 383
1ab256cb
RM
384 if (XSTRING (name)->data[0] != ' ')
385 b->undo_list = Qnil;
386 else
387 b->undo_list = Qt;
388
389 reset_buffer (b);
13de9290 390 reset_buffer_local_variables (b, 1);
1ab256cb
RM
391
392 /* Put this in the alist of all live buffers. */
67180c6a 393 XSETBUFFER (buf, b);
1ab256cb
RM
394 Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));
395
396 b->mark = Fmake_marker ();
336cd056
RS
397 BUF_MARKERS (b) = Qnil;
398 b->name = name;
399 return buf;
400}
401
a2428fa2 402DEFUN ("make-indirect-buffer", Fmake_indirect_buffer, Smake_indirect_buffer, 2, 2,
193c3837 403 "bMake indirect buffer (to buffer): \nBName of indirect buffer: ",
a2428fa2
EN
404 "Create and return an indirect buffer for buffer BASE-BUFFER, named NAME.\n\
405BASE-BUFFER should be an existing buffer (or buffer name).\n\
9e552710
RS
406NAME should be a string which is not the name of an existing buffer.")
407 (base_buffer, name)
408 register Lisp_Object base_buffer, name;
336cd056
RS
409{
410 register Lisp_Object buf;
411 register struct buffer *b;
412
413 buf = Fget_buffer (name);
414 if (!NILP (buf))
415 error ("Buffer name `%s' is in use", XSTRING (name)->data);
416
417 base_buffer = Fget_buffer (base_buffer);
418 if (NILP (base_buffer))
419 error ("No such buffer: `%s'",
420 XSTRING (XBUFFER (base_buffer)->name)->data);
421
422 if (XSTRING (name)->size == 0)
423 error ("Empty string for buffer name is not allowed");
424
425 b = (struct buffer *) xmalloc (sizeof (struct buffer));
426
427 b->size = sizeof (struct buffer) / sizeof (EMACS_INT);
428
429 if (XBUFFER (base_buffer)->base_buffer)
430 b->base_buffer = XBUFFER (base_buffer)->base_buffer;
431 else
432 b->base_buffer = XBUFFER (base_buffer);
433
434 /* Use the base buffer's text object. */
435 b->text = b->base_buffer->text;
436
437 BUF_BEGV (b) = BUF_BEGV (b->base_buffer);
438 BUF_ZV (b) = BUF_ZV (b->base_buffer);
439 BUF_PT (b) = BUF_PT (b->base_buffer);
3f236a40
RS
440 BUF_BEGV_BYTE (b) = BUF_BEGV_BYTE (b->base_buffer);
441 BUF_ZV_BYTE (b) = BUF_ZV_BYTE (b->base_buffer);
442 BUF_PT_BYTE (b) = BUF_PT_BYTE (b->base_buffer);
336cd056
RS
443
444 b->newline_cache = 0;
445 b->width_run_cache = 0;
446 b->width_table = Qnil;
447
448 /* Put this on the chain of all buffers including killed ones. */
449 b->next = all_buffers;
450 all_buffers = b;
451
452 name = Fcopy_sequence (name);
453 INITIALIZE_INTERVAL (XSTRING (name), NULL_INTERVAL);
454 b->name = name;
455
456 reset_buffer (b);
13de9290 457 reset_buffer_local_variables (b, 1);
336cd056
RS
458
459 /* Put this in the alist of all live buffers. */
460 XSETBUFFER (buf, b);
461 Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));
462
463 b->mark = Fmake_marker ();
1ab256cb 464 b->name = name;
336cd056
RS
465
466 /* Make sure the base buffer has markers for its narrowing. */
467 if (NILP (b->base_buffer->pt_marker))
468 {
469 b->base_buffer->pt_marker = Fmake_marker ();
3f236a40
RS
470 set_marker_both (b->base_buffer->pt_marker, base_buffer,
471 BUF_PT (b->base_buffer),
472 BUF_PT_BYTE (b->base_buffer));
336cd056
RS
473 }
474 if (NILP (b->base_buffer->begv_marker))
475 {
476 b->base_buffer->begv_marker = Fmake_marker ();
3f236a40
RS
477 set_marker_both (b->base_buffer->begv_marker, base_buffer,
478 BUF_BEGV (b->base_buffer),
479 BUF_BEGV_BYTE (b->base_buffer));
336cd056
RS
480 }
481 if (NILP (b->base_buffer->zv_marker))
482 {
483 b->base_buffer->zv_marker = Fmake_marker ();
3f236a40
RS
484 set_marker_both (b->base_buffer->zv_marker, base_buffer,
485 BUF_ZV (b->base_buffer),
486 BUF_ZV_BYTE (b->base_buffer));
26d84681 487 XMARKER (b->base_buffer->zv_marker)->insertion_type = 1;
336cd056
RS
488 }
489
490 /* Give the indirect buffer markers for its narrowing. */
ea064aa0 491 b->pt_marker = Fmake_marker ();
3f236a40 492 set_marker_both (b->pt_marker, buf, BUF_PT (b), BUF_PT_BYTE (b));
ea064aa0 493 b->begv_marker = Fmake_marker ();
3f236a40 494 set_marker_both (b->begv_marker, buf, BUF_BEGV (b), BUF_BEGV_BYTE (b));
ea064aa0 495 b->zv_marker = Fmake_marker ();
3f236a40 496 set_marker_both (b->zv_marker, buf, BUF_ZV (b), BUF_ZV_BYTE (b));
26d84681 497 XMARKER (b->zv_marker)->insertion_type = 1;
336cd056 498
a9ee7a59 499 return buf;
1ab256cb
RM
500}
501
bcd40520
RS
502/* Reinitialize everything about a buffer except its name and contents
503 and local variables. */
1ab256cb
RM
504
505void
506reset_buffer (b)
507 register struct buffer *b;
508{
509 b->filename = Qnil;
f6ed2e84 510 b->file_truename = Qnil;
1ab256cb
RM
511 b->directory = (current_buffer) ? current_buffer->directory : Qnil;
512 b->modtime = 0;
8d7a4592 513 XSETFASTINT (b->save_length, 0);
1ab256cb 514 b->last_window_start = 1;
8b264726
RS
515 /* It is more conservative to start out "changed" than "unchanged". */
516 b->clip_changed = 1;
1ab256cb
RM
517 b->backed_up = Qnil;
518 b->auto_save_modified = 0;
84f6bcba 519 b->auto_save_failure_time = -1;
1ab256cb
RM
520 b->auto_save_file_name = Qnil;
521 b->read_only = Qnil;
2eec3b4e
RS
522 b->overlays_before = Qnil;
523 b->overlays_after = Qnil;
8d7a4592 524 XSETFASTINT (b->overlay_center, 1);
dfda7a7f 525 b->mark_active = Qnil;
943e065b 526 b->point_before_scroll = Qnil;
be9aafdd 527 b->file_format = Qnil;
0dc6f165 528 b->last_selected_window = Qnil;
7962a441 529 XSETINT (b->display_count, 0);
fb2030e3
RS
530 b->extra2 = Qnil;
531 b->extra3 = Qnil;
1bf08baf 532 b->enable_multibyte_characters = buffer_defaults.enable_multibyte_characters;
1ab256cb
RM
533}
534
bcd40520
RS
535/* Reset buffer B's local variables info.
536 Don't use this on a buffer that has already been in use;
537 it does not treat permanent locals consistently.
13de9290
RS
538 Instead, use Fkill_all_local_variables.
539
540 If PERMANENT_TOO is 1, then we reset permanent built-in
541 buffer-local variables. If PERMANENT_TOO is 0,
542 we preserve those. */
bcd40520 543
13de9290
RS
544static void
545reset_buffer_local_variables (b, permanent_too)
1ab256cb 546 register struct buffer *b;
13de9290 547 int permanent_too;
1ab256cb
RM
548{
549 register int offset;
13de9290
RS
550 int dont_reset;
551
552 /* Decide which built-in local variables to reset. */
553 if (permanent_too)
554 dont_reset = 0;
555 else
556 dont_reset = buffer_permanent_local_flags;
1ab256cb
RM
557
558 /* Reset the major mode to Fundamental, together with all the
559 things that depend on the major mode.
560 default-major-mode is handled at a higher level.
561 We ignore it here. */
562 b->major_mode = Qfundamental_mode;
563 b->keymap = Qnil;
564 b->abbrev_table = Vfundamental_mode_abbrev_table;
565 b->mode_name = QSFundamental;
566 b->minor_modes = Qnil;
3446af9c
RS
567
568 /* If the standard case table has been altered and invalidated,
569 fix up its insides first. */
570 if (! (CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[0])
571 && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[1])
572 && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[2])))
573 Fset_standard_case_table (Vascii_downcase_table);
574
1ab256cb 575 b->downcase_table = Vascii_downcase_table;
1e9b6335
RS
576 b->upcase_table = XCHAR_TABLE (Vascii_downcase_table)->extras[0];
577 b->case_canon_table = XCHAR_TABLE (Vascii_downcase_table)->extras[1];
578 b->case_eqv_table = XCHAR_TABLE (Vascii_downcase_table)->extras[2];
3cb719bd 579 b->invisibility_spec = Qt;
2e716096
RS
580#ifndef DOS_NT
581 b->buffer_file_type = Qnil;
582#endif
3cb719bd 583
1ab256cb
RM
584#if 0
585 b->sort_table = XSTRING (Vascii_sort_table);
586 b->folding_sort_table = XSTRING (Vascii_folding_sort_table);
587#endif /* 0 */
588
13de9290 589 /* Reset all (or most) per-buffer variables to their defaults. */
1ab256cb 590 b->local_var_alist = Qnil;
13de9290 591 b->local_var_flags &= dont_reset;
1ab256cb
RM
592
593 /* For each slot that has a default value,
594 copy that into the slot. */
595
596 for (offset = (char *)&buffer_local_flags.name - (char *)&buffer_local_flags;
597 offset < sizeof (struct buffer);
4d2f1389 598 offset += sizeof (Lisp_Object)) /* sizeof EMACS_INT == sizeof Lisp_Object */
aab80822
KH
599 {
600 int flag = XINT (*(Lisp_Object *)(offset + (char *)&buffer_local_flags));
13de9290
RS
601 if ((flag > 0
602 /* Don't reset a permanent local. */
603 && ! (dont_reset & flag))
604 || flag == -2)
605 *(Lisp_Object *)(offset + (char *)b)
606 = *(Lisp_Object *)(offset + (char *)&buffer_defaults);
aab80822 607 }
1ab256cb
RM
608}
609
01050cb5
RM
610/* We split this away from generate-new-buffer, because rename-buffer
611 and set-visited-file-name ought to be able to use this to really
612 rename the buffer properly. */
613
614DEFUN ("generate-new-buffer-name", Fgenerate_new_buffer_name, Sgenerate_new_buffer_name,
c273e647 615 1, 2, 0,
01050cb5
RM
616 "Return a string that is the name of no existing buffer based on NAME.\n\
617If there is no live buffer named NAME, then return NAME.\n\
1ab256cb 618Otherwise modify name by appending `<NUMBER>', incrementing NUMBER\n\
c273e647 619until an unused name is found, and then return that name.\n\
03bdd54c 620Optional second argument IGNORE specifies a name that is okay to use\n\
c273e647 621\(if it is in the sequence to be tried)\n\
e8b3a22d 622even if a buffer with that name exists.")
c273e647
RS
623 (name, ignore)
624 register Lisp_Object name, ignore;
1ab256cb
RM
625{
626 register Lisp_Object gentemp, tem;
627 int count;
628 char number[10];
629
630 CHECK_STRING (name, 0);
631
632 tem = Fget_buffer (name);
265a9e55 633 if (NILP (tem))
01050cb5 634 return name;
1ab256cb
RM
635
636 count = 1;
637 while (1)
638 {
639 sprintf (number, "<%d>", ++count);
640 gentemp = concat2 (name, build_string (number));
638e4fc3 641 tem = Fstring_equal (gentemp, ignore);
c273e647
RS
642 if (!NILP (tem))
643 return gentemp;
1ab256cb 644 tem = Fget_buffer (gentemp);
265a9e55 645 if (NILP (tem))
01050cb5 646 return gentemp;
1ab256cb
RM
647 }
648}
649
650\f
651DEFUN ("buffer-name", Fbuffer_name, Sbuffer_name, 0, 1, 0,
652 "Return the name of BUFFER, as a string.\n\
01050cb5 653With no argument or nil as argument, return the name of the current buffer.")
1ab256cb
RM
654 (buffer)
655 register Lisp_Object buffer;
656{
265a9e55 657 if (NILP (buffer))
1ab256cb
RM
658 return current_buffer->name;
659 CHECK_BUFFER (buffer, 0);
660 return XBUFFER (buffer)->name;
661}
662
663DEFUN ("buffer-file-name", Fbuffer_file_name, Sbuffer_file_name, 0, 1, 0,
664 "Return name of file BUFFER is visiting, or nil if none.\n\
665No argument or nil as argument means use the current buffer.")
666 (buffer)
667 register Lisp_Object buffer;
668{
265a9e55 669 if (NILP (buffer))
1ab256cb
RM
670 return current_buffer->filename;
671 CHECK_BUFFER (buffer, 0);
672 return XBUFFER (buffer)->filename;
673}
674
336cd056
RS
675DEFUN ("buffer-base-buffer", Fbuffer_base_buffer, Sbuffer_base_buffer,
676 0, 1, 0,
677 "Return the base buffer of indirect buffer BUFFER.\n\
678If BUFFER is not indirect, return nil.")
679 (buffer)
680 register Lisp_Object buffer;
681{
682 struct buffer *base;
683 Lisp_Object base_buffer;
684
685 if (NILP (buffer))
686 base = current_buffer->base_buffer;
687 else
688 {
689 CHECK_BUFFER (buffer, 0);
690 base = XBUFFER (buffer)->base_buffer;
691 }
692
693 if (! base)
694 return Qnil;
695 XSETBUFFER (base_buffer, base);
696 return base_buffer;
697}
698
1ab256cb
RM
699DEFUN ("buffer-local-variables", Fbuffer_local_variables,
700 Sbuffer_local_variables, 0, 1, 0,
701 "Return an alist of variables that are buffer-local in BUFFER.\n\
553defa4
RS
702Most elements look like (SYMBOL . VALUE), describing one variable.\n\
703For a symbol that is locally unbound, just the symbol appears in the value.\n\
1ab256cb
RM
704Note that storing new VALUEs in these elements doesn't change the variables.\n\
705No argument or nil as argument means use current buffer as BUFFER.")
706 (buffer)
707 register Lisp_Object buffer;
708{
709 register struct buffer *buf;
553defa4 710 register Lisp_Object result;
1ab256cb 711
265a9e55 712 if (NILP (buffer))
1ab256cb
RM
713 buf = current_buffer;
714 else
715 {
716 CHECK_BUFFER (buffer, 0);
717 buf = XBUFFER (buffer);
718 }
719
553defa4
RS
720 result = Qnil;
721
1ab256cb 722 {
553defa4
RS
723 register Lisp_Object tail;
724 for (tail = buf->local_var_alist; CONSP (tail); tail = XCONS (tail)->cdr)
1ab256cb 725 {
553defa4
RS
726 Lisp_Object val, elt;
727
728 elt = XCONS (tail)->car;
729
e0585c64
RS
730 /* Reference each variable in the alist in buf.
731 If inquiring about the current buffer, this gets the current values,
732 so store them into the alist so the alist is up to date.
733 If inquiring about some other buffer, this swaps out any values
734 for that buffer, making the alist up to date automatically. */
735 val = find_symbol_value (XCONS (elt)->car);
736 /* Use the current buffer value only if buf is the current buffer. */
737 if (buf != current_buffer)
553defa4
RS
738 val = XCONS (elt)->cdr;
739
740 /* If symbol is unbound, put just the symbol in the list. */
741 if (EQ (val, Qunbound))
742 result = Fcons (XCONS (elt)->car, result);
743 /* Otherwise, put (symbol . value) in the list. */
744 else
745 result = Fcons (Fcons (XCONS (elt)->car, val), result);
1ab256cb
RM
746 }
747 }
748
1ab256cb
RM
749 /* Add on all the variables stored in special slots. */
750 {
751 register int offset, mask;
752
753 for (offset = (char *)&buffer_local_symbols.name - (char *)&buffer_local_symbols;
754 offset < sizeof (struct buffer);
4d2f1389 755 offset += (sizeof (EMACS_INT))) /* sizeof EMACS_INT == sizeof Lisp_Object */
1ab256cb 756 {
aab80822 757 mask = XINT (*(Lisp_Object *)(offset + (char *)&buffer_local_flags));
1ab256cb 758 if (mask == -1 || (buf->local_var_flags & mask))
aab80822
KH
759 if (SYMBOLP (*(Lisp_Object *)(offset
760 + (char *)&buffer_local_symbols)))
761 result = Fcons (Fcons (*((Lisp_Object *)
762 (offset + (char *)&buffer_local_symbols)),
553defa4
RS
763 *(Lisp_Object *)(offset + (char *)buf)),
764 result);
1ab256cb
RM
765 }
766 }
553defa4
RS
767
768 return result;
1ab256cb
RM
769}
770
771\f
772DEFUN ("buffer-modified-p", Fbuffer_modified_p, Sbuffer_modified_p,
773 0, 1, 0,
774 "Return t if BUFFER was modified since its file was last read or saved.\n\
775No argument or nil as argument means use current buffer as BUFFER.")
776 (buffer)
777 register Lisp_Object buffer;
778{
779 register struct buffer *buf;
265a9e55 780 if (NILP (buffer))
1ab256cb
RM
781 buf = current_buffer;
782 else
783 {
784 CHECK_BUFFER (buffer, 0);
785 buf = XBUFFER (buffer);
786 }
787
336cd056 788 return BUF_SAVE_MODIFF (buf) < BUF_MODIFF (buf) ? Qt : Qnil;
1ab256cb
RM
789}
790
791DEFUN ("set-buffer-modified-p", Fset_buffer_modified_p, Sset_buffer_modified_p,
792 1, 1, 0,
793 "Mark current buffer as modified or unmodified according to FLAG.\n\
794A non-nil FLAG means mark the buffer modified.")
795 (flag)
796 register Lisp_Object flag;
797{
798 register int already;
799 register Lisp_Object fn;
800
801#ifdef CLASH_DETECTION
802 /* If buffer becoming modified, lock the file.
803 If buffer becoming unmodified, unlock the file. */
804
60f4dd23 805 fn = current_buffer->file_truename;
265a9e55 806 if (!NILP (fn))
1ab256cb 807 {
336cd056 808 already = SAVE_MODIFF < MODIFF;
265a9e55 809 if (!already && !NILP (flag))
1ab256cb 810 lock_file (fn);
265a9e55 811 else if (already && NILP (flag))
1ab256cb
RM
812 unlock_file (fn);
813 }
814#endif /* CLASH_DETECTION */
815
336cd056 816 SAVE_MODIFF = NILP (flag) ? MODIFF : 0;
1ab256cb
RM
817 update_mode_lines++;
818 return flag;
819}
820
821DEFUN ("buffer-modified-tick", Fbuffer_modified_tick, Sbuffer_modified_tick,
822 0, 1, 0,
823 "Return BUFFER's tick counter, incremented for each change in text.\n\
824Each buffer has a tick counter which is incremented each time the text in\n\
825that buffer is changed. It wraps around occasionally.\n\
826No argument or nil as argument means use current buffer as BUFFER.")
827 (buffer)
828 register Lisp_Object buffer;
829{
830 register struct buffer *buf;
265a9e55 831 if (NILP (buffer))
1ab256cb
RM
832 buf = current_buffer;
833 else
834 {
835 CHECK_BUFFER (buffer, 0);
836 buf = XBUFFER (buffer);
837 }
838
839 return make_number (BUF_MODIFF (buf));
840}
841\f
01050cb5 842DEFUN ("rename-buffer", Frename_buffer, Srename_buffer, 1, 2,
4c7e5f09 843 "sRename buffer (to new name): \nP",
1ab256cb 844 "Change current buffer's name to NEWNAME (a string).\n\
3bd779aa 845If second arg UNIQUE is nil or omitted, it is an error if a\n\
01050cb5 846buffer named NEWNAME already exists.\n\
3bd779aa 847If UNIQUE is non-nil, come up with a new name using\n\
01050cb5 848`generate-new-buffer-name'.\n\
3bd779aa
RS
849Interactively, you can set UNIQUE with a prefix argument.\n\
850We return the name we actually gave the buffer.\n\
1ab256cb 851This does not change the name of the visited file (if any).")
489c043a
RS
852 (newname, unique)
853 register Lisp_Object newname, unique;
1ab256cb
RM
854{
855 register Lisp_Object tem, buf;
856
489c043a 857 CHECK_STRING (newname, 0);
d59698c4 858
489c043a 859 if (XSTRING (newname)->size == 0)
d59698c4
RS
860 error ("Empty string is invalid as a buffer name");
861
489c043a 862 tem = Fget_buffer (newname);
c059b5ea
RM
863 /* Don't short-circuit if UNIQUE is t. That is a useful way to rename
864 the buffer automatically so you can create another with the original name.
865 It makes UNIQUE equivalent to
489c043a 866 (rename-buffer (generate-new-buffer-name NEWNAME)). */
c059b5ea 867 if (NILP (unique) && XBUFFER (tem) == current_buffer)
fb5eba9c 868 return current_buffer->name;
265a9e55 869 if (!NILP (tem))
01050cb5 870 {
3bd779aa 871 if (!NILP (unique))
489c043a 872 newname = Fgenerate_new_buffer_name (newname, current_buffer->name);
01050cb5 873 else
489c043a 874 error ("Buffer name `%s' is in use", XSTRING (newname)->data);
01050cb5 875 }
1ab256cb 876
489c043a 877 current_buffer->name = newname;
76f590d7
JB
878
879 /* Catch redisplay's attention. Unless we do this, the mode lines for
880 any windows displaying current_buffer will stay unchanged. */
881 update_mode_lines++;
882
67180c6a 883 XSETBUFFER (buf, current_buffer);
489c043a 884 Fsetcar (Frassq (buf, Vbuffer_alist), newname);
cf058e49
KH
885 if (NILP (current_buffer->filename)
886 && !NILP (current_buffer->auto_save_file_name))
1ab256cb 887 call0 (intern ("rename-auto-save-file"));
fb5eba9c
RS
888 /* Refetch since that last call may have done GC. */
889 return current_buffer->name;
1ab256cb
RM
890}
891
a0ebb746 892DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 2, 0,
1ab256cb 893 "Return most recently selected buffer other than BUFFER.\n\
a0ebb746
JB
894Buffers not visible in windows are preferred to visible buffers,\n\
895unless optional second argument VISIBLE-OK is non-nil.\n\
1ab256cb
RM
896If no other buffer exists, the buffer `*scratch*' is returned.\n\
897If BUFFER is omitted or nil, some interesting buffer is returned.")
a0ebb746
JB
898 (buffer, visible_ok)
899 register Lisp_Object buffer, visible_ok;
1ab256cb 900{
89132f25 901 Lisp_Object Fset_buffer_major_mode ();
7962a441 902 register Lisp_Object tail, buf, notsogood, tem, pred, add_ons;
1ab256cb
RM
903 notsogood = Qnil;
904
7962a441
RS
905 tail = Vbuffer_alist;
906 pred = frame_buffer_predicate ();
907
908 /* Consider buffers that have been seen in the selected frame
909 before other buffers. */
910
911 tem = frame_buffer_list ();
912 add_ons = Qnil;
913 while (CONSP (tem))
914 {
915 if (BUFFERP (XCONS (tem)->car))
916 add_ons = Fcons (Fcons (Qnil, XCONS (tem)->car), add_ons);
917 tem = XCONS (tem)->cdr;
918 }
919 tail = nconc2 (Fnreverse (add_ons), tail);
920
921 for (; !NILP (tail); tail = Fcdr (tail))
1ab256cb
RM
922 {
923 buf = Fcdr (Fcar (tail));
924 if (EQ (buf, buffer))
925 continue;
926 if (XSTRING (XBUFFER (buf)->name)->data[0] == ' ')
927 continue;
04ae1b48
RS
928 /* If the selected frame has a buffer_predicate,
929 disregard buffers that don't fit the predicate. */
7962a441 930 if (!NILP (pred))
04ae1b48 931 {
7962a441 932 tem = call1 (pred, buf);
04ae1b48
RS
933 if (NILP (tem))
934 continue;
935 }
04ae1b48 936
a0ebb746 937 if (NILP (visible_ok))
db732e5a 938 tem = Fget_buffer_window (buf, Qt);
a0ebb746
JB
939 else
940 tem = Qnil;
265a9e55 941 if (NILP (tem))
1ab256cb 942 return buf;
265a9e55 943 if (NILP (notsogood))
1ab256cb
RM
944 notsogood = buf;
945 }
265a9e55 946 if (!NILP (notsogood))
1ab256cb 947 return notsogood;
89132f25
KH
948 buf = Fget_buffer_create (build_string ("*scratch*"));
949 Fset_buffer_major_mode (buf);
950 return buf;
1ab256cb
RM
951}
952\f
316784fb
KH
953DEFUN ("buffer-disable-undo", Fbuffer_disable_undo, Sbuffer_disable_undo,
954 0, 1, "",
5b8bcf48
RS
955 "Make BUFFER stop keeping undo information.\n\
956No argument or nil as argument means do this for the current buffer.")
ffd56f97
JB
957 (buffer)
958 register Lisp_Object buffer;
1ab256cb 959{
ffd56f97
JB
960 Lisp_Object real_buffer;
961
962 if (NILP (buffer))
67180c6a 963 XSETBUFFER (real_buffer, current_buffer);
ffd56f97
JB
964 else
965 {
966 real_buffer = Fget_buffer (buffer);
967 if (NILP (real_buffer))
968 nsberror (buffer);
969 }
970
971 XBUFFER (real_buffer)->undo_list = Qt;
972
1ab256cb
RM
973 return Qnil;
974}
975
976DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, Sbuffer_enable_undo,
977 0, 1, "",
978 "Start keeping undo information for buffer BUFFER.\n\
979No argument or nil as argument means do this for the current buffer.")
ffd56f97
JB
980 (buffer)
981 register Lisp_Object buffer;
1ab256cb 982{
ffd56f97 983 Lisp_Object real_buffer;
1ab256cb 984
ffd56f97 985 if (NILP (buffer))
67180c6a 986 XSETBUFFER (real_buffer, current_buffer);
1ab256cb
RM
987 else
988 {
ffd56f97
JB
989 real_buffer = Fget_buffer (buffer);
990 if (NILP (real_buffer))
991 nsberror (buffer);
1ab256cb
RM
992 }
993
ffd56f97
JB
994 if (EQ (XBUFFER (real_buffer)->undo_list, Qt))
995 XBUFFER (real_buffer)->undo_list = Qnil;
1ab256cb
RM
996
997 return Qnil;
998}
999
1000/*
1001 DEFVAR_LISP ("kill-buffer-hook", no_cell, "\
1002Hook to be run (by `run-hooks', which see) when a buffer is killed.\n\
1003The buffer being killed will be current while the hook is running.\n\
1004See `kill-buffer'."
1005 */
1006DEFUN ("kill-buffer", Fkill_buffer, Skill_buffer, 1, 1, "bKill buffer: ",
1007 "Kill the buffer BUFFER.\n\
1008The argument may be a buffer or may be the name of a buffer.\n\
1009An argument of nil means kill the current buffer.\n\n\
1010Value is t if the buffer is actually killed, nil if user says no.\n\n\
1011The value of `kill-buffer-hook' (which may be local to that buffer),\n\
1012if not void, is a list of functions to be called, with no arguments,\n\
1013before the buffer is actually killed. The buffer to be killed is current\n\
1014when the hook functions are called.\n\n\
1015Any processes that have this buffer as the `process-buffer' are killed\n\
b64d7442 1016with SIGHUP.")
a25f13ae
KH
1017 (buffer)
1018 Lisp_Object buffer;
1ab256cb
RM
1019{
1020 Lisp_Object buf;
1021 register struct buffer *b;
1022 register Lisp_Object tem;
1023 register struct Lisp_Marker *m;
1024 struct gcpro gcpro1, gcpro2;
1025
a25f13ae 1026 if (NILP (buffer))
1ab256cb
RM
1027 buf = Fcurrent_buffer ();
1028 else
a25f13ae 1029 buf = Fget_buffer (buffer);
265a9e55 1030 if (NILP (buf))
a25f13ae 1031 nsberror (buffer);
1ab256cb
RM
1032
1033 b = XBUFFER (buf);
1034
4a4a9db5
KH
1035 /* Avoid trouble for buffer already dead. */
1036 if (NILP (b->name))
1037 return Qnil;
1038
1ab256cb 1039 /* Query if the buffer is still modified. */
265a9e55 1040 if (INTERACTIVE && !NILP (b->filename)
336cd056 1041 && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b))
1ab256cb 1042 {
a25f13ae 1043 GCPRO1 (buf);
1ab256cb
RM
1044 tem = do_yes_or_no_p (format1 ("Buffer %s modified; kill anyway? ",
1045 XSTRING (b->name)->data));
1046 UNGCPRO;
265a9e55 1047 if (NILP (tem))
1ab256cb
RM
1048 return Qnil;
1049 }
1050
dcdffbf6 1051 /* Run hooks with the buffer to be killed the current buffer. */
1ab256cb
RM
1052 {
1053 register Lisp_Object val;
1054 int count = specpdl_ptr - specpdl;
dcdffbf6 1055 Lisp_Object list;
1ab256cb
RM
1056
1057 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1058 set_buffer_internal (b);
dcdffbf6
RS
1059
1060 /* First run the query functions; if any query is answered no,
1061 don't kill the buffer. */
1062 for (list = Vkill_buffer_query_functions; !NILP (list); list = Fcdr (list))
1063 {
1064 tem = call0 (Fcar (list));
1065 if (NILP (tem))
1066 return unbind_to (count, Qnil);
1067 }
1068
1069 /* Then run the hooks. */
fd186f07
RS
1070 if (!NILP (Vrun_hooks))
1071 call1 (Vrun_hooks, Qkill_buffer_hook);
1ab256cb
RM
1072 unbind_to (count, Qnil);
1073 }
1074
1075 /* We have no more questions to ask. Verify that it is valid
1076 to kill the buffer. This must be done after the questions
1077 since anything can happen within do_yes_or_no_p. */
1078
1079 /* Don't kill the minibuffer now current. */
1080 if (EQ (buf, XWINDOW (minibuf_window)->buffer))
1081 return Qnil;
1082
265a9e55 1083 if (NILP (b->name))
1ab256cb
RM
1084 return Qnil;
1085
336cd056
RS
1086 /* When we kill a base buffer, kill all its indirect buffers.
1087 We do it at this stage so nothing terrible happens if they
1088 ask questions or their hooks get errors. */
1089 if (! b->base_buffer)
1090 {
1091 struct buffer *other;
1092
1093 GCPRO1 (buf);
1094
1095 for (other = all_buffers; other; other = other->next)
4a4a9db5
KH
1096 /* all_buffers contains dead buffers too;
1097 don't re-kill them. */
1098 if (other->base_buffer == b && !NILP (other->name))
336cd056
RS
1099 {
1100 Lisp_Object buf;
1101 XSETBUFFER (buf, other);
1102 Fkill_buffer (buf);
1103 }
1104
1105 UNGCPRO;
1106 }
1107
1ab256cb
RM
1108 /* Make this buffer not be current.
1109 In the process, notice if this is the sole visible buffer
1110 and give up if so. */
1111 if (b == current_buffer)
1112 {
172a9c1f 1113 tem = Fother_buffer (buf, Qnil);
1ab256cb
RM
1114 Fset_buffer (tem);
1115 if (b == current_buffer)
1116 return Qnil;
1117 }
1118
1119 /* Now there is no question: we can kill the buffer. */
1120
1121#ifdef CLASH_DETECTION
1122 /* Unlock this buffer's file, if it is locked. */
1123 unlock_buffer (b);
1124#endif /* CLASH_DETECTION */
1125
1ab256cb 1126 kill_buffer_processes (buf);
1ab256cb
RM
1127
1128 tem = Vinhibit_quit;
1129 Vinhibit_quit = Qt;
00550f94 1130 replace_buffer_in_all_windows (buf);
b26dd9cb 1131 Vbuffer_alist = Fdelq (Frassq (buf, Vbuffer_alist), Vbuffer_alist);
7962a441 1132 frames_discard_buffer (buf);
1ab256cb
RM
1133 Vinhibit_quit = tem;
1134
9b59d6d0 1135 /* Delete any auto-save file, if we saved it in this session. */
a7a60ce9 1136 if (STRINGP (b->auto_save_file_name)
e95a0b39 1137 && b->auto_save_modified != 0
30e0071c 1138 && BUF_SAVE_MODIFF (b) < b->auto_save_modified)
1ab256cb
RM
1139 {
1140 Lisp_Object tem;
1141 tem = Fsymbol_value (intern ("delete-auto-save-files"));
265a9e55 1142 if (! NILP (tem))
cbb6a418 1143 internal_delete_file (b->auto_save_file_name);
1ab256cb
RM
1144 }
1145
4a4a9db5
KH
1146 if (b->base_buffer)
1147 {
1148 /* Unchain all markers that belong to this indirect buffer.
1149 Don't unchain the markers that belong to the base buffer
1150 or its other indirect buffers. */
1151 for (tem = BUF_MARKERS (b); !NILP (tem); )
1152 {
1153 Lisp_Object next;
1154 m = XMARKER (tem);
1155 next = m->chain;
1156 if (m->buffer == b)
1157 unchain_marker (tem);
1158 tem = next;
1159 }
1160 }
1161 else
1ab256cb 1162 {
4a4a9db5 1163 /* Unchain all markers of this buffer and its indirect buffers.
336cd056 1164 and leave them pointing nowhere. */
4a4a9db5 1165 for (tem = BUF_MARKERS (b); !NILP (tem); )
336cd056
RS
1166 {
1167 m = XMARKER (tem);
1168 m->buffer = 0;
1169 tem = m->chain;
1170 m->chain = Qnil;
1171 }
1172 BUF_MARKERS (b) = Qnil;
1ab256cb 1173
336cd056
RS
1174#ifdef USE_TEXT_PROPERTIES
1175 BUF_INTERVALS (b) = NULL_INTERVAL;
1176#endif
1177
1178 /* Perhaps we should explicitly free the interval tree here... */
1179 }
33f7013e 1180
2f3f993b
RS
1181 /* Reset the local variables, so that this buffer's local values
1182 won't be protected from GC. They would be protected
1183 if they happened to remain encached in their symbols.
1184 This gets rid of them for certain. */
1185 swap_out_buffer_local_variables (b);
13de9290 1186 reset_buffer_local_variables (b, 1);
2f3f993b 1187
1ab256cb 1188 b->name = Qnil;
336cd056 1189
9ac0d9e0 1190 BLOCK_INPUT;
336cd056
RS
1191 if (! b->base_buffer)
1192 BUFFER_FREE (BUF_BEG_ADDR (b));
1193
28e969dd
JB
1194 if (b->newline_cache)
1195 {
1196 free_region_cache (b->newline_cache);
1197 b->newline_cache = 0;
1198 }
1199 if (b->width_run_cache)
1200 {
1201 free_region_cache (b->width_run_cache);
1202 b->width_run_cache = 0;
1203 }
1204 b->width_table = Qnil;
9ac0d9e0 1205 UNBLOCK_INPUT;
1ab256cb
RM
1206 b->undo_list = Qnil;
1207
1208 return Qt;
1209}
1210\f
36a8c287
JB
1211/* Move the assoc for buffer BUF to the front of buffer-alist. Since
1212 we do this each time BUF is selected visibly, the more recently
1213 selected buffers are always closer to the front of the list. This
1214 means that other_buffer is more likely to choose a relevant buffer. */
1ab256cb 1215
01136e9b 1216void
1ab256cb
RM
1217record_buffer (buf)
1218 Lisp_Object buf;
1219{
1220 register Lisp_Object link, prev;
1221
1222 prev = Qnil;
1223 for (link = Vbuffer_alist; CONSP (link); link = XCONS (link)->cdr)
1224 {
1225 if (EQ (XCONS (XCONS (link)->car)->cdr, buf))
1226 break;
1227 prev = link;
1228 }
1229
36a8c287
JB
1230 /* Effectively do Vbuffer_alist = Fdelq (link, Vbuffer_alist);
1231 we cannot use Fdelq itself here because it allows quitting. */
1ab256cb 1232
265a9e55 1233 if (NILP (prev))
1ab256cb
RM
1234 Vbuffer_alist = XCONS (Vbuffer_alist)->cdr;
1235 else
1236 XCONS (prev)->cdr = XCONS (XCONS (prev)->cdr)->cdr;
1237
7962a441 1238 XCONS (link)->cdr = Vbuffer_alist;
1ab256cb 1239 Vbuffer_alist = link;
7962a441
RS
1240
1241 /* Now move this buffer to the front of frame_buffer_list also. */
1242
1243 prev = Qnil;
1244 for (link = frame_buffer_list (); CONSP (link); link = XCONS (link)->cdr)
1245 {
1246 if (EQ (XCONS (link)->car, buf))
1247 break;
1248 prev = link;
1249 }
1250
1251 /* Effectively do delq. */
1252
1253 if (CONSP (link))
1254 {
1255 if (NILP (prev))
1256 set_frame_buffer_list (XCONS (frame_buffer_list ())->cdr);
1257 else
1258 XCONS (prev)->cdr = XCONS (XCONS (prev)->cdr)->cdr;
1259
1260 XCONS (link)->cdr = frame_buffer_list ();
1261 set_frame_buffer_list (link);
1262 }
1263 else
1264 set_frame_buffer_list (Fcons (buf, frame_buffer_list ()));
1ab256cb
RM
1265}
1266
a9ee7a59
KH
1267DEFUN ("set-buffer-major-mode", Fset_buffer_major_mode, Sset_buffer_major_mode, 1, 1, 0,
1268 "Set an appropriate major mode for BUFFER, according to `default-major-mode'.\n\
1269Use this function before selecting the buffer, since it may need to inspect\n\
1270the current buffer's major mode.")
a2428fa2
EN
1271 (buffer)
1272 Lisp_Object buffer;
a9ee7a59
KH
1273{
1274 int count;
1275 Lisp_Object function;
1276
1277 function = buffer_defaults.major_mode;
1278 if (NILP (function) && NILP (Fget (current_buffer->major_mode, Qmode_class)))
1279 function = current_buffer->major_mode;
1280
1281 if (NILP (function) || EQ (function, Qfundamental_mode))
1282 return Qnil;
1283
1284 count = specpdl_ptr - specpdl;
1285
1286 /* To select a nonfundamental mode,
1287 select the buffer temporarily and then call the mode function. */
1288
1289 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1290
a2428fa2 1291 Fset_buffer (buffer);
a9ee7a59
KH
1292 call0 (function);
1293
1294 return unbind_to (count, Qnil);
1295}
1296
1ab256cb
RM
1297DEFUN ("switch-to-buffer", Fswitch_to_buffer, Sswitch_to_buffer, 1, 2, "BSwitch to buffer: ",
1298 "Select buffer BUFFER in the current window.\n\
1299BUFFER may be a buffer or a buffer name.\n\
1300Optional second arg NORECORD non-nil means\n\
1301do not put this buffer at the front of the list of recently selected ones.\n\
1302\n\
1303WARNING: This is NOT the way to work on another buffer temporarily\n\
1304within a Lisp program! Use `set-buffer' instead. That avoids messing with\n\
1305the window-buffer correspondences.")
a25f13ae
KH
1306 (buffer, norecord)
1307 Lisp_Object buffer, norecord;
1ab256cb
RM
1308{
1309 register Lisp_Object buf;
1310 Lisp_Object tem;
1311
1312 if (EQ (minibuf_window, selected_window))
1313 error ("Cannot switch buffers in minibuffer window");
1314 tem = Fwindow_dedicated_p (selected_window);
265a9e55 1315 if (!NILP (tem))
1ab256cb
RM
1316 error ("Cannot switch buffers in a dedicated window");
1317
a25f13ae 1318 if (NILP (buffer))
172a9c1f 1319 buf = Fother_buffer (Fcurrent_buffer (), Qnil);
1ab256cb 1320 else
a9ee7a59 1321 {
a25f13ae 1322 buf = Fget_buffer (buffer);
a9ee7a59
KH
1323 if (NILP (buf))
1324 {
a25f13ae 1325 buf = Fget_buffer_create (buffer);
a9ee7a59
KH
1326 Fset_buffer_major_mode (buf);
1327 }
1328 }
1ab256cb 1329 Fset_buffer (buf);
265a9e55 1330 if (NILP (norecord))
1ab256cb
RM
1331 record_buffer (buf);
1332
1333 Fset_window_buffer (EQ (selected_window, minibuf_window)
5fcd022d
JB
1334 ? Fnext_window (minibuf_window, Qnil, Qnil)
1335 : selected_window,
1ab256cb
RM
1336 buf);
1337
cd0c235a 1338 return buf;
1ab256cb
RM
1339}
1340
cd0c235a 1341DEFUN ("pop-to-buffer", Fpop_to_buffer, Spop_to_buffer, 1, 3, 0,
1ab256cb
RM
1342 "Select buffer BUFFER in some window, preferably a different one.\n\
1343If BUFFER is nil, then some other buffer is chosen.\n\
1344If `pop-up-windows' is non-nil, windows can be split to do this.\n\
1345If optional second arg OTHER-WINDOW is non-nil, insist on finding another\n\
405615e5
RS
1346window even if BUFFER is already visible in the selected window.\n\
1347This uses the function `display-buffer' as a subroutine; see the documentation\n\
6d12711f
RS
1348of `display-buffer' for additional customization information.\n\
1349\n\
1350Optional third arg NORECORD non-nil means\n\
1351do not put this buffer at the front of the list of recently selected ones.")
1352 (buffer, other_window, norecord)
1353 Lisp_Object buffer, other_window, norecord;
1ab256cb
RM
1354{
1355 register Lisp_Object buf;
a25f13ae 1356 if (NILP (buffer))
172a9c1f 1357 buf = Fother_buffer (Fcurrent_buffer (), Qnil);
1ab256cb 1358 else
7c2087ee 1359 {
a25f13ae 1360 buf = Fget_buffer (buffer);
7c2087ee
RS
1361 if (NILP (buf))
1362 {
a25f13ae 1363 buf = Fget_buffer_create (buffer);
7c2087ee
RS
1364 Fset_buffer_major_mode (buf);
1365 }
1366 }
1ab256cb 1367 Fset_buffer (buf);
6d12711f
RS
1368 if (NILP (norecord))
1369 record_buffer (buf);
6b17d756 1370 Fselect_window (Fdisplay_buffer (buf, other_window, Qnil));
e8b3a22d 1371 return buf;
1ab256cb
RM
1372}
1373
1374DEFUN ("current-buffer", Fcurrent_buffer, Scurrent_buffer, 0, 0, 0,
1375 "Return the current buffer as a Lisp object.")
1376 ()
1377{
1378 register Lisp_Object buf;
67180c6a 1379 XSETBUFFER (buf, current_buffer);
1ab256cb
RM
1380 return buf;
1381}
1382\f
c7aa5005 1383/* Set the current buffer to B. */
1ab256cb
RM
1384
1385void
1386set_buffer_internal (b)
1387 register struct buffer *b;
1388{
1389 register struct buffer *old_buf;
1390 register Lisp_Object tail, valcontents;
a7a60ce9 1391 Lisp_Object tem;
1ab256cb
RM
1392
1393 if (current_buffer == b)
1394 return;
1395
1396 windows_or_buffers_changed = 1;
c7aa5005
KH
1397 set_buffer_internal_1 (b);
1398}
1399
1400/* Set the current buffer to B, and do not set windows_or_buffers_changed.
1401 This is used by redisplay. */
1402
1403void
1404set_buffer_internal_1 (b)
1405 register struct buffer *b;
1406{
1407 register struct buffer *old_buf;
1408 register Lisp_Object tail, valcontents;
1409 Lisp_Object tem;
1410
1411 if (current_buffer == b)
1412 return;
1413
1ab256cb
RM
1414 old_buf = current_buffer;
1415 current_buffer = b;
1416 last_known_column_point = -1; /* invalidate indentation cache */
1417
336cd056
RS
1418 if (old_buf)
1419 {
1420 /* Put the undo list back in the base buffer, so that it appears
1421 that an indirect buffer shares the undo list of its base. */
1422 if (old_buf->base_buffer)
1423 old_buf->base_buffer->undo_list = old_buf->undo_list;
1424
1425 /* If the old current buffer has markers to record PT, BEGV and ZV
1426 when it is not current, update them now. */
1427 if (! NILP (old_buf->pt_marker))
1428 {
1429 Lisp_Object obuf;
1430 XSETBUFFER (obuf, old_buf);
3f236a40
RS
1431 set_marker_both (old_buf->pt_marker, obuf,
1432 BUF_PT (old_buf), BUF_PT_BYTE (old_buf));
336cd056
RS
1433 }
1434 if (! NILP (old_buf->begv_marker))
1435 {
1436 Lisp_Object obuf;
1437 XSETBUFFER (obuf, old_buf);
3f236a40
RS
1438 set_marker_both (old_buf->begv_marker, obuf,
1439 BUF_BEGV (old_buf), BUF_BEGV_BYTE (old_buf));
336cd056
RS
1440 }
1441 if (! NILP (old_buf->zv_marker))
1442 {
1443 Lisp_Object obuf;
1444 XSETBUFFER (obuf, old_buf);
3f236a40
RS
1445 set_marker_both (old_buf->zv_marker, obuf,
1446 BUF_ZV (old_buf), BUF_ZV_BYTE (old_buf));
336cd056
RS
1447 }
1448 }
1449
1450 /* Get the undo list from the base buffer, so that it appears
1451 that an indirect buffer shares the undo list of its base. */
1452 if (b->base_buffer)
1453 b->undo_list = b->base_buffer->undo_list;
1454
1455 /* If the new current buffer has markers to record PT, BEGV and ZV
1456 when it is not current, fetch them now. */
1457 if (! NILP (b->pt_marker))
3f236a40
RS
1458 {
1459 BUF_PT (b) = marker_position (b->pt_marker);
1460 BUF_PT_BYTE (b) = marker_byte_position (b->pt_marker);
1461 }
336cd056 1462 if (! NILP (b->begv_marker))
3f236a40
RS
1463 {
1464 BUF_BEGV (b) = marker_position (b->begv_marker);
1465 BUF_BEGV_BYTE (b) = marker_byte_position (b->begv_marker);
1466 }
336cd056 1467 if (! NILP (b->zv_marker))
3f236a40
RS
1468 {
1469 BUF_ZV (b) = marker_position (b->zv_marker);
1470 BUF_ZV_BYTE (b) = marker_byte_position (b->zv_marker);
1471 }
336cd056 1472
1ab256cb
RM
1473 /* Look down buffer's list of local Lisp variables
1474 to find and update any that forward into C variables. */
1475
265a9e55 1476 for (tail = b->local_var_alist; !NILP (tail); tail = XCONS (tail)->cdr)
1ab256cb
RM
1477 {
1478 valcontents = XSYMBOL (XCONS (XCONS (tail)->car)->car)->value;
a7a60ce9
KH
1479 if ((BUFFER_LOCAL_VALUEP (valcontents)
1480 || SOME_BUFFER_LOCAL_VALUEP (valcontents))
3d871c85 1481 && (tem = XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
a7a60ce9 1482 (BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem))))
1ab256cb
RM
1483 /* Just reference the variable
1484 to cause it to become set for this buffer. */
1485 Fsymbol_value (XCONS (XCONS (tail)->car)->car);
1486 }
1487
1488 /* Do the same with any others that were local to the previous buffer */
1489
1490 if (old_buf)
265a9e55 1491 for (tail = old_buf->local_var_alist; !NILP (tail); tail = XCONS (tail)->cdr)
1ab256cb
RM
1492 {
1493 valcontents = XSYMBOL (XCONS (XCONS (tail)->car)->car)->value;
a7a60ce9
KH
1494 if ((BUFFER_LOCAL_VALUEP (valcontents)
1495 || SOME_BUFFER_LOCAL_VALUEP (valcontents))
3d871c85 1496 && (tem = XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
a7a60ce9 1497 (BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem))))
1ab256cb
RM
1498 /* Just reference the variable
1499 to cause it to become set for this buffer. */
1500 Fsymbol_value (XCONS (XCONS (tail)->car)->car);
1501 }
1502}
1503
336cd056 1504/* Switch to buffer B temporarily for redisplay purposes.
bbbe9545 1505 This avoids certain things that don't need to be done within redisplay. */
336cd056
RS
1506
1507void
1508set_buffer_temp (b)
1509 struct buffer *b;
1510{
1511 register struct buffer *old_buf;
1512
1513 if (current_buffer == b)
1514 return;
1515
1516 old_buf = current_buffer;
1517 current_buffer = b;
1518
1519 if (old_buf)
1520 {
1521 /* If the old current buffer has markers to record PT, BEGV and ZV
1522 when it is not current, update them now. */
1523 if (! NILP (old_buf->pt_marker))
1524 {
1525 Lisp_Object obuf;
1526 XSETBUFFER (obuf, old_buf);
3f236a40
RS
1527 set_marker_both (old_buf->pt_marker, obuf,
1528 BUF_PT (old_buf), BUF_PT_BYTE (old_buf));
336cd056
RS
1529 }
1530 if (! NILP (old_buf->begv_marker))
1531 {
1532 Lisp_Object obuf;
1533 XSETBUFFER (obuf, old_buf);
3f236a40
RS
1534 set_marker_both (old_buf->begv_marker, obuf,
1535 BUF_BEGV (old_buf), BUF_BEGV_BYTE (old_buf));
336cd056
RS
1536 }
1537 if (! NILP (old_buf->zv_marker))
1538 {
1539 Lisp_Object obuf;
1540 XSETBUFFER (obuf, old_buf);
3f236a40
RS
1541 set_marker_both (old_buf->zv_marker, obuf,
1542 BUF_ZV (old_buf), BUF_ZV_BYTE (old_buf));
336cd056
RS
1543 }
1544 }
1545
1546 /* If the new current buffer has markers to record PT, BEGV and ZV
1547 when it is not current, fetch them now. */
1548 if (! NILP (b->pt_marker))
3f236a40
RS
1549 {
1550 BUF_PT (b) = marker_position (b->pt_marker);
1551 BUF_PT_BYTE (b) = marker_byte_position (b->pt_marker);
1552 }
336cd056 1553 if (! NILP (b->begv_marker))
3f236a40
RS
1554 {
1555 BUF_BEGV (b) = marker_position (b->begv_marker);
1556 BUF_BEGV_BYTE (b) = marker_byte_position (b->begv_marker);
1557 }
336cd056 1558 if (! NILP (b->zv_marker))
3f236a40
RS
1559 {
1560 BUF_ZV (b) = marker_position (b->zv_marker);
1561 BUF_ZV_BYTE (b) = marker_byte_position (b->zv_marker);
1562 }
336cd056
RS
1563}
1564
1ab256cb
RM
1565DEFUN ("set-buffer", Fset_buffer, Sset_buffer, 1, 1, 0,
1566 "Make the buffer BUFFER current for editing operations.\n\
1567BUFFER may be a buffer or the name of an existing buffer.\n\
1568See also `save-excursion' when you want to make a buffer current temporarily.\n\
1569This function does not display the buffer, so its effect ends\n\
1570when the current command terminates.\n\
1571Use `switch-to-buffer' or `pop-to-buffer' to switch buffers permanently.")
a25f13ae
KH
1572 (buffer)
1573 register Lisp_Object buffer;
1ab256cb 1574{
a25f13ae
KH
1575 register Lisp_Object buf;
1576 buf = Fget_buffer (buffer);
1577 if (NILP (buf))
1578 nsberror (buffer);
1579 if (NILP (XBUFFER (buf)->name))
1ab256cb 1580 error ("Selecting deleted buffer");
a25f13ae
KH
1581 set_buffer_internal (XBUFFER (buf));
1582 return buf;
1ab256cb 1583}
d0628b06
RS
1584
1585/* Set the current buffer to BUFFER provided it is alive. */
1586
1587Lisp_Object
1588set_buffer_if_live (buffer)
1589 Lisp_Object buffer;
1590{
1591 if (! NILP (XBUFFER (buffer)->name))
1592 Fset_buffer (buffer);
1593 return Qnil;
1594}
1ab256cb
RM
1595\f
1596DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only,
1597 Sbarf_if_buffer_read_only, 0, 0, 0,
1598 "Signal a `buffer-read-only' error if the current buffer is read-only.")
1599 ()
1600{
a96b68f1
RS
1601 if (!NILP (current_buffer->read_only)
1602 && NILP (Vinhibit_read_only))
1ab256cb
RM
1603 Fsignal (Qbuffer_read_only, (Fcons (Fcurrent_buffer (), Qnil)));
1604 return Qnil;
1605}
1606
1607DEFUN ("bury-buffer", Fbury_buffer, Sbury_buffer, 0, 1, "",
1608 "Put BUFFER at the end of the list of all buffers.\n\
1609There it is the least likely candidate for `other-buffer' to return;\n\
528415e7 1610thus, the least likely buffer for \\[switch-to-buffer] to select by default.\n\
a5611885
JB
1611If BUFFER is nil or omitted, bury the current buffer.\n\
1612Also, if BUFFER is nil or omitted, remove the current buffer from the\n\
1613selected window if it is displayed there.")
a2428fa2
EN
1614 (buffer)
1615 register Lisp_Object buffer;
1ab256cb 1616{
b271272a 1617 /* Figure out what buffer we're going to bury. */
a2428fa2 1618 if (NILP (buffer))
a5611885 1619 {
a2428fa2 1620 XSETBUFFER (buffer, current_buffer);
0a63b212
RS
1621
1622 /* If we're burying the current buffer, unshow it. */
1623 Fswitch_to_buffer (Fother_buffer (buffer, Qnil), Qnil);
a5611885 1624 }
1ab256cb
RM
1625 else
1626 {
1627 Lisp_Object buf1;
1628
a2428fa2 1629 buf1 = Fget_buffer (buffer);
265a9e55 1630 if (NILP (buf1))
a2428fa2
EN
1631 nsberror (buffer);
1632 buffer = buf1;
b271272a
JB
1633 }
1634
a2428fa2 1635 /* Move buffer to the end of the buffer list. */
b271272a
JB
1636 {
1637 register Lisp_Object aelt, link;
1638
a2428fa2 1639 aelt = Frassq (buffer, Vbuffer_alist);
b271272a
JB
1640 link = Fmemq (aelt, Vbuffer_alist);
1641 Vbuffer_alist = Fdelq (aelt, Vbuffer_alist);
1642 XCONS (link)->cdr = Qnil;
1643 Vbuffer_alist = nconc2 (Vbuffer_alist, link);
1644 }
1ab256cb 1645
dcb26650 1646 frames_bury_buffer (buffer);
dec989eb 1647
1ab256cb
RM
1648 return Qnil;
1649}
1650\f
c922bc55 1651DEFUN ("erase-buffer", Ferase_buffer, Serase_buffer, 0, 0, "*",
1ab256cb 1652 "Delete the entire contents of the current buffer.\n\
2950a20e 1653Any narrowing restriction in effect (see `narrow-to-region') is removed,\n\
1ab256cb
RM
1654so the buffer is truly empty after this.")
1655 ()
1656{
1657 Fwiden ();
1658 del_range (BEG, Z);
1659 current_buffer->last_window_start = 1;
1660 /* Prevent warnings, or suspension of auto saving, that would happen
1661 if future size is less than past size. Use of erase-buffer
1662 implies that the future text is not really related to the past text. */
8d7a4592 1663 XSETFASTINT (current_buffer->save_length, 0);
1ab256cb
RM
1664 return Qnil;
1665}
1666
01136e9b 1667void
1ab256cb
RM
1668validate_region (b, e)
1669 register Lisp_Object *b, *e;
1670{
1ab256cb
RM
1671 CHECK_NUMBER_COERCE_MARKER (*b, 0);
1672 CHECK_NUMBER_COERCE_MARKER (*e, 1);
1673
1674 if (XINT (*b) > XINT (*e))
1675 {
03192067
KH
1676 Lisp_Object tem;
1677 tem = *b; *b = *e; *e = tem;
1ab256cb
RM
1678 }
1679
1680 if (!(BEGV <= XINT (*b) && XINT (*b) <= XINT (*e)
1681 && XINT (*e) <= ZV))
1682 args_out_of_range (*b, *e);
1683}
1684\f
b05525fa
RS
1685/* Advance BYTE_POS up to a character boundary
1686 and return the adjusted position. */
1687
1688static int
1689advance_to_char_boundary (byte_pos)
1690 int byte_pos;
1691{
f8449323 1692 int c;
b05525fa 1693
f8449323
RS
1694 if (byte_pos == BEG)
1695 /* Beginning of buffer is always a character boundary. */
1696 return 1;
1697
1698 c = FETCH_BYTE (byte_pos);
1699 if (! CHAR_HEAD_P (c))
b05525fa 1700 {
f8449323
RS
1701 /* We should advance BYTE_POS only when C is a constituen of a
1702 multibyte sequence. */
1703 DEC_POS (byte_pos);
1704 INC_POS (byte_pos);
1705 /* If C is a constituent of a multibyte sequence, BYTE_POS was
1706 surely advance to the correct character boundary. If C is
1707 not, BYTE_POS was unchanged. */
b05525fa
RS
1708 }
1709
20773569 1710 return byte_pos;
b05525fa
RS
1711}
1712
3ac81adb
RS
1713DEFUN ("set-buffer-multibyte", Fset_buffer_multibyte, Sset_buffer_multibyte,
1714 1, 1, 0,
1715 "Set the multibyte flag of the current buffer to FLAG.\n\
1716If FLAG is t, this makes the buffer a multibyte buffer.\n\
1717If FLAG is nil, this makes the buffer a single-byte buffer.\n\
1718The buffer contents remain unchanged as a sequence of bytes\n\
1719but the contents viewed as characters do change.")
1720 (flag)
1721 Lisp_Object flag;
1722{
1723 Lisp_Object tail, markers;
1724
70e77119
AS
1725 /* Do nothing if nothing actually changes. */
1726 if (NILP (flag) == NILP (current_buffer->enable_multibyte_characters))
1727 return flag;
1728
b05525fa
RS
1729 /* It would be better to update the list,
1730 but this is good enough for now. */
1731 if (! EQ (current_buffer->undo_list, Qt))
1732 current_buffer->undo_list = Qnil;
1733
3ac81adb
RS
1734 /* If the cached position is for this buffer, clear it out. */
1735 clear_charpos_cache (current_buffer);
1736
1737 if (NILP (flag))
1738 {
1739 /* Do this first, so it can use CHAR_TO_BYTE
1740 to calculate the old correspondences. */
1741 set_intervals_multibyte (0);
1742
1743 current_buffer->enable_multibyte_characters = Qnil;
1744
1745 Z = Z_BYTE;
1746 BEGV = BEGV_BYTE;
1747 ZV = ZV_BYTE;
1748 GPT = GPT_BYTE;
1749 TEMP_SET_PT_BOTH (PT_BYTE, PT_BYTE);
1750
1751 tail = BUF_MARKERS (current_buffer);
1752 while (XSYMBOL (tail) != XSYMBOL (Qnil))
1753 {
1754 XMARKER (tail)->charpos = XMARKER (tail)->bytepos;
1755 tail = XMARKER (tail)->chain;
1756 }
1757 }
1758 else
1759 {
673c57d2
KH
1760 /* Be sure not to have a multibyte sequence striding over the GAP.
1761 Ex: We change this: "...abc\201\241\241 _GAP_ \241\241\241..."
1762 to: "...abc _GAP_ \201\241\241\241\241\241..." */
1763
1764 if (GPT_BYTE > 1 && GPT_BYTE < Z_BYTE
1765 && ! CHAR_HEAD_P (*(GAP_END_ADDR)))
1766 {
1767 unsigned char *p = GPT_ADDR - 1;
1768
1769 while (! CHAR_HEAD_P (*p) && p > BEG_ADDR) p--;
1770 if (BASE_LEADING_CODE_P (*p))
1771 {
1772 int new_gpt = GPT_BYTE - (GPT_ADDR - p);
1773
1774 move_gap_both (new_gpt, new_gpt);
1775 }
1776 }
1777
3ac81adb
RS
1778 /* Do this first, so that chars_in_text asks the right question.
1779 set_intervals_multibyte needs it too. */
1780 current_buffer->enable_multibyte_characters = Qt;
1781
b05525fa 1782 GPT_BYTE = advance_to_char_boundary (GPT_BYTE);
3ac81adb 1783 GPT = chars_in_text (BEG_ADDR, GPT_BYTE - BEG_BYTE) + BEG;
b05525fa 1784
673c57d2 1785 Z = chars_in_text (GAP_END_ADDR, Z_BYTE - GPT_BYTE) + GPT;
b05525fa
RS
1786
1787 BEGV_BYTE = advance_to_char_boundary (BEGV_BYTE);
3ac81adb 1788 if (BEGV_BYTE > GPT_BYTE)
673c57d2 1789 BEGV = chars_in_text (GAP_END_ADDR, BEGV_BYTE - GPT_BYTE) + GPT;
3ac81adb
RS
1790 else
1791 BEGV = chars_in_text (BEG_ADDR, BEGV_BYTE - BEG_BYTE) + BEG;
b05525fa
RS
1792
1793 ZV_BYTE = advance_to_char_boundary (ZV_BYTE);
3ac81adb 1794 if (ZV_BYTE > GPT_BYTE)
673c57d2 1795 ZV = chars_in_text (GAP_END_ADDR, ZV_BYTE - GPT_BYTE) + GPT;
3ac81adb
RS
1796 else
1797 ZV = chars_in_text (BEG_ADDR, ZV_BYTE - BEG_BYTE) + BEG;
b05525fa
RS
1798
1799 {
1800 int pt_byte = advance_to_char_boundary (PT_BYTE);
1801 int pt;
1802
1803 if (pt_byte > GPT_BYTE)
673c57d2 1804 pt = chars_in_text (GAP_END_ADDR, pt_byte - GPT_BYTE) + GPT;
b05525fa
RS
1805 else
1806 pt = chars_in_text (BEG_ADDR, pt_byte - BEG_BYTE) + BEG;
1807 TEMP_SET_PT_BOTH (pt, pt_byte);
1808 }
3ac81adb
RS
1809
1810 tail = markers = BUF_MARKERS (current_buffer);
1811 BUF_MARKERS (current_buffer) = Qnil;
1812
1813 while (XSYMBOL (tail) != XSYMBOL (Qnil))
1814 {
b05525fa
RS
1815 XMARKER (tail)->bytepos
1816 = advance_to_char_boundary (XMARKER (tail)->bytepos);
3ac81adb 1817 XMARKER (tail)->charpos = BYTE_TO_CHAR (XMARKER (tail)->bytepos);
b05525fa 1818
3ac81adb
RS
1819 tail = XMARKER (tail)->chain;
1820 }
1821 BUF_MARKERS (current_buffer) = markers;
1822
1823 /* Do this last, so it can calculate the new correspondences
1824 between chars and bytes. */
1825 set_intervals_multibyte (1);
1826 }
1827
1828 return flag;
1829}
1830\f
1ab256cb
RM
1831DEFUN ("kill-all-local-variables", Fkill_all_local_variables, Skill_all_local_variables,
1832 0, 0, 0,
1833 "Switch to Fundamental mode by killing current buffer's local variables.\n\
1834Most local variable bindings are eliminated so that the default values\n\
1835become effective once more. Also, the syntax table is set from\n\
1836`standard-syntax-table', the local keymap is set to nil,\n\
1837and the abbrev table from `fundamental-mode-abbrev-table'.\n\
1838This function also forces redisplay of the mode line.\n\
1839\n\
1840Every function to select a new major mode starts by\n\
1841calling this function.\n\n\
1842As a special exception, local variables whose names have\n\
c5a15222
RS
1843a non-nil `permanent-local' property are not eliminated by this function.\n\
1844\n\
1845The first thing this function does is run\n\
1846the normal hook `change-major-mode-hook'.")
1ab256cb
RM
1847 ()
1848{
1849 register Lisp_Object alist, sym, tem;
1850 Lisp_Object oalist;
7410477a 1851
fd186f07
RS
1852 if (!NILP (Vrun_hooks))
1853 call1 (Vrun_hooks, intern ("change-major-mode-hook"));
1ab256cb
RM
1854 oalist = current_buffer->local_var_alist;
1855
2f3f993b
RS
1856 /* Make sure none of the bindings in oalist
1857 remain swapped in, in their symbols. */
1ab256cb 1858
2f3f993b 1859 swap_out_buffer_local_variables (current_buffer);
1ab256cb
RM
1860
1861 /* Actually eliminate all local bindings of this buffer. */
1862
13de9290 1863 reset_buffer_local_variables (current_buffer, 0);
1ab256cb
RM
1864
1865 /* Redisplay mode lines; we are changing major mode. */
1866
1867 update_mode_lines++;
1868
1869 /* Any which are supposed to be permanent,
1870 make local again, with the same values they had. */
1871
265a9e55 1872 for (alist = oalist; !NILP (alist); alist = XCONS (alist)->cdr)
1ab256cb
RM
1873 {
1874 sym = XCONS (XCONS (alist)->car)->car;
1875 tem = Fget (sym, Qpermanent_local);
265a9e55 1876 if (! NILP (tem))
01050cb5
RM
1877 {
1878 Fmake_local_variable (sym);
1879 Fset (sym, XCONS (XCONS (alist)->car)->cdr);
1880 }
1ab256cb
RM
1881 }
1882
1883 /* Force mode-line redisplay. Useful here because all major mode
1884 commands call this function. */
1885 update_mode_lines++;
1886
1887 return Qnil;
1888}
2f3f993b
RS
1889
1890/* Make sure no local variables remain set up with buffer B
1891 for their current values. */
1892
1893static void
1894swap_out_buffer_local_variables (b)
1895 struct buffer *b;
1896{
1897 Lisp_Object oalist, alist, sym, tem, buffer;
1898
1899 XSETBUFFER (buffer, b);
1900 oalist = b->local_var_alist;
1901
1902 for (alist = oalist; !NILP (alist); alist = XCONS (alist)->cdr)
1903 {
1904 sym = XCONS (XCONS (alist)->car)->car;
1905
1906 /* Need not do anything if some other buffer's binding is now encached. */
3d871c85 1907 tem = XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->buffer;
2f3f993b
RS
1908 if (XBUFFER (tem) == current_buffer)
1909 {
1910 /* Symbol is set up for this buffer's old local value.
1911 Set it up for the current buffer with the default value. */
1912
3d871c85 1913 tem = XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->cdr;
2f3f993b
RS
1914 /* Store the symbol's current value into the alist entry
1915 it is currently set up for. This is so that, if the
1916 local is marked permanent, and we make it local again
1917 later in Fkill_all_local_variables, we don't lose the value. */
1918 XCONS (XCONS (tem)->car)->cdr
3d871c85 1919 = do_symval_forwarding (XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->realvalue);
2f3f993b
RS
1920 /* Switch to the symbol's default-value alist entry. */
1921 XCONS (tem)->car = tem;
1922 /* Mark it as current for buffer B. */
3d871c85 1923 XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->buffer = buffer;
2f3f993b 1924 /* Store the current value into any forwarding in the symbol. */
3d871c85
RS
1925 store_symval_forwarding (sym,
1926 XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->realvalue,
2f3f993b
RS
1927 XCONS (tem)->cdr);
1928 }
1929 }
1930}
1ab256cb 1931\f
2eec3b4e
RS
1932/* Find all the overlays in the current buffer that contain position POS.
1933 Return the number found, and store them in a vector in *VEC_PTR.
1934 Store in *LEN_PTR the size allocated for the vector.
52f8ec73
JB
1935 Store in *NEXT_PTR the next position after POS where an overlay starts,
1936 or ZV if there are no more overlays.
bbbe9545 1937 Store in *PREV_PTR the previous position before POS where an overlay ends,
239c932b
RS
1938 or BEGV if there are no previous overlays.
1939 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
2eec3b4e
RS
1940
1941 *VEC_PTR and *LEN_PTR should contain a valid vector and size
61d54cd5
RS
1942 when this function is called.
1943
1944 If EXTEND is non-zero, we make the vector bigger if necessary.
1945 If EXTEND is zero, we never extend the vector,
1946 and we store only as many overlays as will fit.
1947 But we still return the total number of overlays. */
2eec3b4e
RS
1948
1949int
239c932b 1950overlays_at (pos, extend, vec_ptr, len_ptr, next_ptr, prev_ptr)
2eec3b4e 1951 int pos;
61d54cd5 1952 int extend;
2eec3b4e
RS
1953 Lisp_Object **vec_ptr;
1954 int *len_ptr;
1955 int *next_ptr;
239c932b 1956 int *prev_ptr;
1ab256cb 1957{
2eec3b4e
RS
1958 Lisp_Object tail, overlay, start, end, result;
1959 int idx = 0;
1960 int len = *len_ptr;
1961 Lisp_Object *vec = *vec_ptr;
1962 int next = ZV;
239c932b 1963 int prev = BEGV;
61d54cd5
RS
1964 int inhibit_storing = 0;
1965
2eec3b4e 1966 for (tail = current_buffer->overlays_before;
8fc0589a 1967 GC_CONSP (tail);
2eec3b4e
RS
1968 tail = XCONS (tail)->cdr)
1969 {
239c932b 1970 int startpos, endpos;
52f8ec73 1971
2eec3b4e 1972 overlay = XCONS (tail)->car;
1ab256cb 1973
2eec3b4e
RS
1974 start = OVERLAY_START (overlay);
1975 end = OVERLAY_END (overlay);
239c932b
RS
1976 endpos = OVERLAY_POSITION (end);
1977 if (endpos < pos)
1978 {
1979 if (prev < endpos)
1980 prev = endpos;
1981 break;
1982 }
1983 if (endpos == pos)
1984 continue;
2eec3b4e
RS
1985 startpos = OVERLAY_POSITION (start);
1986 if (startpos <= pos)
1987 {
1988 if (idx == len)
1989 {
61d54cd5
RS
1990 /* The supplied vector is full.
1991 Either make it bigger, or don't store any more in it. */
1992 if (extend)
1993 {
1994 *len_ptr = len *= 2;
1995 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
1996 *vec_ptr = vec;
1997 }
1998 else
1999 inhibit_storing = 1;
2eec3b4e 2000 }
61d54cd5
RS
2001
2002 if (!inhibit_storing)
2003 vec[idx] = overlay;
2004 /* Keep counting overlays even if we can't return them all. */
2005 idx++;
2eec3b4e
RS
2006 }
2007 else if (startpos < next)
2008 next = startpos;
2009 }
2010
2011 for (tail = current_buffer->overlays_after;
8fc0589a 2012 GC_CONSP (tail);
2eec3b4e 2013 tail = XCONS (tail)->cdr)
1ab256cb 2014 {
239c932b 2015 int startpos, endpos;
52f8ec73 2016
2eec3b4e 2017 overlay = XCONS (tail)->car;
2eec3b4e
RS
2018
2019 start = OVERLAY_START (overlay);
2020 end = OVERLAY_END (overlay);
2021 startpos = OVERLAY_POSITION (start);
52f8ec73 2022 if (pos < startpos)
2eec3b4e
RS
2023 {
2024 if (startpos < next)
2025 next = startpos;
2026 break;
2027 }
239c932b
RS
2028 endpos = OVERLAY_POSITION (end);
2029 if (pos < endpos)
2eec3b4e
RS
2030 {
2031 if (idx == len)
2032 {
61d54cd5
RS
2033 if (extend)
2034 {
2035 *len_ptr = len *= 2;
2036 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2037 *vec_ptr = vec;
2038 }
2039 else
2040 inhibit_storing = 1;
2eec3b4e 2041 }
61d54cd5
RS
2042
2043 if (!inhibit_storing)
2044 vec[idx] = overlay;
2045 idx++;
2eec3b4e 2046 }
239c932b
RS
2047 else if (endpos < pos && endpos > prev)
2048 prev = endpos;
1ab256cb
RM
2049 }
2050
239c932b
RS
2051 if (next_ptr)
2052 *next_ptr = next;
2053 if (prev_ptr)
2054 *prev_ptr = prev;
2eec3b4e
RS
2055 return idx;
2056}
74514898
RS
2057\f
2058/* Find all the overlays in the current buffer that overlap the range BEG-END
2a3eeee7
RS
2059 or are empty at BEG.
2060
74514898
RS
2061 Return the number found, and store them in a vector in *VEC_PTR.
2062 Store in *LEN_PTR the size allocated for the vector.
2063 Store in *NEXT_PTR the next position after POS where an overlay starts,
2064 or ZV if there are no more overlays.
2065 Store in *PREV_PTR the previous position before POS where an overlay ends,
2066 or BEGV if there are no previous overlays.
2067 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
2068
2069 *VEC_PTR and *LEN_PTR should contain a valid vector and size
2070 when this function is called.
2071
2072 If EXTEND is non-zero, we make the vector bigger if necessary.
2073 If EXTEND is zero, we never extend the vector,
2074 and we store only as many overlays as will fit.
2075 But we still return the total number of overlays. */
2076
2077int
2078overlays_in (beg, end, extend, vec_ptr, len_ptr, next_ptr, prev_ptr)
2079 int beg, end;
2080 int extend;
2081 Lisp_Object **vec_ptr;
2082 int *len_ptr;
2083 int *next_ptr;
2084 int *prev_ptr;
2085{
2086 Lisp_Object tail, overlay, ostart, oend, result;
2087 int idx = 0;
2088 int len = *len_ptr;
2089 Lisp_Object *vec = *vec_ptr;
2090 int next = ZV;
2091 int prev = BEGV;
2092 int inhibit_storing = 0;
2093
2094 for (tail = current_buffer->overlays_before;
2095 GC_CONSP (tail);
2096 tail = XCONS (tail)->cdr)
2097 {
2098 int startpos, endpos;
2099
2100 overlay = XCONS (tail)->car;
2101
2102 ostart = OVERLAY_START (overlay);
2103 oend = OVERLAY_END (overlay);
2104 endpos = OVERLAY_POSITION (oend);
2105 if (endpos < beg)
2106 {
2107 if (prev < endpos)
2108 prev = endpos;
2109 break;
2110 }
2111 startpos = OVERLAY_POSITION (ostart);
2112 /* Count an interval if it either overlaps the range
2a3eeee7 2113 or is empty at the start of the range. */
74514898 2114 if ((beg < endpos && startpos < end)
2a3eeee7 2115 || (startpos == endpos && beg == endpos))
74514898
RS
2116 {
2117 if (idx == len)
2118 {
2119 /* The supplied vector is full.
2120 Either make it bigger, or don't store any more in it. */
2121 if (extend)
2122 {
2123 *len_ptr = len *= 2;
2124 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2125 *vec_ptr = vec;
2126 }
2127 else
2128 inhibit_storing = 1;
2129 }
2130
2131 if (!inhibit_storing)
2132 vec[idx] = overlay;
2133 /* Keep counting overlays even if we can't return them all. */
2134 idx++;
2135 }
2136 else if (startpos < next)
2137 next = startpos;
2138 }
2139
2140 for (tail = current_buffer->overlays_after;
2141 GC_CONSP (tail);
2142 tail = XCONS (tail)->cdr)
2143 {
2144 int startpos, endpos;
2145
2146 overlay = XCONS (tail)->car;
2147
2148 ostart = OVERLAY_START (overlay);
2149 oend = OVERLAY_END (overlay);
2150 startpos = OVERLAY_POSITION (ostart);
2151 if (end < startpos)
2152 {
2153 if (startpos < next)
2154 next = startpos;
2155 break;
2156 }
2157 endpos = OVERLAY_POSITION (oend);
2a3eeee7
RS
2158 /* Count an interval if it either overlaps the range
2159 or is empty at the start of the range. */
74514898 2160 if ((beg < endpos && startpos < end)
2a3eeee7 2161 || (startpos == endpos && beg == endpos))
74514898
RS
2162 {
2163 if (idx == len)
2164 {
2165 if (extend)
2166 {
2167 *len_ptr = len *= 2;
2168 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2169 *vec_ptr = vec;
2170 }
2171 else
2172 inhibit_storing = 1;
2173 }
2174
2175 if (!inhibit_storing)
2176 vec[idx] = overlay;
2177 idx++;
2178 }
2179 else if (endpos < beg && endpos > prev)
2180 prev = endpos;
2181 }
fc04fa47 2182
74514898
RS
2183 if (next_ptr)
2184 *next_ptr = next;
2185 if (prev_ptr)
2186 *prev_ptr = prev;
2187 return idx;
2188}
2189\f
fc04fa47
KH
2190/* Fast function to just test if we're at an overlay boundary. */
2191int
2192overlay_touches_p (pos)
2193 int pos;
2194{
2195 Lisp_Object tail, overlay;
2196
2197 for (tail = current_buffer->overlays_before; GC_CONSP (tail);
2198 tail = XCONS (tail)->cdr)
2199 {
2200 int endpos;
2201
2202 overlay = XCONS (tail)->car;
2203 if (!GC_OVERLAYP (overlay))
2204 abort ();
2205
2206 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2207 if (endpos < pos)
2208 break;
2209 if (endpos == pos || OVERLAY_POSITION (OVERLAY_START (overlay)) == pos)
2210 return 1;
2211 }
2212
2213 for (tail = current_buffer->overlays_after; GC_CONSP (tail);
2214 tail = XCONS (tail)->cdr)
2215 {
2216 int startpos;
2217
2218 overlay = XCONS (tail)->car;
2219 if (!GC_OVERLAYP (overlay))
2220 abort ();
2221
2222 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2223 if (pos < startpos)
2224 break;
2225 if (startpos == pos || OVERLAY_POSITION (OVERLAY_END (overlay)) == pos)
2226 return 1;
2227 }
2228 return 0;
2229}
2eec3b4e 2230\f
5985d248
KH
2231struct sortvec
2232{
2233 Lisp_Object overlay;
2234 int beg, end;
2235 int priority;
2236};
2237
2238static int
dfcf069d
AS
2239compare_overlays (v1, v2)
2240 const void *v1, *v2;
5985d248 2241{
dfcf069d
AS
2242 const struct sortvec *s1 = (const struct sortvec *) v1;
2243 const struct sortvec *s2 = (const struct sortvec *) v2;
5985d248
KH
2244 if (s1->priority != s2->priority)
2245 return s1->priority - s2->priority;
2246 if (s1->beg != s2->beg)
2247 return s1->beg - s2->beg;
2248 if (s1->end != s2->end)
2249 return s2->end - s1->end;
2250 return 0;
2251}
2252
2253/* Sort an array of overlays by priority. The array is modified in place.
2254 The return value is the new size; this may be smaller than the original
2255 size if some of the overlays were invalid or were window-specific. */
2256int
2257sort_overlays (overlay_vec, noverlays, w)
2258 Lisp_Object *overlay_vec;
2259 int noverlays;
2260 struct window *w;
2261{
2262 int i, j;
2263 struct sortvec *sortvec;
2264 sortvec = (struct sortvec *) alloca (noverlays * sizeof (struct sortvec));
2265
2266 /* Put the valid and relevant overlays into sortvec. */
2267
2268 for (i = 0, j = 0; i < noverlays; i++)
2269 {
0fa767e7 2270 Lisp_Object tem;
c99fc30f 2271 Lisp_Object overlay;
5985d248 2272
c99fc30f 2273 overlay = overlay_vec[i];
5985d248
KH
2274 if (OVERLAY_VALID (overlay)
2275 && OVERLAY_POSITION (OVERLAY_START (overlay)) > 0
2276 && OVERLAY_POSITION (OVERLAY_END (overlay)) > 0)
2277 {
0fa767e7
KH
2278 /* If we're interested in a specific window, then ignore
2279 overlays that are limited to some other window. */
2280 if (w)
5985d248 2281 {
0fa767e7
KH
2282 Lisp_Object window;
2283
2284 window = Foverlay_get (overlay, Qwindow);
a7a60ce9 2285 if (WINDOWP (window) && XWINDOW (window) != w)
0fa767e7 2286 continue;
5985d248 2287 }
0fa767e7
KH
2288
2289 /* This overlay is good and counts: put it into sortvec. */
2290 sortvec[j].overlay = overlay;
2291 sortvec[j].beg = OVERLAY_POSITION (OVERLAY_START (overlay));
2292 sortvec[j].end = OVERLAY_POSITION (OVERLAY_END (overlay));
2293 tem = Foverlay_get (overlay, Qpriority);
2294 if (INTEGERP (tem))
2295 sortvec[j].priority = XINT (tem);
2296 else
2297 sortvec[j].priority = 0;
2298 j++;
5985d248
KH
2299 }
2300 }
2301 noverlays = j;
2302
2303 /* Sort the overlays into the proper order: increasing priority. */
2304
2305 if (noverlays > 1)
2306 qsort (sortvec, noverlays, sizeof (struct sortvec), compare_overlays);
2307
2308 for (i = 0; i < noverlays; i++)
2309 overlay_vec[i] = sortvec[i].overlay;
2310 return (noverlays);
2311}
2312\f
bbbe9545
KH
2313struct sortstr
2314{
cb26008f 2315 Lisp_Object string, string2;
bbbe9545
KH
2316 int size;
2317 int priority;
2318};
2319
e8185fa8
KH
2320struct sortstrlist
2321{
2322 struct sortstr *buf; /* An array that expands as needed; never freed. */
2323 int size; /* Allocated length of that array. */
2324 int used; /* How much of the array is currently in use. */
2325 int bytes; /* Total length of the strings in buf. */
2326};
2327
2328/* Buffers for storing information about the overlays touching a given
2329 position. These could be automatic variables in overlay_strings, but
2330 it's more efficient to hold onto the memory instead of repeatedly
2331 allocating and freeing it. */
2332static struct sortstrlist overlay_heads, overlay_tails;
9492daf2 2333static unsigned char *overlay_str_buf;
e8185fa8
KH
2334
2335/* Allocated length of overlay_str_buf. */
2336static int overlay_str_len;
2337
bbbe9545
KH
2338/* A comparison function suitable for passing to qsort. */
2339static int
2340cmp_for_strings (as1, as2)
2341 char *as1, *as2;
2342{
2343 struct sortstr *s1 = (struct sortstr *)as1;
2344 struct sortstr *s2 = (struct sortstr *)as2;
2345 if (s1->size != s2->size)
2346 return s2->size - s1->size;
2347 if (s1->priority != s2->priority)
2348 return s1->priority - s2->priority;
2349 return 0;
2350}
2351
e8185fa8 2352static void
cb26008f 2353record_overlay_string (ssl, str, str2, pri, size)
e8185fa8 2354 struct sortstrlist *ssl;
cb26008f 2355 Lisp_Object str, str2, pri;
e8185fa8
KH
2356 int size;
2357{
43d27a72
RS
2358 int nbytes;
2359
e8185fa8
KH
2360 if (ssl->used == ssl->size)
2361 {
2362 if (ssl->buf)
2363 ssl->size *= 2;
2364 else
2365 ssl->size = 5;
2366 ssl->buf = ((struct sortstr *)
2367 xrealloc (ssl->buf, ssl->size * sizeof (struct sortstr)));
2368 }
2369 ssl->buf[ssl->used].string = str;
cb26008f 2370 ssl->buf[ssl->used].string2 = str2;
e8185fa8
KH
2371 ssl->buf[ssl->used].size = size;
2372 ssl->buf[ssl->used].priority = (INTEGERP (pri) ? XINT (pri) : 0);
2373 ssl->used++;
43d27a72
RS
2374
2375 if (NILP (current_buffer->enable_multibyte_characters))
2376 nbytes = XSTRING (str)->size;
2377 else if (! STRING_MULTIBYTE (str))
2378 nbytes = count_size_as_multibyte (XSTRING (str)->data,
fc932ac6 2379 STRING_BYTES (XSTRING (str)));
43d27a72 2380 else
fc932ac6 2381 nbytes = STRING_BYTES (XSTRING (str));
43d27a72
RS
2382
2383 ssl->bytes += nbytes;
2384
cb26008f 2385 if (STRINGP (str2))
43d27a72
RS
2386 {
2387 if (NILP (current_buffer->enable_multibyte_characters))
2388 nbytes = XSTRING (str2)->size;
2389 else if (! STRING_MULTIBYTE (str2))
2390 nbytes = count_size_as_multibyte (XSTRING (str2)->data,
fc932ac6 2391 STRING_BYTES (XSTRING (str2)));
43d27a72 2392 else
fc932ac6 2393 nbytes = STRING_BYTES (XSTRING (str2));
43d27a72
RS
2394
2395 ssl->bytes += nbytes;
2396 }
e8185fa8 2397}
bbbe9545
KH
2398
2399/* Return the concatenation of the strings associated with overlays that
2400 begin or end at POS, ignoring overlays that are specific to a window
2401 other than W. The strings are concatenated in the appropriate order:
2402 shorter overlays nest inside longer ones, and higher priority inside
cb26008f
KH
2403 lower. Normally all of the after-strings come first, but zero-sized
2404 overlays have their after-strings ride along with the before-strings
2405 because it would look strange to print them inside-out.
2406
2407 Returns the string length, and stores the contents indirectly through
2408 PSTR, if that variable is non-null. The string may be overwritten by
2409 subsequent calls. */
6b5d3b89 2410
bbbe9545
KH
2411int
2412overlay_strings (pos, w, pstr)
2413 int pos;
2414 struct window *w;
6b5d3b89 2415 unsigned char **pstr;
bbbe9545 2416{
e8185fa8 2417 Lisp_Object ov, overlay, window, str;
bbbe9545 2418 int startpos, endpos;
43d27a72 2419 int multibyte = ! NILP (current_buffer->enable_multibyte_characters);
bbbe9545 2420
e8185fa8
KH
2421 overlay_heads.used = overlay_heads.bytes = 0;
2422 overlay_tails.used = overlay_tails.bytes = 0;
bbbe9545
KH
2423 for (ov = current_buffer->overlays_before; CONSP (ov); ov = XCONS (ov)->cdr)
2424 {
2425 overlay = XCONS (ov)->car;
2426 if (!OVERLAYP (overlay))
2427 abort ();
2428
2429 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2430 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2431 if (endpos < pos)
2432 break;
2433 if (endpos != pos && startpos != pos)
2434 continue;
2435 window = Foverlay_get (overlay, Qwindow);
2436 if (WINDOWP (window) && XWINDOW (window) != w)
2437 continue;
e8185fa8
KH
2438 if (startpos == pos
2439 && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
2440 record_overlay_string (&overlay_heads, str,
cb26008f
KH
2441 (startpos == endpos
2442 ? Foverlay_get (overlay, Qafter_string)
2443 : Qnil),
2444 Foverlay_get (overlay, Qpriority),
2445 endpos - startpos);
2446 else if (endpos == pos
2447 && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
2448 record_overlay_string (&overlay_tails, str, Qnil,
e8185fa8
KH
2449 Foverlay_get (overlay, Qpriority),
2450 endpos - startpos);
bbbe9545
KH
2451 }
2452 for (ov = current_buffer->overlays_after; CONSP (ov); ov = XCONS (ov)->cdr)
2453 {
2454 overlay = XCONS (ov)->car;
2455 if (!OVERLAYP (overlay))
2456 abort ();
2457
2458 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2459 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2460 if (startpos > pos)
2461 break;
e8185fa8
KH
2462 if (endpos != pos && startpos != pos)
2463 continue;
2464 window = Foverlay_get (overlay, Qwindow);
2465 if (WINDOWP (window) && XWINDOW (window) != w)
2466 continue;
e8185fa8
KH
2467 if (startpos == pos
2468 && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
2469 record_overlay_string (&overlay_heads, str,
cb26008f
KH
2470 (startpos == endpos
2471 ? Foverlay_get (overlay, Qafter_string)
2472 : Qnil),
2473 Foverlay_get (overlay, Qpriority),
2474 endpos - startpos);
2475 else if (endpos == pos
2476 && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
2477 record_overlay_string (&overlay_tails, str, Qnil,
e8185fa8
KH
2478 Foverlay_get (overlay, Qpriority),
2479 endpos - startpos);
bbbe9545 2480 }
e8185fa8
KH
2481 if (overlay_tails.used > 1)
2482 qsort (overlay_tails.buf, overlay_tails.used, sizeof (struct sortstr),
2483 cmp_for_strings);
2484 if (overlay_heads.used > 1)
2485 qsort (overlay_heads.buf, overlay_heads.used, sizeof (struct sortstr),
2486 cmp_for_strings);
2487 if (overlay_heads.bytes || overlay_tails.bytes)
bbbe9545 2488 {
e8185fa8 2489 Lisp_Object tem;
bbbe9545 2490 int i;
9f4d7cde 2491 unsigned char *p;
e8185fa8 2492 int total = overlay_heads.bytes + overlay_tails.bytes;
bbbe9545
KH
2493
2494 if (total > overlay_str_len)
9f4d7cde
RS
2495 {
2496 overlay_str_len = total;
2497 overlay_str_buf = (unsigned char *)xrealloc (overlay_str_buf,
2498 total);
2499 }
bbbe9545 2500 p = overlay_str_buf;
e8185fa8 2501 for (i = overlay_tails.used; --i >= 0;)
bbbe9545 2502 {
43d27a72 2503 int nbytes;
e8185fa8 2504 tem = overlay_tails.buf[i].string;
fc932ac6
RS
2505 nbytes = copy_text (XSTRING (tem)->data, p,
2506 STRING_BYTES (XSTRING (tem)),
43d27a72
RS
2507 STRING_MULTIBYTE (tem), multibyte);
2508 p += nbytes;
bbbe9545 2509 }
e8185fa8 2510 for (i = 0; i < overlay_heads.used; ++i)
bbbe9545 2511 {
43d27a72 2512 int nbytes;
e8185fa8 2513 tem = overlay_heads.buf[i].string;
fc932ac6
RS
2514 nbytes = copy_text (XSTRING (tem)->data, p,
2515 STRING_BYTES (XSTRING (tem)),
43d27a72
RS
2516 STRING_MULTIBYTE (tem), multibyte);
2517 p += nbytes;
cb26008f
KH
2518 tem = overlay_heads.buf[i].string2;
2519 if (STRINGP (tem))
2520 {
43d27a72 2521 nbytes = copy_text (XSTRING (tem)->data, p,
fc932ac6 2522 STRING_BYTES (XSTRING (tem)),
43d27a72
RS
2523 STRING_MULTIBYTE (tem), multibyte);
2524 p += nbytes;
cb26008f 2525 }
bbbe9545 2526 }
cb26008f
KH
2527 if (p != overlay_str_buf + total)
2528 abort ();
bbbe9545
KH
2529 if (pstr)
2530 *pstr = overlay_str_buf;
e8185fa8 2531 return total;
bbbe9545 2532 }
e8185fa8 2533 return 0;
bbbe9545
KH
2534}
2535\f
5c4f68f1 2536/* Shift overlays in BUF's overlay lists, to center the lists at POS. */
1ab256cb 2537
2eec3b4e 2538void
5c4f68f1
JB
2539recenter_overlay_lists (buf, pos)
2540 struct buffer *buf;
2eec3b4e
RS
2541 int pos;
2542{
2543 Lisp_Object overlay, tail, next, prev, beg, end;
2544
2545 /* See if anything in overlays_before should move to overlays_after. */
2546
2547 /* We don't strictly need prev in this loop; it should always be nil.
2548 But we use it for symmetry and in case that should cease to be true
2549 with some future change. */
2550 prev = Qnil;
5c4f68f1 2551 for (tail = buf->overlays_before;
2eec3b4e
RS
2552 CONSP (tail);
2553 prev = tail, tail = next)
1ab256cb 2554 {
2eec3b4e
RS
2555 next = XCONS (tail)->cdr;
2556 overlay = XCONS (tail)->car;
2557
2558 /* If the overlay is not valid, get rid of it. */
2559 if (!OVERLAY_VALID (overlay))
52f8ec73
JB
2560#if 1
2561 abort ();
2562#else
2eec3b4e
RS
2563 {
2564 /* Splice the cons cell TAIL out of overlays_before. */
2565 if (!NILP (prev))
2566 XCONS (prev)->cdr = next;
2567 else
5c4f68f1 2568 buf->overlays_before = next;
2eec3b4e
RS
2569 tail = prev;
2570 continue;
2571 }
52f8ec73 2572#endif
1ab256cb 2573
2eec3b4e
RS
2574 beg = OVERLAY_START (overlay);
2575 end = OVERLAY_END (overlay);
1ab256cb 2576
2eec3b4e 2577 if (OVERLAY_POSITION (end) > pos)
1ab256cb 2578 {
2eec3b4e
RS
2579 /* OVERLAY needs to be moved. */
2580 int where = OVERLAY_POSITION (beg);
2581 Lisp_Object other, other_prev;
2582
2583 /* Splice the cons cell TAIL out of overlays_before. */
2584 if (!NILP (prev))
2585 XCONS (prev)->cdr = next;
2586 else
5c4f68f1 2587 buf->overlays_before = next;
2eec3b4e
RS
2588
2589 /* Search thru overlays_after for where to put it. */
2590 other_prev = Qnil;
5c4f68f1 2591 for (other = buf->overlays_after;
2eec3b4e
RS
2592 CONSP (other);
2593 other_prev = other, other = XCONS (other)->cdr)
1ab256cb 2594 {
2eec3b4e
RS
2595 Lisp_Object otherbeg, otheroverlay, follower;
2596 int win;
2597
2598 otheroverlay = XCONS (other)->car;
2599 if (! OVERLAY_VALID (otheroverlay))
52f8ec73 2600 abort ();
2eec3b4e
RS
2601
2602 otherbeg = OVERLAY_START (otheroverlay);
2603 if (OVERLAY_POSITION (otherbeg) >= where)
2604 break;
1ab256cb 2605 }
2eec3b4e
RS
2606
2607 /* Add TAIL to overlays_after before OTHER. */
2608 XCONS (tail)->cdr = other;
2609 if (!NILP (other_prev))
2610 XCONS (other_prev)->cdr = tail;
1ab256cb 2611 else
5c4f68f1 2612 buf->overlays_after = tail;
2eec3b4e 2613 tail = prev;
1ab256cb 2614 }
2eec3b4e
RS
2615 else
2616 /* We've reached the things that should stay in overlays_before.
2617 All the rest of overlays_before must end even earlier,
2618 so stop now. */
2619 break;
2620 }
2621
2622 /* See if anything in overlays_after should be in overlays_before. */
2623 prev = Qnil;
5c4f68f1 2624 for (tail = buf->overlays_after;
2eec3b4e
RS
2625 CONSP (tail);
2626 prev = tail, tail = next)
2627 {
2628 next = XCONS (tail)->cdr;
2629 overlay = XCONS (tail)->car;
2630
2631 /* If the overlay is not valid, get rid of it. */
2632 if (!OVERLAY_VALID (overlay))
52f8ec73
JB
2633#if 1
2634 abort ();
2635#else
2eec3b4e
RS
2636 {
2637 /* Splice the cons cell TAIL out of overlays_after. */
2638 if (!NILP (prev))
2639 XCONS (prev)->cdr = next;
2640 else
5c4f68f1 2641 buf->overlays_after = next;
2eec3b4e
RS
2642 tail = prev;
2643 continue;
2644 }
52f8ec73 2645#endif
2eec3b4e
RS
2646
2647 beg = OVERLAY_START (overlay);
2648 end = OVERLAY_END (overlay);
2649
2650 /* Stop looking, when we know that nothing further
2651 can possibly end before POS. */
2652 if (OVERLAY_POSITION (beg) > pos)
2653 break;
2654
2655 if (OVERLAY_POSITION (end) <= pos)
2656 {
2657 /* OVERLAY needs to be moved. */
2658 int where = OVERLAY_POSITION (end);
2659 Lisp_Object other, other_prev;
2660
2661 /* Splice the cons cell TAIL out of overlays_after. */
2662 if (!NILP (prev))
2663 XCONS (prev)->cdr = next;
2664 else
5c4f68f1 2665 buf->overlays_after = next;
2eec3b4e
RS
2666
2667 /* Search thru overlays_before for where to put it. */
2668 other_prev = Qnil;
5c4f68f1 2669 for (other = buf->overlays_before;
2eec3b4e
RS
2670 CONSP (other);
2671 other_prev = other, other = XCONS (other)->cdr)
2672 {
2673 Lisp_Object otherend, otheroverlay;
2674 int win;
2675
2676 otheroverlay = XCONS (other)->car;
2677 if (! OVERLAY_VALID (otheroverlay))
52f8ec73 2678 abort ();
2eec3b4e
RS
2679
2680 otherend = OVERLAY_END (otheroverlay);
2681 if (OVERLAY_POSITION (otherend) <= where)
2682 break;
2683 }
2684
2685 /* Add TAIL to overlays_before before OTHER. */
2686 XCONS (tail)->cdr = other;
2687 if (!NILP (other_prev))
2688 XCONS (other_prev)->cdr = tail;
2689 else
5c4f68f1 2690 buf->overlays_before = tail;
2eec3b4e
RS
2691 tail = prev;
2692 }
2693 }
2694
8d7a4592 2695 XSETFASTINT (buf->overlay_center, pos);
2eec3b4e 2696}
2b1bdf65 2697
423cdb46
KH
2698void
2699adjust_overlays_for_insert (pos, length)
2700 int pos;
2701 int length;
2702{
2703 /* After an insertion, the lists are still sorted properly,
2704 but we may need to update the value of the overlay center. */
2705 if (XFASTINT (current_buffer->overlay_center) >= pos)
2706 XSETFASTINT (current_buffer->overlay_center,
2707 XFASTINT (current_buffer->overlay_center) + length);
2708}
2709
2710void
2711adjust_overlays_for_delete (pos, length)
2712 int pos;
2713 int length;
2714{
2715 if (XFASTINT (current_buffer->overlay_center) < pos)
2716 /* The deletion was to our right. No change needed; the before- and
2717 after-lists are still consistent. */
2718 ;
2719 else if (XFASTINT (current_buffer->overlay_center) > pos + length)
2720 /* The deletion was to our left. We need to adjust the center value
2721 to account for the change in position, but the lists are consistent
2722 given the new value. */
2723 XSETFASTINT (current_buffer->overlay_center,
2724 XFASTINT (current_buffer->overlay_center) - length);
2725 else
2726 /* We're right in the middle. There might be things on the after-list
2727 that now belong on the before-list. Recentering will move them,
2728 and also update the center point. */
2729 recenter_overlay_lists (current_buffer, pos);
2730}
2731
2b1bdf65
KH
2732/* Fix up overlays that were garbled as a result of permuting markers
2733 in the range START through END. Any overlay with at least one
2734 endpoint in this range will need to be unlinked from the overlay
2735 list and reinserted in its proper place.
2736 Such an overlay might even have negative size at this point.
2737 If so, we'll reverse the endpoints. Can you think of anything
2738 better to do in this situation? */
2739void
2740fix_overlays_in_range (start, end)
2741 register int start, end;
2742{
2743 Lisp_Object tem, overlay;
2744 Lisp_Object before_list, after_list;
2745 Lisp_Object *ptail, *pbefore = &before_list, *pafter = &after_list;
2746 int startpos, endpos;
2747
2748 /* This algorithm shifts links around instead of consing and GCing.
2749 The loop invariant is that before_list (resp. after_list) is a
2750 well-formed list except that its last element, the one that
2751 *pbefore (resp. *pafter) points to, is still uninitialized.
2752 So it's not a bug that before_list isn't initialized, although
2753 it may look strange. */
2754 for (ptail = &current_buffer->overlays_before; CONSP (*ptail);)
2755 {
2756 overlay = XCONS (*ptail)->car;
2757 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2758 if (endpos < start)
2759 break;
2760 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2761 if (endpos < end
2762 || (startpos >= start && startpos < end))
2763 {
2764 /* If the overlay is backwards, fix that now. */
2765 if (startpos > endpos)
2766 {
2767 int tem;
2c99f3ea
RS
2768 Fset_marker (OVERLAY_START (overlay), make_number (endpos),
2769 Qnil);
2770 Fset_marker (OVERLAY_END (overlay), make_number (startpos),
2771 Qnil);
2b1bdf65
KH
2772 tem = startpos; startpos = endpos; endpos = tem;
2773 }
2774 /* Add it to the end of the wrong list. Later on,
2775 recenter_overlay_lists will move it to the right place. */
2776 if (endpos < XINT (current_buffer->overlay_center))
2777 {
2778 *pafter = *ptail;
2779 pafter = &XCONS (*ptail)->cdr;
2780 }
2781 else
2782 {
2783 *pbefore = *ptail;
2784 pbefore = &XCONS (*ptail)->cdr;
2785 }
2786 *ptail = XCONS (*ptail)->cdr;
2787 }
2788 else
2789 ptail = &XCONS (*ptail)->cdr;
2790 }
2791 for (ptail = &current_buffer->overlays_after; CONSP (*ptail);)
2792 {
2793 overlay = XCONS (*ptail)->car;
2794 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2795 if (startpos >= end)
2796 break;
2797 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2798 if (startpos >= start
2799 || (endpos >= start && endpos < end))
2800 {
2801 if (startpos > endpos)
2802 {
2803 int tem;
2c99f3ea
RS
2804 Fset_marker (OVERLAY_START (overlay), make_number (endpos),
2805 Qnil);
2806 Fset_marker (OVERLAY_END (overlay), make_number (startpos),
2807 Qnil);
2b1bdf65
KH
2808 tem = startpos; startpos = endpos; endpos = tem;
2809 }
2810 if (endpos < XINT (current_buffer->overlay_center))
2811 {
2812 *pafter = *ptail;
2813 pafter = &XCONS (*ptail)->cdr;
2814 }
2815 else
2816 {
2817 *pbefore = *ptail;
2818 pbefore = &XCONS (*ptail)->cdr;
2819 }
2820 *ptail = XCONS (*ptail)->cdr;
2821 }
2822 else
2823 ptail = &XCONS (*ptail)->cdr;
2824 }
2825
2826 /* Splice the constructed (wrong) lists into the buffer's lists,
2827 and let the recenter function make it sane again. */
2828 *pbefore = current_buffer->overlays_before;
2829 current_buffer->overlays_before = before_list;
2830 recenter_overlay_lists (current_buffer,
2831 XINT (current_buffer->overlay_center));
2832
2833 *pafter = current_buffer->overlays_after;
2834 current_buffer->overlays_after = after_list;
2835 recenter_overlay_lists (current_buffer,
2836 XINT (current_buffer->overlay_center));
2837}
3b06f880
KH
2838
2839/* We have two types of overlay: the one whose ending marker is
2840 after-insertion-marker (this is the usual case) and the one whose
2841 ending marker is before-insertion-marker. When `overlays_before'
2842 contains overlays of the latter type and the former type in this
2843 order and both overlays end at inserting position, inserting a text
2844 increases only the ending marker of the latter type, which results
2845 in incorrect ordering of `overlays_before'.
2846
2847 This function fixes ordering of overlays in the slot
2848 `overlays_before' of the buffer *BP. Before the insertion, `point'
2849 was at PREV, and now is at POS. */
2850
01136e9b 2851void
3b06f880
KH
2852fix_overlays_before (bp, prev, pos)
2853 struct buffer *bp;
2854 int prev, pos;
2855{
2856 Lisp_Object *tailp = &bp->overlays_before;
2857 Lisp_Object *right_place;
2858 int end;
2859
2860 /* After the insertion, the several overlays may be in incorrect
2861 order. The possibility is that, in the list `overlays_before',
2862 an overlay which ends at POS appears after an overlay which ends
2863 at PREV. Since POS is greater than PREV, we must fix the
2864 ordering of these overlays, by moving overlays ends at POS before
2865 the overlays ends at PREV. */
2866
2867 /* At first, find a place where disordered overlays should be linked
2868 in. It is where an overlay which end before POS exists. (i.e. an
2869 overlay whose ending marker is after-insertion-marker if disorder
2870 exists). */
2871 while (!NILP (*tailp)
2872 && ((end = OVERLAY_POSITION (OVERLAY_END (XCONS (*tailp)->car)))
2873 >= pos))
2874 tailp = &XCONS (*tailp)->cdr;
2875
2876 /* If we don't find such an overlay,
2877 or the found one ends before PREV,
2878 or the found one is the last one in the list,
2879 we don't have to fix anything. */
2880 if (NILP (*tailp)
2881 || end < prev
2882 || NILP (XCONS (*tailp)->cdr))
2883 return;
2884
2885 right_place = tailp;
2886 tailp = &XCONS (*tailp)->cdr;
2887
2888 /* Now, end position of overlays in the list *TAILP should be before
2889 or equal to PREV. In the loop, an overlay which ends at POS is
2890 moved ahead to the place pointed by RIGHT_PLACE. If we found an
2891 overlay which ends before PREV, the remaining overlays are in
2892 correct order. */
2893 while (!NILP (*tailp))
2894 {
2895 end = OVERLAY_POSITION (OVERLAY_END (XCONS (*tailp)->car));
2896
2897 if (end == pos)
2898 { /* This overlay is disordered. */
2899 Lisp_Object found = *tailp;
2900
2901 /* Unlink the found overlay. */
2902 *tailp = XCONS (found)->cdr;
2903 /* Move an overlay at RIGHT_PLACE to the next of the found one. */
2904 XCONS (found)->cdr = *right_place;
2905 /* Link it into the right place. */
2906 *right_place = found;
2907 }
2908 else if (end == prev)
2909 tailp = &XCONS (*tailp)->cdr;
2910 else /* No more disordered overlay. */
2911 break;
2912 }
2913}
2eec3b4e 2914\f
52f8ec73
JB
2915DEFUN ("overlayp", Foverlayp, Soverlayp, 1, 1, 0,
2916 "Return t if OBJECT is an overlay.")
2917 (object)
2918 Lisp_Object object;
2919{
2920 return (OVERLAYP (object) ? Qt : Qnil);
2921}
2922
acac2700 2923DEFUN ("make-overlay", Fmake_overlay, Smake_overlay, 2, 5, 0,
5c4f68f1
JB
2924 "Create a new overlay with range BEG to END in BUFFER.\n\
2925If omitted, BUFFER defaults to the current buffer.\n\
acac2700
RS
2926BEG and END may be integers or markers.\n\
2927The fourth arg FRONT-ADVANCE, if non-nil, makes the\n\
2928front delimiter advance when text is inserted there.\n\
2929The fifth arg REAR-ADVANCE, if non-nil, makes the\n\
2930rear delimiter advance when text is inserted there.")
2931 (beg, end, buffer, front_advance, rear_advance)
5c4f68f1 2932 Lisp_Object beg, end, buffer;
acac2700 2933 Lisp_Object front_advance, rear_advance;
2eec3b4e
RS
2934{
2935 Lisp_Object overlay;
5c4f68f1 2936 struct buffer *b;
2eec3b4e 2937
5c4f68f1 2938 if (NILP (buffer))
67180c6a 2939 XSETBUFFER (buffer, current_buffer);
883047b9
JB
2940 else
2941 CHECK_BUFFER (buffer, 2);
2942 if (MARKERP (beg)
2943 && ! EQ (Fmarker_buffer (beg), buffer))
2944 error ("Marker points into wrong buffer");
2945 if (MARKERP (end)
2946 && ! EQ (Fmarker_buffer (end), buffer))
2947 error ("Marker points into wrong buffer");
2eec3b4e 2948
883047b9
JB
2949 CHECK_NUMBER_COERCE_MARKER (beg, 1);
2950 CHECK_NUMBER_COERCE_MARKER (end, 1);
5c4f68f1 2951
883047b9 2952 if (XINT (beg) > XINT (end))
5c4f68f1 2953 {
c99fc30f
KH
2954 Lisp_Object temp;
2955 temp = beg; beg = end; end = temp;
5c4f68f1 2956 }
883047b9
JB
2957
2958 b = XBUFFER (buffer);
2959
2960 beg = Fset_marker (Fmake_marker (), beg, buffer);
2961 end = Fset_marker (Fmake_marker (), end, buffer);
5c4f68f1 2962
acac2700
RS
2963 if (!NILP (front_advance))
2964 XMARKER (beg)->insertion_type = 1;
2965 if (!NILP (rear_advance))
2966 XMARKER (end)->insertion_type = 1;
597dd755 2967
48e2e3ba 2968 overlay = allocate_misc ();
89ca3e1b 2969 XMISCTYPE (overlay) = Lisp_Misc_Overlay;
48e2e3ba
KH
2970 XOVERLAY (overlay)->start = beg;
2971 XOVERLAY (overlay)->end = end;
2972 XOVERLAY (overlay)->plist = Qnil;
2eec3b4e
RS
2973
2974 /* Put the new overlay on the wrong list. */
2975 end = OVERLAY_END (overlay);
5c4f68f1
JB
2976 if (OVERLAY_POSITION (end) < XINT (b->overlay_center))
2977 b->overlays_after = Fcons (overlay, b->overlays_after);
2eec3b4e 2978 else
5c4f68f1 2979 b->overlays_before = Fcons (overlay, b->overlays_before);
2eec3b4e
RS
2980
2981 /* This puts it in the right list, and in the right order. */
5c4f68f1 2982 recenter_overlay_lists (b, XINT (b->overlay_center));
2eec3b4e 2983
b61982dd
JB
2984 /* We don't need to redisplay the region covered by the overlay, because
2985 the overlay has no properties at the moment. */
2986
2eec3b4e
RS
2987 return overlay;
2988}
876aa27c
RS
2989\f
2990/* Mark a section of BUF as needing redisplay because of overlays changes. */
2991
2992static void
2993modify_overlay (buf, start, end)
2994 struct buffer *buf;
2995 int start, end;
2996{
2997 if (start == end)
2998 return;
2999
3000 if (start > end)
3001 {
3002 int temp = start;
3003 start = end; end = temp;
3004 }
3005
3006 /* If this is a buffer not in the selected window,
3007 we must do other windows. */
3008 if (buf != XBUFFER (XWINDOW (selected_window)->buffer))
3009 windows_or_buffers_changed = 1;
3010 /* If it's not current, we can't use beg_unchanged, end_unchanged for it. */
3011 else if (buf != current_buffer)
3012 windows_or_buffers_changed = 1;
3013 /* If multiple windows show this buffer, we must do other windows. */
3014 else if (buffer_shared > 1)
3015 windows_or_buffers_changed = 1;
3016 else
3017 {
3018 if (unchanged_modified == MODIFF
3019 && overlay_unchanged_modified == OVERLAY_MODIFF)
3020 {
3021 beg_unchanged = start - BEG;
3022 end_unchanged = Z - end;
3023 }
3024 else
3025 {
3026 if (Z - end < end_unchanged)
3027 end_unchanged = Z - end;
3028 if (start - BEG < beg_unchanged)
3029 beg_unchanged = start - BEG;
3030 }
3031 }
3032
d8b9150f 3033 ++BUF_OVERLAY_MODIFF (buf);
876aa27c 3034}
2eec3b4e 3035
876aa27c 3036\f\f
2e34157c
RS
3037Lisp_Object Fdelete_overlay ();
3038
5c4f68f1
JB
3039DEFUN ("move-overlay", Fmove_overlay, Smove_overlay, 3, 4, 0,
3040 "Set the endpoints of OVERLAY to BEG and END in BUFFER.\n\
3ece337a
JB
3041If BUFFER is omitted, leave OVERLAY in the same buffer it inhabits now.\n\
3042If BUFFER is omitted, and OVERLAY is in no buffer, put it in the current\n\
3043buffer.")
5c4f68f1
JB
3044 (overlay, beg, end, buffer)
3045 Lisp_Object overlay, beg, end, buffer;
2eec3b4e 3046{
0a4469c9
RS
3047 struct buffer *b, *ob;
3048 Lisp_Object obuffer;
3049 int count = specpdl_ptr - specpdl;
5c4f68f1 3050
52f8ec73 3051 CHECK_OVERLAY (overlay, 0);
5c4f68f1
JB
3052 if (NILP (buffer))
3053 buffer = Fmarker_buffer (OVERLAY_START (overlay));
3ece337a 3054 if (NILP (buffer))
67180c6a 3055 XSETBUFFER (buffer, current_buffer);
5c4f68f1 3056 CHECK_BUFFER (buffer, 3);
883047b9
JB
3057
3058 if (MARKERP (beg)
3059 && ! EQ (Fmarker_buffer (beg), buffer))
3060 error ("Marker points into wrong buffer");
3061 if (MARKERP (end)
3062 && ! EQ (Fmarker_buffer (end), buffer))
3063 error ("Marker points into wrong buffer");
3064
b61982dd
JB
3065 CHECK_NUMBER_COERCE_MARKER (beg, 1);
3066 CHECK_NUMBER_COERCE_MARKER (end, 1);
3067
9d7608b7
KH
3068 if (XINT (beg) == XINT (end) && ! NILP (Foverlay_get (overlay, Qevaporate)))
3069 return Fdelete_overlay (overlay);
0a4469c9 3070
b61982dd
JB
3071 if (XINT (beg) > XINT (end))
3072 {
c99fc30f
KH
3073 Lisp_Object temp;
3074 temp = beg; beg = end; end = temp;
b61982dd
JB
3075 }
3076
9d7608b7
KH
3077 specbind (Qinhibit_quit, Qt);
3078
0a4469c9 3079 obuffer = Fmarker_buffer (OVERLAY_START (overlay));
5c4f68f1 3080 b = XBUFFER (buffer);
0a4469c9 3081 ob = XBUFFER (obuffer);
2eec3b4e 3082
c82ed728 3083 /* If the overlay has changed buffers, do a thorough redisplay. */
0a4469c9 3084 if (!EQ (buffer, obuffer))
50760c4a
RS
3085 {
3086 /* Redisplay where the overlay was. */
3087 if (!NILP (obuffer))
3088 {
2e34157c
RS
3089 int o_beg;
3090 int o_end;
50760c4a 3091
80509f2f
RS
3092 o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
3093 o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
50760c4a 3094
2e34157c 3095 modify_overlay (ob, o_beg, o_end);
50760c4a
RS
3096 }
3097
3098 /* Redisplay where the overlay is going to be. */
876aa27c 3099 modify_overlay (b, XINT (beg), XINT (end));
50760c4a 3100 }
c82ed728
JB
3101 else
3102 /* Redisplay the area the overlay has just left, or just enclosed. */
3103 {
2e34157c 3104 int o_beg, o_end;
c82ed728
JB
3105 int change_beg, change_end;
3106
80509f2f
RS
3107 o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
3108 o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
c82ed728 3109
2e34157c
RS
3110 if (o_beg == XINT (beg))
3111 modify_overlay (b, o_end, XINT (end));
3112 else if (o_end == XINT (end))
3113 modify_overlay (b, o_beg, XINT (beg));
c82ed728
JB
3114 else
3115 {
2e34157c
RS
3116 if (XINT (beg) < o_beg) o_beg = XINT (beg);
3117 if (XINT (end) > o_end) o_end = XINT (end);
3118 modify_overlay (b, o_beg, o_end);
c82ed728
JB
3119 }
3120 }
b61982dd 3121
0a4469c9
RS
3122 if (!NILP (obuffer))
3123 {
3124 ob->overlays_before = Fdelq (overlay, ob->overlays_before);
3125 ob->overlays_after = Fdelq (overlay, ob->overlays_after);
3126 }
5c4f68f1
JB
3127
3128 Fset_marker (OVERLAY_START (overlay), beg, buffer);
3129 Fset_marker (OVERLAY_END (overlay), end, buffer);
2eec3b4e
RS
3130
3131 /* Put the overlay on the wrong list. */
3132 end = OVERLAY_END (overlay);
5c4f68f1
JB
3133 if (OVERLAY_POSITION (end) < XINT (b->overlay_center))
3134 b->overlays_after = Fcons (overlay, b->overlays_after);
2eec3b4e 3135 else
5c4f68f1 3136 b->overlays_before = Fcons (overlay, b->overlays_before);
2eec3b4e
RS
3137
3138 /* This puts it in the right list, and in the right order. */
5c4f68f1 3139 recenter_overlay_lists (b, XINT (b->overlay_center));
2eec3b4e 3140
0a4469c9 3141 return unbind_to (count, overlay);
2eec3b4e
RS
3142}
3143
3144DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0,
5c4f68f1 3145 "Delete the overlay OVERLAY from its buffer.")
2eec3b4e 3146 (overlay)
5c4f68f1 3147 Lisp_Object overlay;
2eec3b4e 3148{
0a4469c9 3149 Lisp_Object buffer;
5c4f68f1 3150 struct buffer *b;
0a4469c9 3151 int count = specpdl_ptr - specpdl;
5c4f68f1 3152
52f8ec73
JB
3153 CHECK_OVERLAY (overlay, 0);
3154
0a4469c9
RS
3155 buffer = Fmarker_buffer (OVERLAY_START (overlay));
3156 if (NILP (buffer))
3157 return Qnil;
3158
3159 b = XBUFFER (buffer);
3160
3161 specbind (Qinhibit_quit, Qt);
5c4f68f1
JB
3162
3163 b->overlays_before = Fdelq (overlay, b->overlays_before);
3164 b->overlays_after = Fdelq (overlay, b->overlays_after);
3165
876aa27c 3166 modify_overlay (b,
a927f5c9
RS
3167 marker_position (OVERLAY_START (overlay)),
3168 marker_position (OVERLAY_END (overlay)));
b61982dd 3169
3ece337a
JB
3170 Fset_marker (OVERLAY_START (overlay), Qnil, Qnil);
3171 Fset_marker (OVERLAY_END (overlay), Qnil, Qnil);
3172
0a4469c9 3173 return unbind_to (count, Qnil);
2eec3b4e
RS
3174}
3175\f
8ebafa8d
JB
3176/* Overlay dissection functions. */
3177
3178DEFUN ("overlay-start", Foverlay_start, Soverlay_start, 1, 1, 0,
3179 "Return the position at which OVERLAY starts.")
3180 (overlay)
3181 Lisp_Object overlay;
3182{
3183 CHECK_OVERLAY (overlay, 0);
3184
3185 return (Fmarker_position (OVERLAY_START (overlay)));
3186}
3187
3188DEFUN ("overlay-end", Foverlay_end, Soverlay_end, 1, 1, 0,
3189 "Return the position at which OVERLAY ends.")
3190 (overlay)
3191 Lisp_Object overlay;
3192{
3193 CHECK_OVERLAY (overlay, 0);
3194
3195 return (Fmarker_position (OVERLAY_END (overlay)));
3196}
3197
3198DEFUN ("overlay-buffer", Foverlay_buffer, Soverlay_buffer, 1, 1, 0,
3199 "Return the buffer OVERLAY belongs to.")
3200 (overlay)
3201 Lisp_Object overlay;
3202{
3203 CHECK_OVERLAY (overlay, 0);
3204
3205 return Fmarker_buffer (OVERLAY_START (overlay));
3206}
3207
3208DEFUN ("overlay-properties", Foverlay_properties, Soverlay_properties, 1, 1, 0,
3209 "Return a list of the properties on OVERLAY.\n\
3210This is a copy of OVERLAY's plist; modifying its conses has no effect on\n\
3211OVERLAY.")
3212 (overlay)
3213 Lisp_Object overlay;
3214{
3215 CHECK_OVERLAY (overlay, 0);
3216
48e2e3ba 3217 return Fcopy_sequence (XOVERLAY (overlay)->plist);
8ebafa8d
JB
3218}
3219
3220\f
2eec3b4e 3221DEFUN ("overlays-at", Foverlays_at, Soverlays_at, 1, 1, 0,
eb8c3be9 3222 "Return a list of the overlays that contain position POS.")
2eec3b4e
RS
3223 (pos)
3224 Lisp_Object pos;
3225{
3226 int noverlays;
2eec3b4e
RS
3227 Lisp_Object *overlay_vec;
3228 int len;
3229 Lisp_Object result;
3230
3231 CHECK_NUMBER_COERCE_MARKER (pos, 0);
3232
3233 len = 10;
3234 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
3235
3236 /* Put all the overlays we want in a vector in overlay_vec.
3237 Store the length in len. */
2a77a7d7
RS
3238 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
3239 (int *) 0, (int *) 0);
2eec3b4e
RS
3240
3241 /* Make a list of them all. */
3242 result = Flist (noverlays, overlay_vec);
3243
9ac0d9e0 3244 xfree (overlay_vec);
2eec3b4e
RS
3245 return result;
3246}
3247
74514898 3248DEFUN ("overlays-in", Foverlays_in, Soverlays_in, 2, 2, 0,
2a3eeee7
RS
3249 "Return a list of the overlays that overlap the region BEG ... END.\n\
3250Overlap means that at least one character is contained within the overlay\n\
3251and also contained within the specified region.\n\
3252Empty overlays are included in the result if they are located at BEG\n\
3253or between BEG and END.")
74514898
RS
3254 (beg, end)
3255 Lisp_Object beg, end;
3256{
3257 int noverlays;
3258 Lisp_Object *overlay_vec;
3259 int len;
3260 Lisp_Object result;
3261
3262 CHECK_NUMBER_COERCE_MARKER (beg, 0);
3263 CHECK_NUMBER_COERCE_MARKER (end, 0);
3264
3265 len = 10;
3266 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
3267
3268 /* Put all the overlays we want in a vector in overlay_vec.
3269 Store the length in len. */
3270 noverlays = overlays_in (XINT (beg), XINT (end), 1, &overlay_vec, &len,
3271 (int *) 0, (int *) 0);
3272
3273 /* Make a list of them all. */
3274 result = Flist (noverlays, overlay_vec);
3275
3276 xfree (overlay_vec);
3277 return result;
3278}
3279
2eec3b4e
RS
3280DEFUN ("next-overlay-change", Fnext_overlay_change, Snext_overlay_change,
3281 1, 1, 0,
bbe20e81
KH
3282 "Return the next position after POS where an overlay starts or ends.\n\
3283If there are no more overlay boundaries after POS, return (point-max).")
2eec3b4e
RS
3284 (pos)
3285 Lisp_Object pos;
3286{
3287 int noverlays;
3288 int endpos;
3289 Lisp_Object *overlay_vec;
3290 int len;
2eec3b4e
RS
3291 int i;
3292
3293 CHECK_NUMBER_COERCE_MARKER (pos, 0);
3294
3295 len = 10;
3296 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
3297
3298 /* Put all the overlays we want in a vector in overlay_vec.
3299 Store the length in len.
3300 endpos gets the position where the next overlay starts. */
2a77a7d7
RS
3301 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
3302 &endpos, (int *) 0);
2eec3b4e
RS
3303
3304 /* If any of these overlays ends before endpos,
3305 use its ending point instead. */
3306 for (i = 0; i < noverlays; i++)
3307 {
3308 Lisp_Object oend;
3309 int oendpos;
3310
3311 oend = OVERLAY_END (overlay_vec[i]);
3312 oendpos = OVERLAY_POSITION (oend);
3313 if (oendpos < endpos)
3314 endpos = oendpos;
1ab256cb
RM
3315 }
3316
9ac0d9e0 3317 xfree (overlay_vec);
2eec3b4e
RS
3318 return make_number (endpos);
3319}
239c932b
RS
3320
3321DEFUN ("previous-overlay-change", Fprevious_overlay_change,
3322 Sprevious_overlay_change, 1, 1, 0,
3323 "Return the previous position before POS where an overlay starts or ends.\n\
624bbdc4 3324If there are no more overlay boundaries before POS, return (point-min).")
239c932b
RS
3325 (pos)
3326 Lisp_Object pos;
3327{
3328 int noverlays;
3329 int prevpos;
3330 Lisp_Object *overlay_vec;
3331 int len;
3332 int i;
624bbdc4 3333 Lisp_Object tail;
239c932b
RS
3334
3335 CHECK_NUMBER_COERCE_MARKER (pos, 0);
3336
3337 len = 10;
3338 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
3339
624bbdc4
RS
3340 /* At beginning of buffer, we know the answer;
3341 avoid bug subtracting 1 below. */
3342 if (XINT (pos) == BEGV)
3343 return pos;
3344
239c932b
RS
3345 /* Put all the overlays we want in a vector in overlay_vec.
3346 Store the length in len.
3347 prevpos gets the position of an overlay end. */
2a77a7d7
RS
3348 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
3349 (int *) 0, &prevpos);
239c932b 3350
624bbdc4 3351 /* If any of these overlays starts after prevpos,
239c932b
RS
3352 maybe use its starting point instead. */
3353 for (i = 0; i < noverlays; i++)
3354 {
3355 Lisp_Object ostart;
3356 int ostartpos;
3357
3358 ostart = OVERLAY_START (overlay_vec[i]);
3359 ostartpos = OVERLAY_POSITION (ostart);
3360 if (ostartpos > prevpos && ostartpos < XINT (pos))
3361 prevpos = ostartpos;
3362 }
3363
624bbdc4
RS
3364 /* If any overlay ends at pos, consider its starting point too. */
3365 for (tail = current_buffer->overlays_before;
3366 GC_CONSP (tail);
3367 tail = XCONS (tail)->cdr)
3368 {
3369 Lisp_Object overlay, ostart;
3370 int ostartpos;
3371
3372 overlay = XCONS (tail)->car;
3373
3374 ostart = OVERLAY_START (overlay);
3375 ostartpos = OVERLAY_POSITION (ostart);
3376 if (ostartpos > prevpos && ostartpos < XINT (pos))
3377 prevpos = ostartpos;
3378 }
3379
239c932b
RS
3380 xfree (overlay_vec);
3381 return make_number (prevpos);
3382}
2eec3b4e
RS
3383\f
3384/* These functions are for debugging overlays. */
3385
3386DEFUN ("overlay-lists", Foverlay_lists, Soverlay_lists, 0, 0, 0,
3387 "Return a pair of lists giving all the overlays of the current buffer.\n\
3388The car has all the overlays before the overlay center;\n\
bbe20e81 3389the cdr has all the overlays after the overlay center.\n\
2eec3b4e
RS
3390Recentering overlays moves overlays between these lists.\n\
3391The lists you get are copies, so that changing them has no effect.\n\
3392However, the overlays you get are the real objects that the buffer uses.")
3393 ()
3394{
3395 Lisp_Object before, after;
3396 before = current_buffer->overlays_before;
3397 if (CONSP (before))
3398 before = Fcopy_sequence (before);
3399 after = current_buffer->overlays_after;
3400 if (CONSP (after))
3401 after = Fcopy_sequence (after);
3402
3403 return Fcons (before, after);
3404}
3405
3406DEFUN ("overlay-recenter", Foverlay_recenter, Soverlay_recenter, 1, 1, 0,
3407 "Recenter the overlays of the current buffer around position POS.")
3408 (pos)
3409 Lisp_Object pos;
3410{
3411 CHECK_NUMBER_COERCE_MARKER (pos, 0);
3412
5c4f68f1 3413 recenter_overlay_lists (current_buffer, XINT (pos));
2eec3b4e
RS
3414 return Qnil;
3415}
3416\f
3417DEFUN ("overlay-get", Foverlay_get, Soverlay_get, 2, 2, 0,
a2428fa2 3418 "Get the property of overlay OVERLAY with property name PROP.")
2eec3b4e
RS
3419 (overlay, prop)
3420 Lisp_Object overlay, prop;
3421{
cab4777e 3422 Lisp_Object plist, fallback;
52f8ec73
JB
3423
3424 CHECK_OVERLAY (overlay, 0);
3425
cab4777e
RS
3426 fallback = Qnil;
3427
48e2e3ba 3428 for (plist = XOVERLAY (overlay)->plist;
2eec3b4e
RS
3429 CONSP (plist) && CONSP (XCONS (plist)->cdr);
3430 plist = XCONS (XCONS (plist)->cdr)->cdr)
3431 {
3432 if (EQ (XCONS (plist)->car, prop))
3433 return XCONS (XCONS (plist)->cdr)->car;
cab4777e
RS
3434 else if (EQ (XCONS (plist)->car, Qcategory))
3435 {
3436 Lisp_Object tem;
3437 tem = Fcar (Fcdr (plist));
3438 if (SYMBOLP (tem))
3439 fallback = Fget (tem, prop);
3440 }
2eec3b4e 3441 }
52f8ec73 3442
cab4777e 3443 return fallback;
2eec3b4e
RS
3444}
3445
3446DEFUN ("overlay-put", Foverlay_put, Soverlay_put, 3, 3, 0,
3447 "Set one property of overlay OVERLAY: give property PROP value VALUE.")
3448 (overlay, prop, value)
3449 Lisp_Object overlay, prop, value;
3450{
48e2e3ba 3451 Lisp_Object tail, buffer;
9d7608b7 3452 int changed;
2eec3b4e 3453
52f8ec73 3454 CHECK_OVERLAY (overlay, 0);
b61982dd 3455
274a9425
RS
3456 buffer = Fmarker_buffer (OVERLAY_START (overlay));
3457
48e2e3ba 3458 for (tail = XOVERLAY (overlay)->plist;
2eec3b4e
RS
3459 CONSP (tail) && CONSP (XCONS (tail)->cdr);
3460 tail = XCONS (XCONS (tail)->cdr)->cdr)
274a9425
RS
3461 if (EQ (XCONS (tail)->car, prop))
3462 {
9d7608b7
KH
3463 changed = !EQ (XCONS (XCONS (tail)->cdr)->car, value);
3464 XCONS (XCONS (tail)->cdr)->car = value;
3465 goto found;
274a9425 3466 }
9d7608b7
KH
3467 /* It wasn't in the list, so add it to the front. */
3468 changed = !NILP (value);
48e2e3ba
KH
3469 XOVERLAY (overlay)->plist
3470 = Fcons (prop, Fcons (value, XOVERLAY (overlay)->plist));
9d7608b7
KH
3471 found:
3472 if (! NILP (buffer))
3473 {
3474 if (changed)
876aa27c 3475 modify_overlay (XBUFFER (buffer),
9d7608b7
KH
3476 marker_position (OVERLAY_START (overlay)),
3477 marker_position (OVERLAY_END (overlay)));
3478 if (EQ (prop, Qevaporate) && ! NILP (value)
3479 && (OVERLAY_POSITION (OVERLAY_START (overlay))
3480 == OVERLAY_POSITION (OVERLAY_END (overlay))))
3481 Fdelete_overlay (overlay);
3482 }
2eec3b4e 3483 return value;
1ab256cb
RM
3484}
3485\f
9115729e
KH
3486/* Subroutine of report_overlay_modification. */
3487
3488/* Lisp vector holding overlay hook functions to call.
3489 Vector elements come in pairs.
3490 Each even-index element is a list of hook functions.
3491 The following odd-index element is the overlay they came from.
3492
3493 Before the buffer change, we fill in this vector
3494 as we call overlay hook functions.
3495 After the buffer change, we get the functions to call from this vector.
3496 This way we always call the same functions before and after the change. */
3497static Lisp_Object last_overlay_modification_hooks;
3498
3499/* Number of elements actually used in last_overlay_modification_hooks. */
3500static int last_overlay_modification_hooks_used;
3501
3502/* Add one functionlist/overlay pair
3503 to the end of last_overlay_modification_hooks. */
3504
3505static void
3506add_overlay_mod_hooklist (functionlist, overlay)
3507 Lisp_Object functionlist, overlay;
3508{
3509 int oldsize = XVECTOR (last_overlay_modification_hooks)->size;
3510
3511 if (last_overlay_modification_hooks_used == oldsize)
3512 {
3513 Lisp_Object old;
3514 old = last_overlay_modification_hooks;
3515 last_overlay_modification_hooks
3516 = Fmake_vector (make_number (oldsize * 2), Qnil);
0b1f1b09
RS
3517 bcopy (XVECTOR (old)->contents,
3518 XVECTOR (last_overlay_modification_hooks)->contents,
9115729e
KH
3519 sizeof (Lisp_Object) * oldsize);
3520 }
3521 XVECTOR (last_overlay_modification_hooks)->contents[last_overlay_modification_hooks_used++] = functionlist;
3522 XVECTOR (last_overlay_modification_hooks)->contents[last_overlay_modification_hooks_used++] = overlay;
3523}
3524\f
173f2a64
RS
3525/* Run the modification-hooks of overlays that include
3526 any part of the text in START to END.
9115729e
KH
3527 If this change is an insertion, also
3528 run the insert-before-hooks of overlay starting at END,
930a9140
RS
3529 and the insert-after-hooks of overlay ending at START.
3530
3531 This is called both before and after the modification.
3532 AFTER is nonzero when we call after the modification.
3533
9115729e
KH
3534 ARG1, ARG2, ARG3 are arguments to pass to the hook functions.
3535 When AFTER is nonzero, they are the start position,
3536 the position after the inserted new text,
3537 and the length of deleted or replaced old text. */
173f2a64
RS
3538
3539void
930a9140 3540report_overlay_modification (start, end, after, arg1, arg2, arg3)
173f2a64 3541 Lisp_Object start, end;
930a9140
RS
3542 int after;
3543 Lisp_Object arg1, arg2, arg3;
173f2a64
RS
3544{
3545 Lisp_Object prop, overlay, tail;
9115729e
KH
3546 /* 1 if this change is an insertion. */
3547 int insertion = (after ? XFASTINT (arg3) == 0 : EQ (start, end));
55b48893 3548 int tail_copied;
930a9140 3549 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
55b48893
RS
3550
3551 overlay = Qnil;
3552 tail = Qnil;
930a9140 3553 GCPRO5 (overlay, tail, arg1, arg2, arg3);
173f2a64 3554
9115729e
KH
3555 if (after)
3556 {
3557 /* Call the functions recorded in last_overlay_modification_hooks
3558 rather than scanning the overlays again.
3559 First copy the vector contents, in case some of these hooks
3560 do subsequent modification of the buffer. */
3561 int size = last_overlay_modification_hooks_used;
3562 Lisp_Object *copy = (Lisp_Object *) alloca (size * sizeof (Lisp_Object));
3563 int i;
3564
3565 bcopy (XVECTOR (last_overlay_modification_hooks)->contents,
3566 copy, size * sizeof (Lisp_Object));
3567 gcpro1.var = copy;
3568 gcpro1.nvars = size;
3569
3570 for (i = 0; i < size;)
3571 {
3572 Lisp_Object prop, overlay;
3573 prop = copy[i++];
3574 overlay = copy[i++];
3575 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
3576 }
3577 UNGCPRO;
3578 return;
3579 }
3580
3581 /* We are being called before a change.
3582 Scan the overlays to find the functions to call. */
3583 last_overlay_modification_hooks_used = 0;
55b48893 3584 tail_copied = 0;
173f2a64
RS
3585 for (tail = current_buffer->overlays_before;
3586 CONSP (tail);
3587 tail = XCONS (tail)->cdr)
3588 {
3589 int startpos, endpos;
be8b1c6b 3590 Lisp_Object ostart, oend;
173f2a64
RS
3591
3592 overlay = XCONS (tail)->car;
3593
3594 ostart = OVERLAY_START (overlay);
3595 oend = OVERLAY_END (overlay);
3596 endpos = OVERLAY_POSITION (oend);
3597 if (XFASTINT (start) > endpos)
3598 break;
3599 startpos = OVERLAY_POSITION (ostart);
9115729e
KH
3600 if (insertion && (XFASTINT (start) == startpos
3601 || XFASTINT (end) == startpos))
173f2a64
RS
3602 {
3603 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
5fb5aa33
RS
3604 if (!NILP (prop))
3605 {
3606 /* Copy TAIL in case the hook recenters the overlay lists. */
55b48893
RS
3607 if (!tail_copied)
3608 tail = Fcopy_sequence (tail);
3609 tail_copied = 1;
930a9140 3610 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
5fb5aa33 3611 }
173f2a64 3612 }
9115729e
KH
3613 if (insertion && (XFASTINT (start) == endpos
3614 || XFASTINT (end) == endpos))
173f2a64
RS
3615 {
3616 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
5fb5aa33
RS
3617 if (!NILP (prop))
3618 {
55b48893
RS
3619 if (!tail_copied)
3620 tail = Fcopy_sequence (tail);
3621 tail_copied = 1;
930a9140 3622 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
5fb5aa33 3623 }
173f2a64 3624 }
3bd13e92
KH
3625 /* Test for intersecting intervals. This does the right thing
3626 for both insertion and deletion. */
3627 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
173f2a64
RS
3628 {
3629 prop = Foverlay_get (overlay, Qmodification_hooks);
5fb5aa33
RS
3630 if (!NILP (prop))
3631 {
55b48893
RS
3632 if (!tail_copied)
3633 tail = Fcopy_sequence (tail);
3634 tail_copied = 1;
930a9140 3635 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
5fb5aa33 3636 }
173f2a64
RS
3637 }
3638 }
3639
55b48893 3640 tail_copied = 0;
173f2a64
RS
3641 for (tail = current_buffer->overlays_after;
3642 CONSP (tail);
3643 tail = XCONS (tail)->cdr)
3644 {
3645 int startpos, endpos;
be8b1c6b 3646 Lisp_Object ostart, oend;
173f2a64
RS
3647
3648 overlay = XCONS (tail)->car;
3649
3650 ostart = OVERLAY_START (overlay);
3651 oend = OVERLAY_END (overlay);
3652 startpos = OVERLAY_POSITION (ostart);
cdf0b096 3653 endpos = OVERLAY_POSITION (oend);
173f2a64
RS
3654 if (XFASTINT (end) < startpos)
3655 break;
9115729e
KH
3656 if (insertion && (XFASTINT (start) == startpos
3657 || XFASTINT (end) == startpos))
173f2a64
RS
3658 {
3659 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
5fb5aa33
RS
3660 if (!NILP (prop))
3661 {
55b48893
RS
3662 if (!tail_copied)
3663 tail = Fcopy_sequence (tail);
3664 tail_copied = 1;
930a9140 3665 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
5fb5aa33 3666 }
173f2a64 3667 }
9115729e
KH
3668 if (insertion && (XFASTINT (start) == endpos
3669 || XFASTINT (end) == endpos))
173f2a64
RS
3670 {
3671 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
5fb5aa33
RS
3672 if (!NILP (prop))
3673 {
55b48893
RS
3674 if (!tail_copied)
3675 tail = Fcopy_sequence (tail);
3676 tail_copied = 1;
930a9140 3677 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
5fb5aa33 3678 }
173f2a64 3679 }
3bd13e92
KH
3680 /* Test for intersecting intervals. This does the right thing
3681 for both insertion and deletion. */
3682 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
173f2a64
RS
3683 {
3684 prop = Foverlay_get (overlay, Qmodification_hooks);
5fb5aa33
RS
3685 if (!NILP (prop))
3686 {
55b48893
RS
3687 if (!tail_copied)
3688 tail = Fcopy_sequence (tail);
3689 tail_copied = 1;
930a9140 3690 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
5fb5aa33 3691 }
173f2a64
RS
3692 }
3693 }
55b48893
RS
3694
3695 UNGCPRO;
173f2a64
RS
3696}
3697
3698static void
930a9140
RS
3699call_overlay_mod_hooks (list, overlay, after, arg1, arg2, arg3)
3700 Lisp_Object list, overlay;
3701 int after;
3702 Lisp_Object arg1, arg2, arg3;
173f2a64 3703{
930a9140 3704 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
9115729e 3705
930a9140 3706 GCPRO4 (list, arg1, arg2, arg3);
9115729e
KH
3707 if (! after)
3708 add_overlay_mod_hooklist (list, overlay);
3709
173f2a64
RS
3710 while (!NILP (list))
3711 {
930a9140
RS
3712 if (NILP (arg3))
3713 call4 (Fcar (list), overlay, after ? Qt : Qnil, arg1, arg2);
3714 else
3715 call5 (Fcar (list), overlay, after ? Qt : Qnil, arg1, arg2, arg3);
173f2a64
RS
3716 list = Fcdr (list);
3717 }
3718 UNGCPRO;
3719}
9d7608b7
KH
3720
3721/* Delete any zero-sized overlays at position POS, if the `evaporate'
3722 property is set. */
3723void
3724evaporate_overlays (pos)
3725 int pos;
3726{
3727 Lisp_Object tail, overlay, hit_list;
3728
3729 hit_list = Qnil;
3730 if (pos <= XFASTINT (current_buffer->overlay_center))
3731 for (tail = current_buffer->overlays_before; CONSP (tail);
3732 tail = XCONS (tail)->cdr)
3733 {
3734 int endpos;
3735 overlay = XCONS (tail)->car;
3736 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3737 if (endpos < pos)
3738 break;
3739 if (endpos == pos && OVERLAY_POSITION (OVERLAY_START (overlay)) == pos
c3935f9d 3740 && ! NILP (Foverlay_get (overlay, Qevaporate)))
9d7608b7
KH
3741 hit_list = Fcons (overlay, hit_list);
3742 }
3743 else
3744 for (tail = current_buffer->overlays_after; CONSP (tail);
3745 tail = XCONS (tail)->cdr)
3746 {
3747 int startpos;
889bf329 3748 overlay = XCONS (tail)->car;
9d7608b7
KH
3749 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3750 if (startpos > pos)
3751 break;
3752 if (startpos == pos && OVERLAY_POSITION (OVERLAY_END (overlay)) == pos
c3935f9d 3753 && ! NILP (Foverlay_get (overlay, Qevaporate)))
9d7608b7
KH
3754 hit_list = Fcons (overlay, hit_list);
3755 }
3756 for (; CONSP (hit_list); hit_list = XCONS (hit_list)->cdr)
3757 Fdelete_overlay (XCONS (hit_list)->car);
3758}
173f2a64 3759\f
54dfdeb0 3760/* Somebody has tried to store a value with an unacceptable type
1bf08baf
KH
3761 in the slot with offset OFFSET. */
3762
0fa3ba92 3763void
54dfdeb0
KH
3764buffer_slot_type_mismatch (offset)
3765 int offset;
0fa3ba92 3766{
54dfdeb0 3767 Lisp_Object sym;
0fa3ba92 3768 char *type_name;
54dfdeb0 3769 sym = *(Lisp_Object *)(offset + (char *)&buffer_local_symbols);
0fa3ba92
JB
3770 switch (XINT (*(Lisp_Object *)(offset + (char *)&buffer_local_types)))
3771 {
3772 case Lisp_Int: type_name = "integers"; break;
3773 case Lisp_String: type_name = "strings"; break;
0fa3ba92 3774 case Lisp_Symbol: type_name = "symbols"; break;
1bf08baf 3775
0fa3ba92
JB
3776 default:
3777 abort ();
3778 }
3779
1bf08baf 3780 error ("Only %s should be stored in the buffer-local variable %s",
54dfdeb0 3781 type_name, XSYMBOL (sym)->name->data);
0fa3ba92
JB
3782}
3783\f
dfcf069d 3784void
1ab256cb
RM
3785init_buffer_once ()
3786{
3787 register Lisp_Object tem;
3788
13de9290
RS
3789 buffer_permanent_local_flags = 0;
3790
1ab256cb
RM
3791 /* Make sure all markable slots in buffer_defaults
3792 are initialized reasonably, so mark_buffer won't choke. */
3793 reset_buffer (&buffer_defaults);
13de9290 3794 reset_buffer_local_variables (&buffer_defaults, 1);
1ab256cb 3795 reset_buffer (&buffer_local_symbols);
13de9290 3796 reset_buffer_local_variables (&buffer_local_symbols, 1);
336cd056
RS
3797 /* Prevent GC from getting confused. */
3798 buffer_defaults.text = &buffer_defaults.own_text;
3799 buffer_local_symbols.text = &buffer_local_symbols.own_text;
3800#ifdef USE_TEXT_PROPERTIES
3801 BUF_INTERVALS (&buffer_defaults) = 0;
3802 BUF_INTERVALS (&buffer_local_symbols) = 0;
3803#endif
67180c6a
KH
3804 XSETBUFFER (Vbuffer_defaults, &buffer_defaults);
3805 XSETBUFFER (Vbuffer_local_symbols, &buffer_local_symbols);
1ab256cb
RM
3806
3807 /* Set up the default values of various buffer slots. */
3808 /* Must do these before making the first buffer! */
3809
3810 /* real setup is done in loaddefs.el */
3811 buffer_defaults.mode_line_format = build_string ("%-");
3812 buffer_defaults.abbrev_mode = Qnil;
3813 buffer_defaults.overwrite_mode = Qnil;
3814 buffer_defaults.case_fold_search = Qt;
3815 buffer_defaults.auto_fill_function = Qnil;
3816 buffer_defaults.selective_display = Qnil;
3817#ifndef old
3818 buffer_defaults.selective_display_ellipses = Qt;
3819#endif
3820 buffer_defaults.abbrev_table = Qnil;
3821 buffer_defaults.display_table = Qnil;
1ab256cb 3822 buffer_defaults.undo_list = Qnil;
c48f61ef 3823 buffer_defaults.mark_active = Qnil;
be9aafdd 3824 buffer_defaults.file_format = Qnil;
2eec3b4e
RS
3825 buffer_defaults.overlays_before = Qnil;
3826 buffer_defaults.overlays_after = Qnil;
bbbe9545 3827 XSETFASTINT (buffer_defaults.overlay_center, BEG);
1ab256cb 3828
8d7a4592 3829 XSETFASTINT (buffer_defaults.tab_width, 8);
1ab256cb
RM
3830 buffer_defaults.truncate_lines = Qnil;
3831 buffer_defaults.ctl_arrow = Qt;
3b06f880 3832 buffer_defaults.direction_reversed = Qnil;
1ab256cb 3833
f7975d07 3834#ifdef DOS_NT
0776cb1b 3835 buffer_defaults.buffer_file_type = Qnil; /* TEXT */
54ad07d3 3836#endif
a1a17b61 3837 buffer_defaults.enable_multibyte_characters = Qt;
c71b5d9b 3838 buffer_defaults.buffer_file_coding_system = Qnil;
8d7a4592
KH
3839 XSETFASTINT (buffer_defaults.fill_column, 70);
3840 XSETFASTINT (buffer_defaults.left_margin, 0);
28e969dd 3841 buffer_defaults.cache_long_line_scans = Qnil;
f6ed2e84 3842 buffer_defaults.file_truename = Qnil;
7962a441 3843 XSETFASTINT (buffer_defaults.display_count, 0);
1ab256cb
RM
3844
3845 /* Assign the local-flags to the slots that have default values.
3846 The local flag is a bit that is used in the buffer
3847 to say that it has its own local value for the slot.
3848 The local flag bits are in the local_var_flags slot of the buffer. */
3849
3850 /* Nothing can work if this isn't true */
4d2f1389 3851 if (sizeof (EMACS_INT) != sizeof (Lisp_Object)) abort ();
1ab256cb
RM
3852
3853 /* 0 means not a lisp var, -1 means always local, else mask */
3854 bzero (&buffer_local_flags, sizeof buffer_local_flags);
aab80822
KH
3855 XSETINT (buffer_local_flags.filename, -1);
3856 XSETINT (buffer_local_flags.directory, -1);
3857 XSETINT (buffer_local_flags.backed_up, -1);
3858 XSETINT (buffer_local_flags.save_length, -1);
3859 XSETINT (buffer_local_flags.auto_save_file_name, -1);
3860 XSETINT (buffer_local_flags.read_only, -1);
3861 XSETINT (buffer_local_flags.major_mode, -1);
3862 XSETINT (buffer_local_flags.mode_name, -1);
3863 XSETINT (buffer_local_flags.undo_list, -1);
3864 XSETINT (buffer_local_flags.mark_active, -1);
943e065b 3865 XSETINT (buffer_local_flags.point_before_scroll, -1);
f6ed2e84 3866 XSETINT (buffer_local_flags.file_truename, -1);
3cb719bd 3867 XSETINT (buffer_local_flags.invisibility_spec, -1);
55ac8536 3868 XSETINT (buffer_local_flags.file_format, -1);
7962a441 3869 XSETINT (buffer_local_flags.display_count, -1);
1bf08baf 3870 XSETINT (buffer_local_flags.enable_multibyte_characters, -1);
8d7a4592
KH
3871
3872 XSETFASTINT (buffer_local_flags.mode_line_format, 1);
3873 XSETFASTINT (buffer_local_flags.abbrev_mode, 2);
3874 XSETFASTINT (buffer_local_flags.overwrite_mode, 4);
3875 XSETFASTINT (buffer_local_flags.case_fold_search, 8);
3876 XSETFASTINT (buffer_local_flags.auto_fill_function, 0x10);
3877 XSETFASTINT (buffer_local_flags.selective_display, 0x20);
1ab256cb 3878#ifndef old
8d7a4592 3879 XSETFASTINT (buffer_local_flags.selective_display_ellipses, 0x40);
1ab256cb 3880#endif
8d7a4592
KH
3881 XSETFASTINT (buffer_local_flags.tab_width, 0x80);
3882 XSETFASTINT (buffer_local_flags.truncate_lines, 0x100);
3883 XSETFASTINT (buffer_local_flags.ctl_arrow, 0x200);
3884 XSETFASTINT (buffer_local_flags.fill_column, 0x400);
3885 XSETFASTINT (buffer_local_flags.left_margin, 0x800);
3886 XSETFASTINT (buffer_local_flags.abbrev_table, 0x1000);
3887 XSETFASTINT (buffer_local_flags.display_table, 0x2000);
f7975d07 3888#ifdef DOS_NT
8d7a4592 3889 XSETFASTINT (buffer_local_flags.buffer_file_type, 0x4000);
13de9290
RS
3890 /* Make this one a permanent local. */
3891 buffer_permanent_local_flags |= 0x4000;
54ad07d3 3892#endif
2e716096
RS
3893 XSETFASTINT (buffer_local_flags.syntax_table, 0x8000);
3894 XSETFASTINT (buffer_local_flags.cache_long_line_scans, 0x10000);
3b06f880
KH
3895 XSETFASTINT (buffer_local_flags.category_table, 0x20000);
3896 XSETFASTINT (buffer_local_flags.direction_reversed, 0x40000);
1bf08baf 3897 XSETFASTINT (buffer_local_flags.buffer_file_coding_system, 0x80000);
a1a17b61
KH
3898 /* Make this one a permanent local. */
3899 buffer_permanent_local_flags |= 0x80000;
c71b5d9b 3900
1ab256cb
RM
3901 Vbuffer_alist = Qnil;
3902 current_buffer = 0;
3903 all_buffers = 0;
3904
3905 QSFundamental = build_string ("Fundamental");
3906
3907 Qfundamental_mode = intern ("fundamental-mode");
3908 buffer_defaults.major_mode = Qfundamental_mode;
3909
3910 Qmode_class = intern ("mode-class");
3911
3912 Qprotected_field = intern ("protected-field");
3913
3914 Qpermanent_local = intern ("permanent-local");
3915
3916 Qkill_buffer_hook = intern ("kill-buffer-hook");
3917
3918 Vprin1_to_string_buffer = Fget_buffer_create (build_string (" prin1"));
000f8083 3919
1ab256cb
RM
3920 /* super-magic invisible buffer */
3921 Vbuffer_alist = Qnil;
3922
ffd56f97 3923 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
1ab256cb
RM
3924}
3925
dfcf069d 3926void
1ab256cb
RM
3927init_buffer ()
3928{
3929 char buf[MAXPATHLEN+1];
2381d133
JB
3930 char *pwd;
3931 struct stat dotstat, pwdstat;
136351b7 3932 Lisp_Object temp;
f7975d07 3933 int rc;
1ab256cb
RM
3934
3935 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
3d871c85
RS
3936 if (NILP (buffer_defaults.enable_multibyte_characters))
3937 Fset_buffer_multibyte (Qnil);
2381d133
JB
3938
3939 /* If PWD is accurate, use it instead of calling getwd. This is faster
3940 when PWD is right, and may avoid a fatal error. */
f7975d07 3941 if ((pwd = getenv ("PWD")) != 0 && IS_DIRECTORY_SEP (*pwd)
2381d133
JB
3942 && stat (pwd, &pwdstat) == 0
3943 && stat (".", &dotstat) == 0
3944 && dotstat.st_ino == pwdstat.st_ino
3945 && dotstat.st_dev == pwdstat.st_dev
3946 && strlen (pwd) < MAXPATHLEN)
3947 strcpy (buf, pwd);
6335beb0
RS
3948#ifdef HAVE_GETCWD
3949 else if (getcwd (buf, MAXPATHLEN+1) == 0)
9dde47f5 3950 fatal ("`getcwd' failed: %s\n", strerror (errno));
6335beb0 3951#else
2381d133 3952 else if (getwd (buf) == 0)
cf1e6391 3953 fatal ("`getwd' failed: %s\n", buf);
6335beb0 3954#endif
1ab256cb
RM
3955
3956#ifndef VMS
3957 /* Maybe this should really use some standard subroutine
3958 whose definition is filename syntax dependent. */
f7975d07
RS
3959 rc = strlen (buf);
3960 if (!(IS_DIRECTORY_SEP (buf[rc - 1])))
3961 {
3962 buf[rc] = DIRECTORY_SEP;
3963 buf[rc + 1] = '\0';
3964 }
1ab256cb 3965#endif /* not VMS */
0995fa35 3966
1ab256cb 3967 current_buffer->directory = build_string (buf);
136351b7 3968
0995fa35
RS
3969 /* Add /: to the front of the name
3970 if it would otherwise be treated as magic. */
3971 temp = Ffind_file_name_handler (current_buffer->directory, Qt);
81ab2e07
KH
3972 if (! NILP (temp)
3973 /* If the default dir is just /, TEMP is non-nil
3974 because of the ange-ftp completion handler.
3975 However, it is not necessary to turn / into /:/.
3976 So avoid doing that. */
3977 && strcmp ("/", XSTRING (current_buffer->directory)->data))
0995fa35
RS
3978 current_buffer->directory
3979 = concat2 (build_string ("/:"), current_buffer->directory);
3980
136351b7
RS
3981 temp = get_minibuffer (0);
3982 XBUFFER (temp)->directory = current_buffer->directory;
1ab256cb
RM
3983}
3984
3985/* initialize the buffer routines */
dfcf069d 3986void
1ab256cb
RM
3987syms_of_buffer ()
3988{
188d4d11
RM
3989 extern Lisp_Object Qdisabled;
3990
9115729e
KH
3991 staticpro (&last_overlay_modification_hooks);
3992 last_overlay_modification_hooks
3993 = Fmake_vector (make_number (10), Qnil);
3994
1ab256cb
RM
3995 staticpro (&Vbuffer_defaults);
3996 staticpro (&Vbuffer_local_symbols);
3997 staticpro (&Qfundamental_mode);
3998 staticpro (&Qmode_class);
3999 staticpro (&QSFundamental);
4000 staticpro (&Vbuffer_alist);
4001 staticpro (&Qprotected_field);
4002 staticpro (&Qpermanent_local);
4003 staticpro (&Qkill_buffer_hook);
22378665 4004 Qoverlayp = intern ("overlayp");
52f8ec73 4005 staticpro (&Qoverlayp);
9d7608b7
KH
4006 Qevaporate = intern ("evaporate");
4007 staticpro (&Qevaporate);
294d215f 4008 Qmodification_hooks = intern ("modification-hooks");
22378665 4009 staticpro (&Qmodification_hooks);
294d215f 4010 Qinsert_in_front_hooks = intern ("insert-in-front-hooks");
22378665 4011 staticpro (&Qinsert_in_front_hooks);
294d215f 4012 Qinsert_behind_hooks = intern ("insert-behind-hooks");
22378665 4013 staticpro (&Qinsert_behind_hooks);
5fe0b67e 4014 Qget_file_buffer = intern ("get-file-buffer");
22378665 4015 staticpro (&Qget_file_buffer);
5985d248
KH
4016 Qpriority = intern ("priority");
4017 staticpro (&Qpriority);
4018 Qwindow = intern ("window");
4019 staticpro (&Qwindow);
bbbe9545
KH
4020 Qbefore_string = intern ("before-string");
4021 staticpro (&Qbefore_string);
4022 Qafter_string = intern ("after-string");
4023 staticpro (&Qafter_string);
22378665
RS
4024 Qfirst_change_hook = intern ("first-change-hook");
4025 staticpro (&Qfirst_change_hook);
4026 Qbefore_change_functions = intern ("before-change-functions");
4027 staticpro (&Qbefore_change_functions);
4028 Qafter_change_functions = intern ("after-change-functions");
4029 staticpro (&Qafter_change_functions);
1ab256cb
RM
4030
4031 Fput (Qprotected_field, Qerror_conditions,
4032 Fcons (Qprotected_field, Fcons (Qerror, Qnil)));
4033 Fput (Qprotected_field, Qerror_message,
4034 build_string ("Attempt to modify a protected field"));
4035
4036 /* All these use DEFVAR_LISP_NOPRO because the slots in
4037 buffer_defaults will all be marked via Vbuffer_defaults. */
4038
4039 DEFVAR_LISP_NOPRO ("default-mode-line-format",
4040 &buffer_defaults.mode_line_format,
4041 "Default value of `mode-line-format' for buffers that don't override it.\n\
4042This is the same as (default-value 'mode-line-format).");
4043
4044 DEFVAR_LISP_NOPRO ("default-abbrev-mode",
4045 &buffer_defaults.abbrev_mode,
4046 "Default value of `abbrev-mode' for buffers that do not override it.\n\
4047This is the same as (default-value 'abbrev-mode).");
4048
4049 DEFVAR_LISP_NOPRO ("default-ctl-arrow",
4050 &buffer_defaults.ctl_arrow,
4051 "Default value of `ctl-arrow' for buffers that do not override it.\n\
4052This is the same as (default-value 'ctl-arrow).");
4053
3b06f880
KH
4054 DEFVAR_LISP_NOPRO ("default-direction-reversed",
4055 &buffer_defaults.direction_reversed,
4056 "Default value of `direction_reversed' for buffers that do not override it.\n\
4057 This is the same as (default-value 'direction-reversed).");
4058
a1a17b61
KH
4059 DEFVAR_LISP_NOPRO ("default-enable-multibyte-characters",
4060 &buffer_defaults.enable_multibyte_characters,
4061 "Default value of `enable-multibyte-characters' for buffers not overriding it.\n\
4062 This is the same as (default-value 'enable-multibyte-characters).");
4063
c71b5d9b
KH
4064 DEFVAR_LISP_NOPRO ("default-buffer-file-coding-system",
4065 &buffer_defaults.buffer_file_coding_system,
4066 "Default value of `buffer-file-coding-system' for buffers not overriding it.\n\
4067 This is the same as (default-value 'buffer-file-coding-system).");
4068
1ab256cb
RM
4069 DEFVAR_LISP_NOPRO ("default-truncate-lines",
4070 &buffer_defaults.truncate_lines,
4071 "Default value of `truncate-lines' for buffers that do not override it.\n\
4072This is the same as (default-value 'truncate-lines).");
4073
4074 DEFVAR_LISP_NOPRO ("default-fill-column",
4075 &buffer_defaults.fill_column,
4076 "Default value of `fill-column' for buffers that do not override it.\n\
4077This is the same as (default-value 'fill-column).");
4078
4079 DEFVAR_LISP_NOPRO ("default-left-margin",
4080 &buffer_defaults.left_margin,
4081 "Default value of `left-margin' for buffers that do not override it.\n\
4082This is the same as (default-value 'left-margin).");
4083
4084 DEFVAR_LISP_NOPRO ("default-tab-width",
4085 &buffer_defaults.tab_width,
4086 "Default value of `tab-width' for buffers that do not override it.\n\
4087This is the same as (default-value 'tab-width).");
4088
4089 DEFVAR_LISP_NOPRO ("default-case-fold-search",
4090 &buffer_defaults.case_fold_search,
4091 "Default value of `case-fold-search' for buffers that don't override it.\n\
4092This is the same as (default-value 'case-fold-search).");
4093
f7975d07 4094#ifdef DOS_NT
54ad07d3
RS
4095 DEFVAR_LISP_NOPRO ("default-buffer-file-type",
4096 &buffer_defaults.buffer_file_type,
4097 "Default file type for buffers that do not override it.\n\
4098This is the same as (default-value 'buffer-file-type).\n\
4099The file type is nil for text, t for binary.");
4100#endif
4101
0fa3ba92
JB
4102 DEFVAR_PER_BUFFER ("mode-line-format", &current_buffer->mode_line_format,
4103 Qnil, 0);
1ab256cb
RM
4104
4105/* This doc string is too long for cpp; cpp dies if it isn't in a comment.
4106 But make-docfile finds it!
4107 DEFVAR_PER_BUFFER ("mode-line-format", &current_buffer->mode_line_format,
bec44fd6 4108 Qnil,
1ab256cb
RM
4109 "Template for displaying mode line for current buffer.\n\
4110Each buffer has its own value of this variable.\n\
4111Value may be a string, a symbol or a list or cons cell.\n\
4112For a symbol, its value is used (but it is ignored if t or nil).\n\
4113 A string appearing directly as the value of a symbol is processed verbatim\n\
4114 in that the %-constructs below are not recognized.\n\
4115For a list whose car is a symbol, the symbol's value is taken,\n\
4116 and if that is non-nil, the cadr of the list is processed recursively.\n\
4117 Otherwise, the caddr of the list (if there is one) is processed.\n\
4118For a list whose car is a string or list, each element is processed\n\
4119 recursively and the results are effectively concatenated.\n\
4120For a list whose car is an integer, the cdr of the list is processed\n\
4121 and padded (if the number is positive) or truncated (if negative)\n\
4122 to the width specified by that number.\n\
4123A string is printed verbatim in the mode line except for %-constructs:\n\
4124 (%-constructs are allowed when the string is the entire mode-line-format\n\
4125 or when it is found in a cons-cell or a list)\n\
4126 %b -- print buffer name. %f -- print visited file name.\n\
5d516f2d 4127 %F -- print frame name.\n\
c2ff34f7
RS
4128 %* -- print %, * or hyphen. %+ -- print *, % or hyphen.\n\
4129 % means buffer is read-only and * means it is modified.\n\
4130 For a modified read-only buffer, %* gives % and %+ gives *.\n\
a97c374a 4131 %s -- print process status. %l -- print the current line number.\n\
07924294 4132 %c -- print the current column number (this makes editing slower).\n\
6a567ad8
RS
4133 To make the column number update correctly in all cases,\n\
4134 `column-number-mode' must be non-nil.\n\
dd24e6a6 4135 %p -- print percent of buffer above top of window, or Top, Bot or All.\n\
9d130ffc 4136 %P -- print percent of buffer above bottom of window, perhaps plus Top,\n\
dd24e6a6 4137 or print Bottom or All.\n\
1ab256cb 4138 %n -- print Narrow if appropriate.\n\
b77087c5 4139 %t -- print T if file is text, B if binary.\n\
1ab256cb
RM
4140 %[ -- print one [ for each recursive editing level. %] similar.\n\
4141 %% -- print %. %- -- print infinitely many dashes.\n\
4142Decimal digits after the % specify field width to which to pad.");
4143*/
4144
4145 DEFVAR_LISP_NOPRO ("default-major-mode", &buffer_defaults.major_mode,
4146 "*Major mode for new buffers. Defaults to `fundamental-mode'.\n\
4147nil here means use current buffer's major mode.");
4148
4149 DEFVAR_PER_BUFFER ("major-mode", &current_buffer->major_mode,
0fa3ba92 4150 make_number (Lisp_Symbol),
1ab256cb
RM
4151 "Symbol for current buffer's major mode.");
4152
4153 DEFVAR_PER_BUFFER ("mode-name", &current_buffer->mode_name,
0fa3ba92 4154 make_number (Lisp_String),
1ab256cb
RM
4155 "Pretty name of current buffer's major mode (a string).");
4156
0fa3ba92 4157 DEFVAR_PER_BUFFER ("abbrev-mode", &current_buffer->abbrev_mode, Qnil,
1ab256cb
RM
4158 "Non-nil turns on automatic expansion of abbrevs as they are inserted.\n\
4159Automatically becomes buffer-local when set in any fashion.");
4160
4161 DEFVAR_PER_BUFFER ("case-fold-search", &current_buffer->case_fold_search,
0fa3ba92 4162 Qnil,
1ab256cb
RM
4163 "*Non-nil if searches should ignore case.\n\
4164Automatically becomes buffer-local when set in any fashion.");
4165
4166 DEFVAR_PER_BUFFER ("fill-column", &current_buffer->fill_column,
0fa3ba92 4167 make_number (Lisp_Int),
1ab256cb
RM
4168 "*Column beyond which automatic line-wrapping should happen.\n\
4169Automatically becomes buffer-local when set in any fashion.");
4170
4171 DEFVAR_PER_BUFFER ("left-margin", &current_buffer->left_margin,
0fa3ba92 4172 make_number (Lisp_Int),
1ab256cb
RM
4173 "*Column for the default indent-line-function to indent to.\n\
4174Linefeed indents to this column in Fundamental mode.\n\
4175Automatically becomes buffer-local when set in any fashion.");
4176
4177 DEFVAR_PER_BUFFER ("tab-width", &current_buffer->tab_width,
0fa3ba92 4178 make_number (Lisp_Int),
1ab256cb
RM
4179 "*Distance between tab stops (for display of tab characters), in columns.\n\
4180Automatically becomes buffer-local when set in any fashion.");
4181
0fa3ba92 4182 DEFVAR_PER_BUFFER ("ctl-arrow", &current_buffer->ctl_arrow, Qnil,
1ab256cb 4183 "*Non-nil means display control chars with uparrow.\n\
6a99d31d 4184A value of nil means use backslash and octal digits.\n\
1ab256cb
RM
4185Automatically becomes buffer-local when set in any fashion.\n\
4186This variable does not apply to characters whose display is specified\n\
4187in the current display table (if there is one).");
4188
3b06f880 4189 DEFVAR_PER_BUFFER ("enable-multibyte-characters",
1bf08baf
KH
4190 &current_buffer->enable_multibyte_characters,
4191 make_number (-1),
c807f767 4192 "*Non-nil means the buffer contents are regarded as multi-byte form\n\
3b06f880
KH
4193of characters, not a binary code. This affects the display, file I/O,\n\
4194and behaviors of various editing commands.");
4195
c71b5d9b
KH
4196 DEFVAR_PER_BUFFER ("buffer-file-coding-system",
4197 &current_buffer->buffer_file_coding_system, Qnil,
4198 "Coding system to be used for encoding the buffer contents on saving.\n\
4199If it is nil, the buffer is saved without any code conversion unless\n\
4200some coding system is specified in file-coding-system-alist\n\
4201for the buffer file.\n\
4202\n\
4203This variable is never applied to a way of decoding\n\
4204a file while reading it.");
4205
3b06f880
KH
4206 DEFVAR_PER_BUFFER ("direction-reversed", &current_buffer->direction_reversed,
4207 Qnil,
4208 "*Non-nil means lines in the buffer are displayed right to left.");
4209
0fa3ba92 4210 DEFVAR_PER_BUFFER ("truncate-lines", &current_buffer->truncate_lines, Qnil,
1ab256cb
RM
4211 "*Non-nil means do not display continuation lines;\n\
4212give each line of text one screen line.\n\
4213Automatically becomes buffer-local when set in any fashion.\n\
4214\n\
4215Note that this is overridden by the variable\n\
4216`truncate-partial-width-windows' if that variable is non-nil\n\
502b9b64 4217and this buffer is not full-frame width.");
1ab256cb 4218
f7975d07 4219#ifdef DOS_NT
54ad07d3
RS
4220 DEFVAR_PER_BUFFER ("buffer-file-type", &current_buffer->buffer_file_type,
4221 Qnil,
006d3d34
RS
4222 "Non-nil if the visited file is a binary file.\n\
4223This variable is meaningful on MS-DOG and Windows NT.\n\
4224On those systems, it is automatically local in every buffer.\n\
e0585c64 4225On other systems, this variable is normally always nil.");
54ad07d3
RS
4226#endif
4227
1ab256cb 4228 DEFVAR_PER_BUFFER ("default-directory", &current_buffer->directory,
0fa3ba92 4229 make_number (Lisp_String),
1ab256cb
RM
4230 "Name of default directory of current buffer. Should end with slash.\n\
4231Each buffer has its own value of this variable.");
4232
4233 DEFVAR_PER_BUFFER ("auto-fill-function", &current_buffer->auto_fill_function,
0fa3ba92 4234 Qnil,
1ab256cb 4235 "Function called (if non-nil) to perform auto-fill.\n\
54158e68 4236It is called after self-inserting a space or newline.\n\
1ab256cb 4237Each buffer has its own value of this variable.\n\
54158e68
KH
4238NOTE: This variable is not a hook;\n\
4239its value may not be a list of functions.");
1ab256cb
RM
4240
4241 DEFVAR_PER_BUFFER ("buffer-file-name", &current_buffer->filename,
0fa3ba92 4242 make_number (Lisp_String),
1ab256cb
RM
4243 "Name of file visited in current buffer, or nil if not visiting a file.\n\
4244Each buffer has its own value of this variable.");
4245
f6ed2e84
RS
4246 DEFVAR_PER_BUFFER ("buffer-file-truename", &current_buffer->file_truename,
4247 make_number (Lisp_String),
bb4c204e 4248 "Abbreviated truename of file visited in current buffer, or nil if none.\n\
b1c03e64
RS
4249The truename of a file is calculated by `file-truename'\n\
4250and then abbreviated with `abbreviate-file-name'.\n\
f6ed2e84
RS
4251Each buffer has its own value of this variable.");
4252
1ab256cb 4253 DEFVAR_PER_BUFFER ("buffer-auto-save-file-name",
3f5fcd47 4254 &current_buffer->auto_save_file_name,
0fa3ba92 4255 make_number (Lisp_String),
1ab256cb
RM
4256 "Name of file for auto-saving current buffer,\n\
4257or nil if buffer should not be auto-saved.\n\
4258Each buffer has its own value of this variable.");
4259
0fa3ba92 4260 DEFVAR_PER_BUFFER ("buffer-read-only", &current_buffer->read_only, Qnil,
1ab256cb
RM
4261 "Non-nil if this buffer is read-only.\n\
4262Each buffer has its own value of this variable.");
4263
0fa3ba92 4264 DEFVAR_PER_BUFFER ("buffer-backed-up", &current_buffer->backed_up, Qnil,
1ab256cb
RM
4265 "Non-nil if this buffer's file has been backed up.\n\
4266Backing up is done before the first time the file is saved.\n\
4267Each buffer has its own value of this variable.");
4268
4269 DEFVAR_PER_BUFFER ("buffer-saved-size", &current_buffer->save_length,
0fa3ba92 4270 make_number (Lisp_Int),
1ab256cb
RM
4271 "Length of current buffer when last read in, saved or auto-saved.\n\
42720 initially.\n\
4273Each buffer has its own value of this variable.");
4274
4275 DEFVAR_PER_BUFFER ("selective-display", &current_buffer->selective_display,
0fa3ba92 4276 Qnil,
1ab256cb
RM
4277 "Non-nil enables selective display:\n\
4278Integer N as value means display only lines\n\
4279 that start with less than n columns of space.\n\
4280A value of t means, after a ^M, all the rest of the line is invisible.\n\
4281 Then ^M's in the file are written into files as newlines.\n\n\
4282Automatically becomes buffer-local when set in any fashion.");
4283
4284#ifndef old
4285 DEFVAR_PER_BUFFER ("selective-display-ellipses",
4286 &current_buffer->selective_display_ellipses,
0fa3ba92 4287 Qnil,
1ab256cb
RM
4288 "t means display ... on previous line when a line is invisible.\n\
4289Automatically becomes buffer-local when set in any fashion.");
4290#endif
4291
0fa3ba92 4292 DEFVAR_PER_BUFFER ("overwrite-mode", &current_buffer->overwrite_mode, Qnil,
1ab256cb 4293 "Non-nil if self-insertion should replace existing text.\n\
5e05d0a5
RS
4294The value should be one of `overwrite-mode-textual',\n\
4295`overwrite-mode-binary', or nil.\n\
4296If it is `overwrite-mode-textual', self-insertion still\n\
6bbb0d4a 4297inserts at the end of a line, and inserts when point is before a tab,\n\
2e94b813 4298until the tab is filled in.\n\
6bbb0d4a 4299If `overwrite-mode-binary', self-insertion replaces newlines and tabs too.\n\
1ab256cb
RM
4300Automatically becomes buffer-local when set in any fashion.");
4301
54939090
RS
4302#if 0 /* The doc string is too long for some compilers,
4303 but make-docfile can find it in this comment. */
1ab256cb 4304 DEFVAR_PER_BUFFER ("buffer-display-table", &current_buffer->display_table,
5d305367 4305 Qnil,
1ab256cb
RM
4306 "Display table that controls display of the contents of current buffer.\n\
4307Automatically becomes buffer-local when set in any fashion.\n\
6fdc249f
EN
4308The display table is a char-table created with `make-display-table'.\n\
4309The ordinary char-table elements control how to display each possible text\n\
4310character. Each value should be a vector of characters or nil;\n\
1ab256cb 4311nil means display the character in the default fashion.\n\
6fdc249f
EN
4312There are six extra slots to control the display of\n\
4313 the end of a truncated screen line (extra-slot 0, a single character);\n\
4314 the end of a continued line (extra-slot 1, a single character);\n\
6158b3b0 4315 the escape character used to display character codes in octal\n\
6fdc249f
EN
4316 (extra-slot 2, a single character);\n\
4317 the character used as an arrow for control characters (extra-slot 3,\n\
6158b3b0 4318 a single character);\n\
6fdc249f 4319 the decoration indicating the presence of invisible lines (extra-slot 4,\n\
a45e35e1
JB
4320 a vector of characters);\n\
4321 the character used to draw the border between side-by-side windows\n\
6fdc249f
EN
4322 (extra-slot 5, a single character).\n\
4323See also the functions `display-table-slot' and `set-display-table-slot'.\n\
1ab256cb
RM
4324If this variable is nil, the value of `standard-display-table' is used.\n\
4325Each window can have its own, overriding display table.");
54939090
RS
4326#endif
4327 DEFVAR_PER_BUFFER ("buffer-display-table", &current_buffer->display_table,
de15914a 4328 Qnil, 0);
1ab256cb 4329
1ab256cb
RM
4330/*DEFVAR_LISP ("debug-check-symbol", &Vcheck_symbol,
4331 "Don't ask.");
4332*/
01050cb5 4333 DEFVAR_LISP ("before-change-function", &Vbefore_change_function,
f0724bcb 4334 "If non-nil, a function to call before each text change (obsolete).\n\
1ab256cb
RM
4335Two arguments are passed to the function: the positions of\n\
4336the beginning and end of the range of old text to be changed.\n\
4337\(For an insertion, the beginning and end are at the same place.)\n\
4338No information is given about the length of the text after the change.\n\
1ab256cb 4339\n\
5f079267 4340Buffer changes made while executing the `before-change-function'\n\
b86344d0
RS
4341don't call any before-change or after-change functions.\n\
4342That's because these variables are temporarily set to nil.\n\
4343As a result, a hook function cannot straightforwardly alter the value of\n\
4344these variables. See the Emacs Lisp manual for a way of\n\
f0724bcb
RS
4345accomplishing an equivalent result by using other variables.\n\n\
4346This variable is obsolete; use `before-change-functions' instead.");
1ab256cb
RM
4347 Vbefore_change_function = Qnil;
4348
4349 DEFVAR_LISP ("after-change-function", &Vafter_change_function,
f0724bcb 4350 "If non-nil, a Function to call after each text change (obsolete).\n\
1ab256cb
RM
4351Three arguments are passed to the function: the positions of\n\
4352the beginning and end of the range of changed text,\n\
4353and the length of the pre-change text replaced by that range.\n\
4354\(For an insertion, the pre-change length is zero;\n\
839dd834 4355for a deletion, that length is the number of bytes deleted,\n\
1ab256cb
RM
4356and the post-change beginning and end are at the same place.)\n\
4357\n\
5f079267 4358Buffer changes made while executing the `after-change-function'\n\
b86344d0
RS
4359don't call any before-change or after-change functions.\n\
4360That's because these variables are temporarily set to nil.\n\
4361As a result, a hook function cannot straightforwardly alter the value of\n\
4362these variables. See the Emacs Lisp manual for a way of\n\
f0724bcb
RS
4363accomplishing an equivalent result by using other variables.\n\n\
4364This variable is obsolete; use `after-change-functions' instead.");
1ab256cb
RM
4365 Vafter_change_function = Qnil;
4366
5f079267
RS
4367 DEFVAR_LISP ("before-change-functions", &Vbefore_change_functions,
4368 "List of functions to call before each text change.\n\
4369Two arguments are passed to each function: the positions of\n\
4370the beginning and end of the range of old text to be changed.\n\
4371\(For an insertion, the beginning and end are at the same place.)\n\
4372No information is given about the length of the text after the change.\n\
5f079267
RS
4373\n\
4374Buffer changes made while executing the `before-change-functions'\n\
b86344d0
RS
4375don't call any before-change or after-change functions.\n\
4376That's because these variables are temporarily set to nil.\n\
4377As a result, a hook function cannot straightforwardly alter the value of\n\
4378these variables. See the Emacs Lisp manual for a way of\n\
d59698c4 4379accomplishing an equivalent result by using other variables.");
5f079267
RS
4380 Vbefore_change_functions = Qnil;
4381
4382 DEFVAR_LISP ("after-change-functions", &Vafter_change_functions,
4383 "List of function to call after each text change.\n\
4384Three arguments are passed to each function: the positions of\n\
4385the beginning and end of the range of changed text,\n\
839dd834 4386and the length in bytes of the pre-change text replaced by that range.\n\
5f079267 4387\(For an insertion, the pre-change length is zero;\n\
839dd834 4388for a deletion, that length is the number of bytes deleted,\n\
5f079267
RS
4389and the post-change beginning and end are at the same place.)\n\
4390\n\
4391Buffer changes made while executing the `after-change-functions'\n\
b86344d0
RS
4392don't call any before-change or after-change functions.\n\
4393That's because these variables are temporarily set to nil.\n\
4394As a result, a hook function cannot straightforwardly alter the value of\n\
4395these variables. See the Emacs Lisp manual for a way of\n\
d59698c4 4396accomplishing an equivalent result by using other variables.");
b86344d0 4397
5f079267
RS
4398 Vafter_change_functions = Qnil;
4399
dbc4e1c1
JB
4400 DEFVAR_LISP ("first-change-hook", &Vfirst_change_hook,
4401 "A list of functions to call before changing a buffer which is unmodified.\n\
4402The functions are run using the `run-hooks' function.");
4403 Vfirst_change_hook = Qnil;
1ab256cb 4404
54939090
RS
4405#if 0 /* The doc string is too long for some compilers,
4406 but make-docfile can find it in this comment. */
3f5fcd47 4407 DEFVAR_PER_BUFFER ("buffer-undo-list", &current_buffer->undo_list, Qnil,
1ab256cb
RM
4408 "List of undo entries in current buffer.\n\
4409Recent changes come first; older changes follow newer.\n\
4410\n\
630f4018
KH
4411An entry (BEG . END) represents an insertion which begins at\n\
4412position BEG and ends at position END.\n\
1ab256cb
RM
4413\n\
4414An entry (TEXT . POSITION) represents the deletion of the string TEXT\n\
4415from (abs POSITION). If POSITION is positive, point was at the front\n\
4416of the text being deleted; if negative, point was at the end.\n\
4417\n\
6c0df54a
RS
4418An entry (t HIGH . LOW) indicates that the buffer previously had\n\
4419\"unmodified\" status. HIGH and LOW are the high and low 16-bit portions\n\
4420of the visited file's modification time, as of that time. If the\n\
4421modification time of the most recent save is different, this entry is\n\
1ab256cb
RM
4422obsolete.\n\
4423\n\
6c0df54a
RS
4424An entry (nil PROPERTY VALUE BEG . END) indicates that a text property\n\
4425was modified between BEG and END. PROPERTY is the property name,\n\
4426and VALUE is the old value.\n\
483c1fd3 4427\n\
da1c183c
RS
4428An entry (MARKER . DISTANCE) indicates that the marker MARKER\n\
4429was adjusted in position by the offset DISTANCE (an integer).\n\
4430\n\
bec44fd6
JB
4431An entry of the form POSITION indicates that point was at the buffer\n\
4432location given by the integer. Undoing an entry of this form places\n\
4433point at POSITION.\n\
4434\n\
1ab256cb
RM
4435nil marks undo boundaries. The undo command treats the changes\n\
4436between two undo boundaries as a single step to be undone.\n\
4437\n\
bec44fd6 4438If the value of the variable is t, undo information is not recorded.");
54939090
RS
4439#endif
4440 DEFVAR_PER_BUFFER ("buffer-undo-list", &current_buffer->undo_list, Qnil,
de15914a 4441 0);
1ab256cb 4442
c48f61ef
RS
4443 DEFVAR_PER_BUFFER ("mark-active", &current_buffer->mark_active, Qnil,
4444 "Non-nil means the mark and region are currently active in this buffer.\n\
4445Automatically local in all buffers.");
4446
28e969dd 4447 DEFVAR_PER_BUFFER ("cache-long-line-scans", &current_buffer->cache_long_line_scans, Qnil,
f0c5b712
JB
4448 "Non-nil means that Emacs should use caches to handle long lines more quickly.\n\
4449This variable is buffer-local, in all buffers.\n\
28e969dd 4450\n\
f0c5b712
JB
4451Normally, the line-motion functions work by scanning the buffer for\n\
4452newlines. Columnar operations (like move-to-column and\n\
4453compute-motion) also work by scanning the buffer, summing character\n\
4454widths as they go. This works well for ordinary text, but if the\n\
28e969dd 4455buffer's lines are very long (say, more than 500 characters), these\n\
f0c5b712
JB
4456motion functions will take longer to execute. Emacs may also take\n\
4457longer to update the display.\n\
28e969dd 4458\n\
f0c5b712
JB
4459If cache-long-line-scans is non-nil, these motion functions cache the\n\
4460results of their scans, and consult the cache to avoid rescanning\n\
4461regions of the buffer until the text is modified. The caches are most\n\
4462beneficial when they prevent the most searching---that is, when the\n\
4463buffer contains long lines and large regions of characters with the\n\
4464same, fixed screen width.\n\
28e969dd 4465\n\
f0c5b712
JB
4466When cache-long-line-scans is non-nil, processing short lines will\n\
4467become slightly slower (because of the overhead of consulting the\n\
4468cache), and the caches will use memory roughly proportional to the\n\
4469number of newlines and characters whose screen width varies.\n\
4470\n\
4471The caches require no explicit maintenance; their accuracy is\n\
4472maintained internally by the Emacs primitives. Enabling or disabling\n\
4473the cache should not affect the behavior of any of the motion\n\
4474functions; it should only affect their performance.");
28e969dd 4475
943e065b
RS
4476 DEFVAR_PER_BUFFER ("point-before-scroll", &current_buffer->point_before_scroll, Qnil,
4477 "Value of point before the last series of scroll operations, or nil.");
4478
be9aafdd
BG
4479 DEFVAR_PER_BUFFER ("buffer-file-format", &current_buffer->file_format, Qnil,
4480 "List of formats to use when saving this buffer.\n\
4481Formats are defined by `format-alist'. This variable is\n\
4482set when a file is visited. Automatically local in all buffers.");
4483
3cb719bd
RS
4484 DEFVAR_PER_BUFFER ("buffer-invisibility-spec",
4485 &current_buffer->invisibility_spec, Qnil,
4486 "Invisibility spec of this buffer.\n\
4487The default is t, which means that text is invisible\n\
4488if it has a non-nil `invisible' property.\n\
4489If the value is a list, a text character is invisible if its `invisible'\n\
4490property is an element in that list.\n\
554216ad
KH
4491If an element is a cons cell of the form (PROP . ELLIPSIS),\n\
4492then characters with property value PROP are invisible,\n\
3cb719bd
RS
4493and they have an ellipsis as well if ELLIPSIS is non-nil.");
4494
7962a441
RS
4495 DEFVAR_PER_BUFFER ("buffer-display-count",
4496 &current_buffer->display_count, Qnil,
4497 "A number incremented each time the buffer is displayed in a window.");
4498
c48f61ef 4499 DEFVAR_LISP ("transient-mark-mode", &Vtransient_mark_mode,
319c537c
RS
4500 "*Non-nil means deactivate the mark when the buffer contents change.\n\
4501Non-nil also enables highlighting of the region whenever the mark is active.\n\
4502The variable `highlight-nonselected-windows' controls whether to highlight\n\
4503all windows or just the selected window.");
c48f61ef
RS
4504 Vtransient_mark_mode = Qnil;
4505
0a4469c9 4506 DEFVAR_LISP ("inhibit-read-only", &Vinhibit_read_only,
a96b68f1
RS
4507 "*Non-nil means disregard read-only status of buffers or characters.\n\
4508If the value is t, disregard `buffer-read-only' and all `read-only'\n\
4509text properties. If the value is a list, disregard `buffer-read-only'\n\
4510and disregard a `read-only' text property if the property value\n\
4511is a member of the list.");
4512 Vinhibit_read_only = Qnil;
4513
dcdffbf6
RS
4514 DEFVAR_LISP ("kill-buffer-query-functions", &Vkill_buffer_query_functions,
4515 "List of functions called with no args to query before killing a buffer.");
4516 Vkill_buffer_query_functions = Qnil;
4517
0dc88e60 4518 defsubr (&Sbuffer_live_p);
1ab256cb
RM
4519 defsubr (&Sbuffer_list);
4520 defsubr (&Sget_buffer);
4521 defsubr (&Sget_file_buffer);
4522 defsubr (&Sget_buffer_create);
336cd056 4523 defsubr (&Smake_indirect_buffer);
01050cb5 4524 defsubr (&Sgenerate_new_buffer_name);
1ab256cb
RM
4525 defsubr (&Sbuffer_name);
4526/*defsubr (&Sbuffer_number);*/
4527 defsubr (&Sbuffer_file_name);
336cd056 4528 defsubr (&Sbuffer_base_buffer);
1ab256cb
RM
4529 defsubr (&Sbuffer_local_variables);
4530 defsubr (&Sbuffer_modified_p);
4531 defsubr (&Sset_buffer_modified_p);
4532 defsubr (&Sbuffer_modified_tick);
4533 defsubr (&Srename_buffer);
4534 defsubr (&Sother_buffer);
4535 defsubr (&Sbuffer_disable_undo);
4536 defsubr (&Sbuffer_enable_undo);
4537 defsubr (&Skill_buffer);
a9ee7a59 4538 defsubr (&Sset_buffer_major_mode);
1ab256cb
RM
4539 defsubr (&Sswitch_to_buffer);
4540 defsubr (&Spop_to_buffer);
4541 defsubr (&Scurrent_buffer);
4542 defsubr (&Sset_buffer);
4543 defsubr (&Sbarf_if_buffer_read_only);
4544 defsubr (&Sbury_buffer);
3ac81adb
RS
4545 defsubr (&Serase_buffer);
4546 defsubr (&Sset_buffer_multibyte);
1ab256cb 4547 defsubr (&Skill_all_local_variables);
2eec3b4e 4548
52f8ec73 4549 defsubr (&Soverlayp);
2eec3b4e
RS
4550 defsubr (&Smake_overlay);
4551 defsubr (&Sdelete_overlay);
4552 defsubr (&Smove_overlay);
8ebafa8d
JB
4553 defsubr (&Soverlay_start);
4554 defsubr (&Soverlay_end);
4555 defsubr (&Soverlay_buffer);
4556 defsubr (&Soverlay_properties);
2eec3b4e 4557 defsubr (&Soverlays_at);
74514898 4558 defsubr (&Soverlays_in);
2eec3b4e 4559 defsubr (&Snext_overlay_change);
239c932b 4560 defsubr (&Sprevious_overlay_change);
2eec3b4e
RS
4561 defsubr (&Soverlay_recenter);
4562 defsubr (&Soverlay_lists);
4563 defsubr (&Soverlay_get);
4564 defsubr (&Soverlay_put);
1ab256cb
RM
4565}
4566
dfcf069d 4567void
1ab256cb
RM
4568keys_of_buffer ()
4569{
4570 initial_define_key (control_x_map, 'b', "switch-to-buffer");
4571 initial_define_key (control_x_map, 'k', "kill-buffer");
4158c17d
RM
4572
4573 /* This must not be in syms_of_buffer, because Qdisabled is not
4574 initialized when that function gets called. */
4575 Fput (intern ("erase-buffer"), Qdisabled, Qt);
1ab256cb 4576}