(Fset_buffer_multibyte): Error if marker is put
[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);
95fb069b
RS
1811
1812 /* This prevents BYTE_TO_CHAR (that is, buf_bytepos_to_charpos) from
1813 getting confused by the markers that have not yet been updated.
1814 It is also a signal that it should never create a marker. */
3ac81adb
RS
1815 BUF_MARKERS (current_buffer) = Qnil;
1816
1817 while (XSYMBOL (tail) != XSYMBOL (Qnil))
1818 {
b05525fa
RS
1819 XMARKER (tail)->bytepos
1820 = advance_to_char_boundary (XMARKER (tail)->bytepos);
3ac81adb 1821 XMARKER (tail)->charpos = BYTE_TO_CHAR (XMARKER (tail)->bytepos);
b05525fa 1822
3ac81adb
RS
1823 tail = XMARKER (tail)->chain;
1824 }
b69f9797
RS
1825
1826 /* Make sure no markers were put on the chain
1827 while the chain value was incorrect. */
1828 if (! EQ (BUF_MARKERS (current_buffer), Qnil))
1829 abort ();
1830
3ac81adb
RS
1831 BUF_MARKERS (current_buffer) = markers;
1832
1833 /* Do this last, so it can calculate the new correspondences
1834 between chars and bytes. */
1835 set_intervals_multibyte (1);
1836 }
1837
1838 return flag;
1839}
1840\f
1ab256cb
RM
1841DEFUN ("kill-all-local-variables", Fkill_all_local_variables, Skill_all_local_variables,
1842 0, 0, 0,
1843 "Switch to Fundamental mode by killing current buffer's local variables.\n\
1844Most local variable bindings are eliminated so that the default values\n\
1845become effective once more. Also, the syntax table is set from\n\
1846`standard-syntax-table', the local keymap is set to nil,\n\
1847and the abbrev table from `fundamental-mode-abbrev-table'.\n\
1848This function also forces redisplay of the mode line.\n\
1849\n\
1850Every function to select a new major mode starts by\n\
1851calling this function.\n\n\
1852As a special exception, local variables whose names have\n\
c5a15222
RS
1853a non-nil `permanent-local' property are not eliminated by this function.\n\
1854\n\
1855The first thing this function does is run\n\
1856the normal hook `change-major-mode-hook'.")
1ab256cb
RM
1857 ()
1858{
1859 register Lisp_Object alist, sym, tem;
1860 Lisp_Object oalist;
7410477a 1861
fd186f07
RS
1862 if (!NILP (Vrun_hooks))
1863 call1 (Vrun_hooks, intern ("change-major-mode-hook"));
1ab256cb
RM
1864 oalist = current_buffer->local_var_alist;
1865
2f3f993b
RS
1866 /* Make sure none of the bindings in oalist
1867 remain swapped in, in their symbols. */
1ab256cb 1868
2f3f993b 1869 swap_out_buffer_local_variables (current_buffer);
1ab256cb
RM
1870
1871 /* Actually eliminate all local bindings of this buffer. */
1872
13de9290 1873 reset_buffer_local_variables (current_buffer, 0);
1ab256cb
RM
1874
1875 /* Redisplay mode lines; we are changing major mode. */
1876
1877 update_mode_lines++;
1878
1879 /* Any which are supposed to be permanent,
1880 make local again, with the same values they had. */
1881
265a9e55 1882 for (alist = oalist; !NILP (alist); alist = XCONS (alist)->cdr)
1ab256cb
RM
1883 {
1884 sym = XCONS (XCONS (alist)->car)->car;
1885 tem = Fget (sym, Qpermanent_local);
265a9e55 1886 if (! NILP (tem))
01050cb5
RM
1887 {
1888 Fmake_local_variable (sym);
1889 Fset (sym, XCONS (XCONS (alist)->car)->cdr);
1890 }
1ab256cb
RM
1891 }
1892
1893 /* Force mode-line redisplay. Useful here because all major mode
1894 commands call this function. */
1895 update_mode_lines++;
1896
1897 return Qnil;
1898}
2f3f993b
RS
1899
1900/* Make sure no local variables remain set up with buffer B
1901 for their current values. */
1902
1903static void
1904swap_out_buffer_local_variables (b)
1905 struct buffer *b;
1906{
1907 Lisp_Object oalist, alist, sym, tem, buffer;
1908
1909 XSETBUFFER (buffer, b);
1910 oalist = b->local_var_alist;
1911
1912 for (alist = oalist; !NILP (alist); alist = XCONS (alist)->cdr)
1913 {
1914 sym = XCONS (XCONS (alist)->car)->car;
1915
1916 /* Need not do anything if some other buffer's binding is now encached. */
3d871c85 1917 tem = XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->buffer;
2f3f993b
RS
1918 if (XBUFFER (tem) == current_buffer)
1919 {
1920 /* Symbol is set up for this buffer's old local value.
1921 Set it up for the current buffer with the default value. */
1922
3d871c85 1923 tem = XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->cdr;
2f3f993b
RS
1924 /* Store the symbol's current value into the alist entry
1925 it is currently set up for. This is so that, if the
1926 local is marked permanent, and we make it local again
1927 later in Fkill_all_local_variables, we don't lose the value. */
1928 XCONS (XCONS (tem)->car)->cdr
3d871c85 1929 = do_symval_forwarding (XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->realvalue);
2f3f993b
RS
1930 /* Switch to the symbol's default-value alist entry. */
1931 XCONS (tem)->car = tem;
1932 /* Mark it as current for buffer B. */
3d871c85 1933 XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->buffer = buffer;
2f3f993b 1934 /* Store the current value into any forwarding in the symbol. */
3d871c85
RS
1935 store_symval_forwarding (sym,
1936 XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->realvalue,
2f3f993b
RS
1937 XCONS (tem)->cdr);
1938 }
1939 }
1940}
1ab256cb 1941\f
2eec3b4e
RS
1942/* Find all the overlays in the current buffer that contain position POS.
1943 Return the number found, and store them in a vector in *VEC_PTR.
1944 Store in *LEN_PTR the size allocated for the vector.
52f8ec73
JB
1945 Store in *NEXT_PTR the next position after POS where an overlay starts,
1946 or ZV if there are no more overlays.
bbbe9545 1947 Store in *PREV_PTR the previous position before POS where an overlay ends,
239c932b
RS
1948 or BEGV if there are no previous overlays.
1949 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
2eec3b4e
RS
1950
1951 *VEC_PTR and *LEN_PTR should contain a valid vector and size
61d54cd5
RS
1952 when this function is called.
1953
1954 If EXTEND is non-zero, we make the vector bigger if necessary.
1955 If EXTEND is zero, we never extend the vector,
1956 and we store only as many overlays as will fit.
1957 But we still return the total number of overlays. */
2eec3b4e
RS
1958
1959int
239c932b 1960overlays_at (pos, extend, vec_ptr, len_ptr, next_ptr, prev_ptr)
2eec3b4e 1961 int pos;
61d54cd5 1962 int extend;
2eec3b4e
RS
1963 Lisp_Object **vec_ptr;
1964 int *len_ptr;
1965 int *next_ptr;
239c932b 1966 int *prev_ptr;
1ab256cb 1967{
2eec3b4e
RS
1968 Lisp_Object tail, overlay, start, end, result;
1969 int idx = 0;
1970 int len = *len_ptr;
1971 Lisp_Object *vec = *vec_ptr;
1972 int next = ZV;
239c932b 1973 int prev = BEGV;
61d54cd5
RS
1974 int inhibit_storing = 0;
1975
2eec3b4e 1976 for (tail = current_buffer->overlays_before;
8fc0589a 1977 GC_CONSP (tail);
2eec3b4e
RS
1978 tail = XCONS (tail)->cdr)
1979 {
239c932b 1980 int startpos, endpos;
52f8ec73 1981
2eec3b4e 1982 overlay = XCONS (tail)->car;
1ab256cb 1983
2eec3b4e
RS
1984 start = OVERLAY_START (overlay);
1985 end = OVERLAY_END (overlay);
239c932b
RS
1986 endpos = OVERLAY_POSITION (end);
1987 if (endpos < pos)
1988 {
1989 if (prev < endpos)
1990 prev = endpos;
1991 break;
1992 }
1993 if (endpos == pos)
1994 continue;
2eec3b4e
RS
1995 startpos = OVERLAY_POSITION (start);
1996 if (startpos <= pos)
1997 {
1998 if (idx == len)
1999 {
61d54cd5
RS
2000 /* The supplied vector is full.
2001 Either make it bigger, or don't store any more in it. */
2002 if (extend)
2003 {
2004 *len_ptr = len *= 2;
2005 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2006 *vec_ptr = vec;
2007 }
2008 else
2009 inhibit_storing = 1;
2eec3b4e 2010 }
61d54cd5
RS
2011
2012 if (!inhibit_storing)
2013 vec[idx] = overlay;
2014 /* Keep counting overlays even if we can't return them all. */
2015 idx++;
2eec3b4e
RS
2016 }
2017 else if (startpos < next)
2018 next = startpos;
2019 }
2020
2021 for (tail = current_buffer->overlays_after;
8fc0589a 2022 GC_CONSP (tail);
2eec3b4e 2023 tail = XCONS (tail)->cdr)
1ab256cb 2024 {
239c932b 2025 int startpos, endpos;
52f8ec73 2026
2eec3b4e 2027 overlay = XCONS (tail)->car;
2eec3b4e
RS
2028
2029 start = OVERLAY_START (overlay);
2030 end = OVERLAY_END (overlay);
2031 startpos = OVERLAY_POSITION (start);
52f8ec73 2032 if (pos < startpos)
2eec3b4e
RS
2033 {
2034 if (startpos < next)
2035 next = startpos;
2036 break;
2037 }
239c932b
RS
2038 endpos = OVERLAY_POSITION (end);
2039 if (pos < endpos)
2eec3b4e
RS
2040 {
2041 if (idx == len)
2042 {
61d54cd5
RS
2043 if (extend)
2044 {
2045 *len_ptr = len *= 2;
2046 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2047 *vec_ptr = vec;
2048 }
2049 else
2050 inhibit_storing = 1;
2eec3b4e 2051 }
61d54cd5
RS
2052
2053 if (!inhibit_storing)
2054 vec[idx] = overlay;
2055 idx++;
2eec3b4e 2056 }
239c932b
RS
2057 else if (endpos < pos && endpos > prev)
2058 prev = endpos;
1ab256cb
RM
2059 }
2060
239c932b
RS
2061 if (next_ptr)
2062 *next_ptr = next;
2063 if (prev_ptr)
2064 *prev_ptr = prev;
2eec3b4e
RS
2065 return idx;
2066}
74514898
RS
2067\f
2068/* Find all the overlays in the current buffer that overlap the range BEG-END
2a3eeee7
RS
2069 or are empty at BEG.
2070
74514898
RS
2071 Return the number found, and store them in a vector in *VEC_PTR.
2072 Store in *LEN_PTR the size allocated for the vector.
2073 Store in *NEXT_PTR the next position after POS where an overlay starts,
2074 or ZV if there are no more overlays.
2075 Store in *PREV_PTR the previous position before POS where an overlay ends,
2076 or BEGV if there are no previous overlays.
2077 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
2078
2079 *VEC_PTR and *LEN_PTR should contain a valid vector and size
2080 when this function is called.
2081
2082 If EXTEND is non-zero, we make the vector bigger if necessary.
2083 If EXTEND is zero, we never extend the vector,
2084 and we store only as many overlays as will fit.
2085 But we still return the total number of overlays. */
2086
2087int
2088overlays_in (beg, end, extend, vec_ptr, len_ptr, next_ptr, prev_ptr)
2089 int beg, end;
2090 int extend;
2091 Lisp_Object **vec_ptr;
2092 int *len_ptr;
2093 int *next_ptr;
2094 int *prev_ptr;
2095{
2096 Lisp_Object tail, overlay, ostart, oend, result;
2097 int idx = 0;
2098 int len = *len_ptr;
2099 Lisp_Object *vec = *vec_ptr;
2100 int next = ZV;
2101 int prev = BEGV;
2102 int inhibit_storing = 0;
2103
2104 for (tail = current_buffer->overlays_before;
2105 GC_CONSP (tail);
2106 tail = XCONS (tail)->cdr)
2107 {
2108 int startpos, endpos;
2109
2110 overlay = XCONS (tail)->car;
2111
2112 ostart = OVERLAY_START (overlay);
2113 oend = OVERLAY_END (overlay);
2114 endpos = OVERLAY_POSITION (oend);
2115 if (endpos < beg)
2116 {
2117 if (prev < endpos)
2118 prev = endpos;
2119 break;
2120 }
2121 startpos = OVERLAY_POSITION (ostart);
2122 /* Count an interval if it either overlaps the range
2a3eeee7 2123 or is empty at the start of the range. */
74514898 2124 if ((beg < endpos && startpos < end)
2a3eeee7 2125 || (startpos == endpos && beg == endpos))
74514898
RS
2126 {
2127 if (idx == len)
2128 {
2129 /* The supplied vector is full.
2130 Either make it bigger, or don't store any more in it. */
2131 if (extend)
2132 {
2133 *len_ptr = len *= 2;
2134 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2135 *vec_ptr = vec;
2136 }
2137 else
2138 inhibit_storing = 1;
2139 }
2140
2141 if (!inhibit_storing)
2142 vec[idx] = overlay;
2143 /* Keep counting overlays even if we can't return them all. */
2144 idx++;
2145 }
2146 else if (startpos < next)
2147 next = startpos;
2148 }
2149
2150 for (tail = current_buffer->overlays_after;
2151 GC_CONSP (tail);
2152 tail = XCONS (tail)->cdr)
2153 {
2154 int startpos, endpos;
2155
2156 overlay = XCONS (tail)->car;
2157
2158 ostart = OVERLAY_START (overlay);
2159 oend = OVERLAY_END (overlay);
2160 startpos = OVERLAY_POSITION (ostart);
2161 if (end < startpos)
2162 {
2163 if (startpos < next)
2164 next = startpos;
2165 break;
2166 }
2167 endpos = OVERLAY_POSITION (oend);
2a3eeee7
RS
2168 /* Count an interval if it either overlaps the range
2169 or is empty at the start of the range. */
74514898 2170 if ((beg < endpos && startpos < end)
2a3eeee7 2171 || (startpos == endpos && beg == endpos))
74514898
RS
2172 {
2173 if (idx == len)
2174 {
2175 if (extend)
2176 {
2177 *len_ptr = len *= 2;
2178 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
2179 *vec_ptr = vec;
2180 }
2181 else
2182 inhibit_storing = 1;
2183 }
2184
2185 if (!inhibit_storing)
2186 vec[idx] = overlay;
2187 idx++;
2188 }
2189 else if (endpos < beg && endpos > prev)
2190 prev = endpos;
2191 }
fc04fa47 2192
74514898
RS
2193 if (next_ptr)
2194 *next_ptr = next;
2195 if (prev_ptr)
2196 *prev_ptr = prev;
2197 return idx;
2198}
2199\f
fc04fa47
KH
2200/* Fast function to just test if we're at an overlay boundary. */
2201int
2202overlay_touches_p (pos)
2203 int pos;
2204{
2205 Lisp_Object tail, overlay;
2206
2207 for (tail = current_buffer->overlays_before; GC_CONSP (tail);
2208 tail = XCONS (tail)->cdr)
2209 {
2210 int endpos;
2211
2212 overlay = XCONS (tail)->car;
2213 if (!GC_OVERLAYP (overlay))
2214 abort ();
2215
2216 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2217 if (endpos < pos)
2218 break;
2219 if (endpos == pos || OVERLAY_POSITION (OVERLAY_START (overlay)) == pos)
2220 return 1;
2221 }
2222
2223 for (tail = current_buffer->overlays_after; GC_CONSP (tail);
2224 tail = XCONS (tail)->cdr)
2225 {
2226 int startpos;
2227
2228 overlay = XCONS (tail)->car;
2229 if (!GC_OVERLAYP (overlay))
2230 abort ();
2231
2232 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2233 if (pos < startpos)
2234 break;
2235 if (startpos == pos || OVERLAY_POSITION (OVERLAY_END (overlay)) == pos)
2236 return 1;
2237 }
2238 return 0;
2239}
2eec3b4e 2240\f
5985d248
KH
2241struct sortvec
2242{
2243 Lisp_Object overlay;
2244 int beg, end;
2245 int priority;
2246};
2247
2248static int
dfcf069d
AS
2249compare_overlays (v1, v2)
2250 const void *v1, *v2;
5985d248 2251{
dfcf069d
AS
2252 const struct sortvec *s1 = (const struct sortvec *) v1;
2253 const struct sortvec *s2 = (const struct sortvec *) v2;
5985d248
KH
2254 if (s1->priority != s2->priority)
2255 return s1->priority - s2->priority;
2256 if (s1->beg != s2->beg)
2257 return s1->beg - s2->beg;
2258 if (s1->end != s2->end)
2259 return s2->end - s1->end;
2260 return 0;
2261}
2262
2263/* Sort an array of overlays by priority. The array is modified in place.
2264 The return value is the new size; this may be smaller than the original
2265 size if some of the overlays were invalid or were window-specific. */
2266int
2267sort_overlays (overlay_vec, noverlays, w)
2268 Lisp_Object *overlay_vec;
2269 int noverlays;
2270 struct window *w;
2271{
2272 int i, j;
2273 struct sortvec *sortvec;
2274 sortvec = (struct sortvec *) alloca (noverlays * sizeof (struct sortvec));
2275
2276 /* Put the valid and relevant overlays into sortvec. */
2277
2278 for (i = 0, j = 0; i < noverlays; i++)
2279 {
0fa767e7 2280 Lisp_Object tem;
c99fc30f 2281 Lisp_Object overlay;
5985d248 2282
c99fc30f 2283 overlay = overlay_vec[i];
5985d248
KH
2284 if (OVERLAY_VALID (overlay)
2285 && OVERLAY_POSITION (OVERLAY_START (overlay)) > 0
2286 && OVERLAY_POSITION (OVERLAY_END (overlay)) > 0)
2287 {
0fa767e7
KH
2288 /* If we're interested in a specific window, then ignore
2289 overlays that are limited to some other window. */
2290 if (w)
5985d248 2291 {
0fa767e7
KH
2292 Lisp_Object window;
2293
2294 window = Foverlay_get (overlay, Qwindow);
a7a60ce9 2295 if (WINDOWP (window) && XWINDOW (window) != w)
0fa767e7 2296 continue;
5985d248 2297 }
0fa767e7
KH
2298
2299 /* This overlay is good and counts: put it into sortvec. */
2300 sortvec[j].overlay = overlay;
2301 sortvec[j].beg = OVERLAY_POSITION (OVERLAY_START (overlay));
2302 sortvec[j].end = OVERLAY_POSITION (OVERLAY_END (overlay));
2303 tem = Foverlay_get (overlay, Qpriority);
2304 if (INTEGERP (tem))
2305 sortvec[j].priority = XINT (tem);
2306 else
2307 sortvec[j].priority = 0;
2308 j++;
5985d248
KH
2309 }
2310 }
2311 noverlays = j;
2312
2313 /* Sort the overlays into the proper order: increasing priority. */
2314
2315 if (noverlays > 1)
2316 qsort (sortvec, noverlays, sizeof (struct sortvec), compare_overlays);
2317
2318 for (i = 0; i < noverlays; i++)
2319 overlay_vec[i] = sortvec[i].overlay;
2320 return (noverlays);
2321}
2322\f
bbbe9545
KH
2323struct sortstr
2324{
cb26008f 2325 Lisp_Object string, string2;
bbbe9545
KH
2326 int size;
2327 int priority;
2328};
2329
e8185fa8
KH
2330struct sortstrlist
2331{
2332 struct sortstr *buf; /* An array that expands as needed; never freed. */
2333 int size; /* Allocated length of that array. */
2334 int used; /* How much of the array is currently in use. */
2335 int bytes; /* Total length of the strings in buf. */
2336};
2337
2338/* Buffers for storing information about the overlays touching a given
2339 position. These could be automatic variables in overlay_strings, but
2340 it's more efficient to hold onto the memory instead of repeatedly
2341 allocating and freeing it. */
2342static struct sortstrlist overlay_heads, overlay_tails;
9492daf2 2343static unsigned char *overlay_str_buf;
e8185fa8
KH
2344
2345/* Allocated length of overlay_str_buf. */
2346static int overlay_str_len;
2347
bbbe9545
KH
2348/* A comparison function suitable for passing to qsort. */
2349static int
2350cmp_for_strings (as1, as2)
2351 char *as1, *as2;
2352{
2353 struct sortstr *s1 = (struct sortstr *)as1;
2354 struct sortstr *s2 = (struct sortstr *)as2;
2355 if (s1->size != s2->size)
2356 return s2->size - s1->size;
2357 if (s1->priority != s2->priority)
2358 return s1->priority - s2->priority;
2359 return 0;
2360}
2361
e8185fa8 2362static void
cb26008f 2363record_overlay_string (ssl, str, str2, pri, size)
e8185fa8 2364 struct sortstrlist *ssl;
cb26008f 2365 Lisp_Object str, str2, pri;
e8185fa8
KH
2366 int size;
2367{
43d27a72
RS
2368 int nbytes;
2369
e8185fa8
KH
2370 if (ssl->used == ssl->size)
2371 {
2372 if (ssl->buf)
2373 ssl->size *= 2;
2374 else
2375 ssl->size = 5;
2376 ssl->buf = ((struct sortstr *)
2377 xrealloc (ssl->buf, ssl->size * sizeof (struct sortstr)));
2378 }
2379 ssl->buf[ssl->used].string = str;
cb26008f 2380 ssl->buf[ssl->used].string2 = str2;
e8185fa8
KH
2381 ssl->buf[ssl->used].size = size;
2382 ssl->buf[ssl->used].priority = (INTEGERP (pri) ? XINT (pri) : 0);
2383 ssl->used++;
43d27a72
RS
2384
2385 if (NILP (current_buffer->enable_multibyte_characters))
2386 nbytes = XSTRING (str)->size;
2387 else if (! STRING_MULTIBYTE (str))
2388 nbytes = count_size_as_multibyte (XSTRING (str)->data,
fc932ac6 2389 STRING_BYTES (XSTRING (str)));
43d27a72 2390 else
fc932ac6 2391 nbytes = STRING_BYTES (XSTRING (str));
43d27a72
RS
2392
2393 ssl->bytes += nbytes;
2394
cb26008f 2395 if (STRINGP (str2))
43d27a72
RS
2396 {
2397 if (NILP (current_buffer->enable_multibyte_characters))
2398 nbytes = XSTRING (str2)->size;
2399 else if (! STRING_MULTIBYTE (str2))
2400 nbytes = count_size_as_multibyte (XSTRING (str2)->data,
fc932ac6 2401 STRING_BYTES (XSTRING (str2)));
43d27a72 2402 else
fc932ac6 2403 nbytes = STRING_BYTES (XSTRING (str2));
43d27a72
RS
2404
2405 ssl->bytes += nbytes;
2406 }
e8185fa8 2407}
bbbe9545
KH
2408
2409/* Return the concatenation of the strings associated with overlays that
2410 begin or end at POS, ignoring overlays that are specific to a window
2411 other than W. The strings are concatenated in the appropriate order:
2412 shorter overlays nest inside longer ones, and higher priority inside
cb26008f
KH
2413 lower. Normally all of the after-strings come first, but zero-sized
2414 overlays have their after-strings ride along with the before-strings
2415 because it would look strange to print them inside-out.
2416
2417 Returns the string length, and stores the contents indirectly through
2418 PSTR, if that variable is non-null. The string may be overwritten by
2419 subsequent calls. */
6b5d3b89 2420
bbbe9545
KH
2421int
2422overlay_strings (pos, w, pstr)
2423 int pos;
2424 struct window *w;
6b5d3b89 2425 unsigned char **pstr;
bbbe9545 2426{
e8185fa8 2427 Lisp_Object ov, overlay, window, str;
bbbe9545 2428 int startpos, endpos;
43d27a72 2429 int multibyte = ! NILP (current_buffer->enable_multibyte_characters);
bbbe9545 2430
e8185fa8
KH
2431 overlay_heads.used = overlay_heads.bytes = 0;
2432 overlay_tails.used = overlay_tails.bytes = 0;
bbbe9545
KH
2433 for (ov = current_buffer->overlays_before; CONSP (ov); ov = XCONS (ov)->cdr)
2434 {
2435 overlay = XCONS (ov)->car;
2436 if (!OVERLAYP (overlay))
2437 abort ();
2438
2439 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2440 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2441 if (endpos < pos)
2442 break;
2443 if (endpos != pos && startpos != pos)
2444 continue;
2445 window = Foverlay_get (overlay, Qwindow);
2446 if (WINDOWP (window) && XWINDOW (window) != w)
2447 continue;
e8185fa8
KH
2448 if (startpos == pos
2449 && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
2450 record_overlay_string (&overlay_heads, str,
cb26008f
KH
2451 (startpos == endpos
2452 ? Foverlay_get (overlay, Qafter_string)
2453 : Qnil),
2454 Foverlay_get (overlay, Qpriority),
2455 endpos - startpos);
2456 else if (endpos == pos
2457 && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
2458 record_overlay_string (&overlay_tails, str, Qnil,
e8185fa8
KH
2459 Foverlay_get (overlay, Qpriority),
2460 endpos - startpos);
bbbe9545
KH
2461 }
2462 for (ov = current_buffer->overlays_after; CONSP (ov); ov = XCONS (ov)->cdr)
2463 {
2464 overlay = XCONS (ov)->car;
2465 if (!OVERLAYP (overlay))
2466 abort ();
2467
2468 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2469 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2470 if (startpos > pos)
2471 break;
e8185fa8
KH
2472 if (endpos != pos && startpos != pos)
2473 continue;
2474 window = Foverlay_get (overlay, Qwindow);
2475 if (WINDOWP (window) && XWINDOW (window) != w)
2476 continue;
e8185fa8
KH
2477 if (startpos == pos
2478 && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
2479 record_overlay_string (&overlay_heads, str,
cb26008f
KH
2480 (startpos == endpos
2481 ? Foverlay_get (overlay, Qafter_string)
2482 : Qnil),
2483 Foverlay_get (overlay, Qpriority),
2484 endpos - startpos);
2485 else if (endpos == pos
2486 && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
2487 record_overlay_string (&overlay_tails, str, Qnil,
e8185fa8
KH
2488 Foverlay_get (overlay, Qpriority),
2489 endpos - startpos);
bbbe9545 2490 }
e8185fa8
KH
2491 if (overlay_tails.used > 1)
2492 qsort (overlay_tails.buf, overlay_tails.used, sizeof (struct sortstr),
2493 cmp_for_strings);
2494 if (overlay_heads.used > 1)
2495 qsort (overlay_heads.buf, overlay_heads.used, sizeof (struct sortstr),
2496 cmp_for_strings);
2497 if (overlay_heads.bytes || overlay_tails.bytes)
bbbe9545 2498 {
e8185fa8 2499 Lisp_Object tem;
bbbe9545 2500 int i;
9f4d7cde 2501 unsigned char *p;
e8185fa8 2502 int total = overlay_heads.bytes + overlay_tails.bytes;
bbbe9545
KH
2503
2504 if (total > overlay_str_len)
9f4d7cde
RS
2505 {
2506 overlay_str_len = total;
2507 overlay_str_buf = (unsigned char *)xrealloc (overlay_str_buf,
2508 total);
2509 }
bbbe9545 2510 p = overlay_str_buf;
e8185fa8 2511 for (i = overlay_tails.used; --i >= 0;)
bbbe9545 2512 {
43d27a72 2513 int nbytes;
e8185fa8 2514 tem = overlay_tails.buf[i].string;
fc932ac6
RS
2515 nbytes = copy_text (XSTRING (tem)->data, p,
2516 STRING_BYTES (XSTRING (tem)),
43d27a72
RS
2517 STRING_MULTIBYTE (tem), multibyte);
2518 p += nbytes;
bbbe9545 2519 }
e8185fa8 2520 for (i = 0; i < overlay_heads.used; ++i)
bbbe9545 2521 {
43d27a72 2522 int nbytes;
e8185fa8 2523 tem = overlay_heads.buf[i].string;
fc932ac6
RS
2524 nbytes = copy_text (XSTRING (tem)->data, p,
2525 STRING_BYTES (XSTRING (tem)),
43d27a72
RS
2526 STRING_MULTIBYTE (tem), multibyte);
2527 p += nbytes;
cb26008f
KH
2528 tem = overlay_heads.buf[i].string2;
2529 if (STRINGP (tem))
2530 {
43d27a72 2531 nbytes = copy_text (XSTRING (tem)->data, p,
fc932ac6 2532 STRING_BYTES (XSTRING (tem)),
43d27a72
RS
2533 STRING_MULTIBYTE (tem), multibyte);
2534 p += nbytes;
cb26008f 2535 }
bbbe9545 2536 }
cb26008f
KH
2537 if (p != overlay_str_buf + total)
2538 abort ();
bbbe9545
KH
2539 if (pstr)
2540 *pstr = overlay_str_buf;
e8185fa8 2541 return total;
bbbe9545 2542 }
e8185fa8 2543 return 0;
bbbe9545
KH
2544}
2545\f
5c4f68f1 2546/* Shift overlays in BUF's overlay lists, to center the lists at POS. */
1ab256cb 2547
2eec3b4e 2548void
5c4f68f1
JB
2549recenter_overlay_lists (buf, pos)
2550 struct buffer *buf;
2eec3b4e
RS
2551 int pos;
2552{
2553 Lisp_Object overlay, tail, next, prev, beg, end;
2554
2555 /* See if anything in overlays_before should move to overlays_after. */
2556
2557 /* We don't strictly need prev in this loop; it should always be nil.
2558 But we use it for symmetry and in case that should cease to be true
2559 with some future change. */
2560 prev = Qnil;
5c4f68f1 2561 for (tail = buf->overlays_before;
2eec3b4e
RS
2562 CONSP (tail);
2563 prev = tail, tail = next)
1ab256cb 2564 {
2eec3b4e
RS
2565 next = XCONS (tail)->cdr;
2566 overlay = XCONS (tail)->car;
2567
2568 /* If the overlay is not valid, get rid of it. */
2569 if (!OVERLAY_VALID (overlay))
52f8ec73
JB
2570#if 1
2571 abort ();
2572#else
2eec3b4e
RS
2573 {
2574 /* Splice the cons cell TAIL out of overlays_before. */
2575 if (!NILP (prev))
2576 XCONS (prev)->cdr = next;
2577 else
5c4f68f1 2578 buf->overlays_before = next;
2eec3b4e
RS
2579 tail = prev;
2580 continue;
2581 }
52f8ec73 2582#endif
1ab256cb 2583
2eec3b4e
RS
2584 beg = OVERLAY_START (overlay);
2585 end = OVERLAY_END (overlay);
1ab256cb 2586
2eec3b4e 2587 if (OVERLAY_POSITION (end) > pos)
1ab256cb 2588 {
2eec3b4e
RS
2589 /* OVERLAY needs to be moved. */
2590 int where = OVERLAY_POSITION (beg);
2591 Lisp_Object other, other_prev;
2592
2593 /* Splice the cons cell TAIL out of overlays_before. */
2594 if (!NILP (prev))
2595 XCONS (prev)->cdr = next;
2596 else
5c4f68f1 2597 buf->overlays_before = next;
2eec3b4e
RS
2598
2599 /* Search thru overlays_after for where to put it. */
2600 other_prev = Qnil;
5c4f68f1 2601 for (other = buf->overlays_after;
2eec3b4e
RS
2602 CONSP (other);
2603 other_prev = other, other = XCONS (other)->cdr)
1ab256cb 2604 {
2eec3b4e
RS
2605 Lisp_Object otherbeg, otheroverlay, follower;
2606 int win;
2607
2608 otheroverlay = XCONS (other)->car;
2609 if (! OVERLAY_VALID (otheroverlay))
52f8ec73 2610 abort ();
2eec3b4e
RS
2611
2612 otherbeg = OVERLAY_START (otheroverlay);
2613 if (OVERLAY_POSITION (otherbeg) >= where)
2614 break;
1ab256cb 2615 }
2eec3b4e
RS
2616
2617 /* Add TAIL to overlays_after before OTHER. */
2618 XCONS (tail)->cdr = other;
2619 if (!NILP (other_prev))
2620 XCONS (other_prev)->cdr = tail;
1ab256cb 2621 else
5c4f68f1 2622 buf->overlays_after = tail;
2eec3b4e 2623 tail = prev;
1ab256cb 2624 }
2eec3b4e
RS
2625 else
2626 /* We've reached the things that should stay in overlays_before.
2627 All the rest of overlays_before must end even earlier,
2628 so stop now. */
2629 break;
2630 }
2631
2632 /* See if anything in overlays_after should be in overlays_before. */
2633 prev = Qnil;
5c4f68f1 2634 for (tail = buf->overlays_after;
2eec3b4e
RS
2635 CONSP (tail);
2636 prev = tail, tail = next)
2637 {
2638 next = XCONS (tail)->cdr;
2639 overlay = XCONS (tail)->car;
2640
2641 /* If the overlay is not valid, get rid of it. */
2642 if (!OVERLAY_VALID (overlay))
52f8ec73
JB
2643#if 1
2644 abort ();
2645#else
2eec3b4e
RS
2646 {
2647 /* Splice the cons cell TAIL out of overlays_after. */
2648 if (!NILP (prev))
2649 XCONS (prev)->cdr = next;
2650 else
5c4f68f1 2651 buf->overlays_after = next;
2eec3b4e
RS
2652 tail = prev;
2653 continue;
2654 }
52f8ec73 2655#endif
2eec3b4e
RS
2656
2657 beg = OVERLAY_START (overlay);
2658 end = OVERLAY_END (overlay);
2659
2660 /* Stop looking, when we know that nothing further
2661 can possibly end before POS. */
2662 if (OVERLAY_POSITION (beg) > pos)
2663 break;
2664
2665 if (OVERLAY_POSITION (end) <= pos)
2666 {
2667 /* OVERLAY needs to be moved. */
2668 int where = OVERLAY_POSITION (end);
2669 Lisp_Object other, other_prev;
2670
2671 /* Splice the cons cell TAIL out of overlays_after. */
2672 if (!NILP (prev))
2673 XCONS (prev)->cdr = next;
2674 else
5c4f68f1 2675 buf->overlays_after = next;
2eec3b4e
RS
2676
2677 /* Search thru overlays_before for where to put it. */
2678 other_prev = Qnil;
5c4f68f1 2679 for (other = buf->overlays_before;
2eec3b4e
RS
2680 CONSP (other);
2681 other_prev = other, other = XCONS (other)->cdr)
2682 {
2683 Lisp_Object otherend, otheroverlay;
2684 int win;
2685
2686 otheroverlay = XCONS (other)->car;
2687 if (! OVERLAY_VALID (otheroverlay))
52f8ec73 2688 abort ();
2eec3b4e
RS
2689
2690 otherend = OVERLAY_END (otheroverlay);
2691 if (OVERLAY_POSITION (otherend) <= where)
2692 break;
2693 }
2694
2695 /* Add TAIL to overlays_before before OTHER. */
2696 XCONS (tail)->cdr = other;
2697 if (!NILP (other_prev))
2698 XCONS (other_prev)->cdr = tail;
2699 else
5c4f68f1 2700 buf->overlays_before = tail;
2eec3b4e
RS
2701 tail = prev;
2702 }
2703 }
2704
8d7a4592 2705 XSETFASTINT (buf->overlay_center, pos);
2eec3b4e 2706}
2b1bdf65 2707
423cdb46
KH
2708void
2709adjust_overlays_for_insert (pos, length)
2710 int pos;
2711 int length;
2712{
2713 /* After an insertion, the lists are still sorted properly,
2714 but we may need to update the value of the overlay center. */
2715 if (XFASTINT (current_buffer->overlay_center) >= pos)
2716 XSETFASTINT (current_buffer->overlay_center,
2717 XFASTINT (current_buffer->overlay_center) + length);
2718}
2719
2720void
2721adjust_overlays_for_delete (pos, length)
2722 int pos;
2723 int length;
2724{
2725 if (XFASTINT (current_buffer->overlay_center) < pos)
2726 /* The deletion was to our right. No change needed; the before- and
2727 after-lists are still consistent. */
2728 ;
2729 else if (XFASTINT (current_buffer->overlay_center) > pos + length)
2730 /* The deletion was to our left. We need to adjust the center value
2731 to account for the change in position, but the lists are consistent
2732 given the new value. */
2733 XSETFASTINT (current_buffer->overlay_center,
2734 XFASTINT (current_buffer->overlay_center) - length);
2735 else
2736 /* We're right in the middle. There might be things on the after-list
2737 that now belong on the before-list. Recentering will move them,
2738 and also update the center point. */
2739 recenter_overlay_lists (current_buffer, pos);
2740}
2741
2b1bdf65
KH
2742/* Fix up overlays that were garbled as a result of permuting markers
2743 in the range START through END. Any overlay with at least one
2744 endpoint in this range will need to be unlinked from the overlay
2745 list and reinserted in its proper place.
2746 Such an overlay might even have negative size at this point.
2747 If so, we'll reverse the endpoints. Can you think of anything
2748 better to do in this situation? */
2749void
2750fix_overlays_in_range (start, end)
2751 register int start, end;
2752{
2753 Lisp_Object tem, overlay;
2754 Lisp_Object before_list, after_list;
2755 Lisp_Object *ptail, *pbefore = &before_list, *pafter = &after_list;
2756 int startpos, endpos;
2757
2758 /* This algorithm shifts links around instead of consing and GCing.
2759 The loop invariant is that before_list (resp. after_list) is a
2760 well-formed list except that its last element, the one that
2761 *pbefore (resp. *pafter) points to, is still uninitialized.
2762 So it's not a bug that before_list isn't initialized, although
2763 it may look strange. */
2764 for (ptail = &current_buffer->overlays_before; CONSP (*ptail);)
2765 {
2766 overlay = XCONS (*ptail)->car;
2767 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2768 if (endpos < start)
2769 break;
2770 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2771 if (endpos < end
2772 || (startpos >= start && startpos < end))
2773 {
2774 /* If the overlay is backwards, fix that now. */
2775 if (startpos > endpos)
2776 {
2777 int tem;
2c99f3ea
RS
2778 Fset_marker (OVERLAY_START (overlay), make_number (endpos),
2779 Qnil);
2780 Fset_marker (OVERLAY_END (overlay), make_number (startpos),
2781 Qnil);
2b1bdf65
KH
2782 tem = startpos; startpos = endpos; endpos = tem;
2783 }
2784 /* Add it to the end of the wrong list. Later on,
2785 recenter_overlay_lists will move it to the right place. */
2786 if (endpos < XINT (current_buffer->overlay_center))
2787 {
2788 *pafter = *ptail;
2789 pafter = &XCONS (*ptail)->cdr;
2790 }
2791 else
2792 {
2793 *pbefore = *ptail;
2794 pbefore = &XCONS (*ptail)->cdr;
2795 }
2796 *ptail = XCONS (*ptail)->cdr;
2797 }
2798 else
2799 ptail = &XCONS (*ptail)->cdr;
2800 }
2801 for (ptail = &current_buffer->overlays_after; CONSP (*ptail);)
2802 {
2803 overlay = XCONS (*ptail)->car;
2804 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2805 if (startpos >= end)
2806 break;
2807 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2808 if (startpos >= start
2809 || (endpos >= start && endpos < end))
2810 {
2811 if (startpos > endpos)
2812 {
2813 int tem;
2c99f3ea
RS
2814 Fset_marker (OVERLAY_START (overlay), make_number (endpos),
2815 Qnil);
2816 Fset_marker (OVERLAY_END (overlay), make_number (startpos),
2817 Qnil);
2b1bdf65
KH
2818 tem = startpos; startpos = endpos; endpos = tem;
2819 }
2820 if (endpos < XINT (current_buffer->overlay_center))
2821 {
2822 *pafter = *ptail;
2823 pafter = &XCONS (*ptail)->cdr;
2824 }
2825 else
2826 {
2827 *pbefore = *ptail;
2828 pbefore = &XCONS (*ptail)->cdr;
2829 }
2830 *ptail = XCONS (*ptail)->cdr;
2831 }
2832 else
2833 ptail = &XCONS (*ptail)->cdr;
2834 }
2835
2836 /* Splice the constructed (wrong) lists into the buffer's lists,
2837 and let the recenter function make it sane again. */
2838 *pbefore = current_buffer->overlays_before;
2839 current_buffer->overlays_before = before_list;
2840 recenter_overlay_lists (current_buffer,
2841 XINT (current_buffer->overlay_center));
2842
2843 *pafter = current_buffer->overlays_after;
2844 current_buffer->overlays_after = after_list;
2845 recenter_overlay_lists (current_buffer,
2846 XINT (current_buffer->overlay_center));
2847}
3b06f880
KH
2848
2849/* We have two types of overlay: the one whose ending marker is
2850 after-insertion-marker (this is the usual case) and the one whose
2851 ending marker is before-insertion-marker. When `overlays_before'
2852 contains overlays of the latter type and the former type in this
2853 order and both overlays end at inserting position, inserting a text
2854 increases only the ending marker of the latter type, which results
2855 in incorrect ordering of `overlays_before'.
2856
2857 This function fixes ordering of overlays in the slot
2858 `overlays_before' of the buffer *BP. Before the insertion, `point'
2859 was at PREV, and now is at POS. */
2860
01136e9b 2861void
3b06f880
KH
2862fix_overlays_before (bp, prev, pos)
2863 struct buffer *bp;
2864 int prev, pos;
2865{
2866 Lisp_Object *tailp = &bp->overlays_before;
2867 Lisp_Object *right_place;
2868 int end;
2869
2870 /* After the insertion, the several overlays may be in incorrect
2871 order. The possibility is that, in the list `overlays_before',
2872 an overlay which ends at POS appears after an overlay which ends
2873 at PREV. Since POS is greater than PREV, we must fix the
2874 ordering of these overlays, by moving overlays ends at POS before
2875 the overlays ends at PREV. */
2876
2877 /* At first, find a place where disordered overlays should be linked
2878 in. It is where an overlay which end before POS exists. (i.e. an
2879 overlay whose ending marker is after-insertion-marker if disorder
2880 exists). */
2881 while (!NILP (*tailp)
2882 && ((end = OVERLAY_POSITION (OVERLAY_END (XCONS (*tailp)->car)))
2883 >= pos))
2884 tailp = &XCONS (*tailp)->cdr;
2885
2886 /* If we don't find such an overlay,
2887 or the found one ends before PREV,
2888 or the found one is the last one in the list,
2889 we don't have to fix anything. */
2890 if (NILP (*tailp)
2891 || end < prev
2892 || NILP (XCONS (*tailp)->cdr))
2893 return;
2894
2895 right_place = tailp;
2896 tailp = &XCONS (*tailp)->cdr;
2897
2898 /* Now, end position of overlays in the list *TAILP should be before
2899 or equal to PREV. In the loop, an overlay which ends at POS is
2900 moved ahead to the place pointed by RIGHT_PLACE. If we found an
2901 overlay which ends before PREV, the remaining overlays are in
2902 correct order. */
2903 while (!NILP (*tailp))
2904 {
2905 end = OVERLAY_POSITION (OVERLAY_END (XCONS (*tailp)->car));
2906
2907 if (end == pos)
2908 { /* This overlay is disordered. */
2909 Lisp_Object found = *tailp;
2910
2911 /* Unlink the found overlay. */
2912 *tailp = XCONS (found)->cdr;
2913 /* Move an overlay at RIGHT_PLACE to the next of the found one. */
2914 XCONS (found)->cdr = *right_place;
2915 /* Link it into the right place. */
2916 *right_place = found;
2917 }
2918 else if (end == prev)
2919 tailp = &XCONS (*tailp)->cdr;
2920 else /* No more disordered overlay. */
2921 break;
2922 }
2923}
2eec3b4e 2924\f
52f8ec73
JB
2925DEFUN ("overlayp", Foverlayp, Soverlayp, 1, 1, 0,
2926 "Return t if OBJECT is an overlay.")
2927 (object)
2928 Lisp_Object object;
2929{
2930 return (OVERLAYP (object) ? Qt : Qnil);
2931}
2932
acac2700 2933DEFUN ("make-overlay", Fmake_overlay, Smake_overlay, 2, 5, 0,
5c4f68f1
JB
2934 "Create a new overlay with range BEG to END in BUFFER.\n\
2935If omitted, BUFFER defaults to the current buffer.\n\
acac2700
RS
2936BEG and END may be integers or markers.\n\
2937The fourth arg FRONT-ADVANCE, if non-nil, makes the\n\
2938front delimiter advance when text is inserted there.\n\
2939The fifth arg REAR-ADVANCE, if non-nil, makes the\n\
2940rear delimiter advance when text is inserted there.")
2941 (beg, end, buffer, front_advance, rear_advance)
5c4f68f1 2942 Lisp_Object beg, end, buffer;
acac2700 2943 Lisp_Object front_advance, rear_advance;
2eec3b4e
RS
2944{
2945 Lisp_Object overlay;
5c4f68f1 2946 struct buffer *b;
2eec3b4e 2947
5c4f68f1 2948 if (NILP (buffer))
67180c6a 2949 XSETBUFFER (buffer, current_buffer);
883047b9
JB
2950 else
2951 CHECK_BUFFER (buffer, 2);
2952 if (MARKERP (beg)
2953 && ! EQ (Fmarker_buffer (beg), buffer))
2954 error ("Marker points into wrong buffer");
2955 if (MARKERP (end)
2956 && ! EQ (Fmarker_buffer (end), buffer))
2957 error ("Marker points into wrong buffer");
2eec3b4e 2958
883047b9
JB
2959 CHECK_NUMBER_COERCE_MARKER (beg, 1);
2960 CHECK_NUMBER_COERCE_MARKER (end, 1);
5c4f68f1 2961
883047b9 2962 if (XINT (beg) > XINT (end))
5c4f68f1 2963 {
c99fc30f
KH
2964 Lisp_Object temp;
2965 temp = beg; beg = end; end = temp;
5c4f68f1 2966 }
883047b9
JB
2967
2968 b = XBUFFER (buffer);
2969
2970 beg = Fset_marker (Fmake_marker (), beg, buffer);
2971 end = Fset_marker (Fmake_marker (), end, buffer);
5c4f68f1 2972
acac2700
RS
2973 if (!NILP (front_advance))
2974 XMARKER (beg)->insertion_type = 1;
2975 if (!NILP (rear_advance))
2976 XMARKER (end)->insertion_type = 1;
597dd755 2977
48e2e3ba 2978 overlay = allocate_misc ();
89ca3e1b 2979 XMISCTYPE (overlay) = Lisp_Misc_Overlay;
48e2e3ba
KH
2980 XOVERLAY (overlay)->start = beg;
2981 XOVERLAY (overlay)->end = end;
2982 XOVERLAY (overlay)->plist = Qnil;
2eec3b4e
RS
2983
2984 /* Put the new overlay on the wrong list. */
2985 end = OVERLAY_END (overlay);
5c4f68f1
JB
2986 if (OVERLAY_POSITION (end) < XINT (b->overlay_center))
2987 b->overlays_after = Fcons (overlay, b->overlays_after);
2eec3b4e 2988 else
5c4f68f1 2989 b->overlays_before = Fcons (overlay, b->overlays_before);
2eec3b4e
RS
2990
2991 /* This puts it in the right list, and in the right order. */
5c4f68f1 2992 recenter_overlay_lists (b, XINT (b->overlay_center));
2eec3b4e 2993
b61982dd
JB
2994 /* We don't need to redisplay the region covered by the overlay, because
2995 the overlay has no properties at the moment. */
2996
2eec3b4e
RS
2997 return overlay;
2998}
876aa27c
RS
2999\f
3000/* Mark a section of BUF as needing redisplay because of overlays changes. */
3001
3002static void
3003modify_overlay (buf, start, end)
3004 struct buffer *buf;
3005 int start, end;
3006{
3007 if (start == end)
3008 return;
3009
3010 if (start > end)
3011 {
3012 int temp = start;
3013 start = end; end = temp;
3014 }
3015
3016 /* If this is a buffer not in the selected window,
3017 we must do other windows. */
3018 if (buf != XBUFFER (XWINDOW (selected_window)->buffer))
3019 windows_or_buffers_changed = 1;
3020 /* If it's not current, we can't use beg_unchanged, end_unchanged for it. */
3021 else if (buf != current_buffer)
3022 windows_or_buffers_changed = 1;
3023 /* If multiple windows show this buffer, we must do other windows. */
3024 else if (buffer_shared > 1)
3025 windows_or_buffers_changed = 1;
3026 else
3027 {
3028 if (unchanged_modified == MODIFF
3029 && overlay_unchanged_modified == OVERLAY_MODIFF)
3030 {
3031 beg_unchanged = start - BEG;
3032 end_unchanged = Z - end;
3033 }
3034 else
3035 {
3036 if (Z - end < end_unchanged)
3037 end_unchanged = Z - end;
3038 if (start - BEG < beg_unchanged)
3039 beg_unchanged = start - BEG;
3040 }
3041 }
3042
d8b9150f 3043 ++BUF_OVERLAY_MODIFF (buf);
876aa27c 3044}
2eec3b4e 3045
876aa27c 3046\f\f
2e34157c
RS
3047Lisp_Object Fdelete_overlay ();
3048
5c4f68f1
JB
3049DEFUN ("move-overlay", Fmove_overlay, Smove_overlay, 3, 4, 0,
3050 "Set the endpoints of OVERLAY to BEG and END in BUFFER.\n\
3ece337a
JB
3051If BUFFER is omitted, leave OVERLAY in the same buffer it inhabits now.\n\
3052If BUFFER is omitted, and OVERLAY is in no buffer, put it in the current\n\
3053buffer.")
5c4f68f1
JB
3054 (overlay, beg, end, buffer)
3055 Lisp_Object overlay, beg, end, buffer;
2eec3b4e 3056{
0a4469c9
RS
3057 struct buffer *b, *ob;
3058 Lisp_Object obuffer;
3059 int count = specpdl_ptr - specpdl;
5c4f68f1 3060
52f8ec73 3061 CHECK_OVERLAY (overlay, 0);
5c4f68f1
JB
3062 if (NILP (buffer))
3063 buffer = Fmarker_buffer (OVERLAY_START (overlay));
3ece337a 3064 if (NILP (buffer))
67180c6a 3065 XSETBUFFER (buffer, current_buffer);
5c4f68f1 3066 CHECK_BUFFER (buffer, 3);
883047b9
JB
3067
3068 if (MARKERP (beg)
3069 && ! EQ (Fmarker_buffer (beg), buffer))
3070 error ("Marker points into wrong buffer");
3071 if (MARKERP (end)
3072 && ! EQ (Fmarker_buffer (end), buffer))
3073 error ("Marker points into wrong buffer");
3074
b61982dd
JB
3075 CHECK_NUMBER_COERCE_MARKER (beg, 1);
3076 CHECK_NUMBER_COERCE_MARKER (end, 1);
3077
9d7608b7
KH
3078 if (XINT (beg) == XINT (end) && ! NILP (Foverlay_get (overlay, Qevaporate)))
3079 return Fdelete_overlay (overlay);
0a4469c9 3080
b61982dd
JB
3081 if (XINT (beg) > XINT (end))
3082 {
c99fc30f
KH
3083 Lisp_Object temp;
3084 temp = beg; beg = end; end = temp;
b61982dd
JB
3085 }
3086
9d7608b7
KH
3087 specbind (Qinhibit_quit, Qt);
3088
0a4469c9 3089 obuffer = Fmarker_buffer (OVERLAY_START (overlay));
5c4f68f1 3090 b = XBUFFER (buffer);
0a4469c9 3091 ob = XBUFFER (obuffer);
2eec3b4e 3092
c82ed728 3093 /* If the overlay has changed buffers, do a thorough redisplay. */
0a4469c9 3094 if (!EQ (buffer, obuffer))
50760c4a
RS
3095 {
3096 /* Redisplay where the overlay was. */
3097 if (!NILP (obuffer))
3098 {
2e34157c
RS
3099 int o_beg;
3100 int o_end;
50760c4a 3101
80509f2f
RS
3102 o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
3103 o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
50760c4a 3104
2e34157c 3105 modify_overlay (ob, o_beg, o_end);
50760c4a
RS
3106 }
3107
3108 /* Redisplay where the overlay is going to be. */
876aa27c 3109 modify_overlay (b, XINT (beg), XINT (end));
50760c4a 3110 }
c82ed728
JB
3111 else
3112 /* Redisplay the area the overlay has just left, or just enclosed. */
3113 {
2e34157c 3114 int o_beg, o_end;
c82ed728
JB
3115 int change_beg, change_end;
3116
80509f2f
RS
3117 o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
3118 o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
c82ed728 3119
2e34157c
RS
3120 if (o_beg == XINT (beg))
3121 modify_overlay (b, o_end, XINT (end));
3122 else if (o_end == XINT (end))
3123 modify_overlay (b, o_beg, XINT (beg));
c82ed728
JB
3124 else
3125 {
2e34157c
RS
3126 if (XINT (beg) < o_beg) o_beg = XINT (beg);
3127 if (XINT (end) > o_end) o_end = XINT (end);
3128 modify_overlay (b, o_beg, o_end);
c82ed728
JB
3129 }
3130 }
b61982dd 3131
0a4469c9
RS
3132 if (!NILP (obuffer))
3133 {
3134 ob->overlays_before = Fdelq (overlay, ob->overlays_before);
3135 ob->overlays_after = Fdelq (overlay, ob->overlays_after);
3136 }
5c4f68f1
JB
3137
3138 Fset_marker (OVERLAY_START (overlay), beg, buffer);
3139 Fset_marker (OVERLAY_END (overlay), end, buffer);
2eec3b4e
RS
3140
3141 /* Put the overlay on the wrong list. */
3142 end = OVERLAY_END (overlay);
5c4f68f1
JB
3143 if (OVERLAY_POSITION (end) < XINT (b->overlay_center))
3144 b->overlays_after = Fcons (overlay, b->overlays_after);
2eec3b4e 3145 else
5c4f68f1 3146 b->overlays_before = Fcons (overlay, b->overlays_before);
2eec3b4e
RS
3147
3148 /* This puts it in the right list, and in the right order. */
5c4f68f1 3149 recenter_overlay_lists (b, XINT (b->overlay_center));
2eec3b4e 3150
0a4469c9 3151 return unbind_to (count, overlay);
2eec3b4e
RS
3152}
3153
3154DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0,
5c4f68f1 3155 "Delete the overlay OVERLAY from its buffer.")
2eec3b4e 3156 (overlay)
5c4f68f1 3157 Lisp_Object overlay;
2eec3b4e 3158{
0a4469c9 3159 Lisp_Object buffer;
5c4f68f1 3160 struct buffer *b;
0a4469c9 3161 int count = specpdl_ptr - specpdl;
5c4f68f1 3162
52f8ec73
JB
3163 CHECK_OVERLAY (overlay, 0);
3164
0a4469c9
RS
3165 buffer = Fmarker_buffer (OVERLAY_START (overlay));
3166 if (NILP (buffer))
3167 return Qnil;
3168
3169 b = XBUFFER (buffer);
3170
3171 specbind (Qinhibit_quit, Qt);
5c4f68f1
JB
3172
3173 b->overlays_before = Fdelq (overlay, b->overlays_before);
3174 b->overlays_after = Fdelq (overlay, b->overlays_after);
3175
876aa27c 3176 modify_overlay (b,
8231a9aa
RS
3177 marker_position (OVERLAY_START (overlay)),
3178 marker_position (OVERLAY_END (overlay)));
b61982dd 3179
3ece337a
JB
3180 Fset_marker (OVERLAY_START (overlay), Qnil, Qnil);
3181 Fset_marker (OVERLAY_END (overlay), Qnil, Qnil);
3182
0a4469c9 3183 return unbind_to (count, Qnil);
2eec3b4e
RS
3184}
3185\f
8ebafa8d
JB
3186/* Overlay dissection functions. */
3187
3188DEFUN ("overlay-start", Foverlay_start, Soverlay_start, 1, 1, 0,
3189 "Return the position at which OVERLAY starts.")
3190 (overlay)
3191 Lisp_Object overlay;
3192{
3193 CHECK_OVERLAY (overlay, 0);
3194
3195 return (Fmarker_position (OVERLAY_START (overlay)));
3196}
3197
3198DEFUN ("overlay-end", Foverlay_end, Soverlay_end, 1, 1, 0,
3199 "Return the position at which OVERLAY ends.")
3200 (overlay)
3201 Lisp_Object overlay;
3202{
3203 CHECK_OVERLAY (overlay, 0);
3204
3205 return (Fmarker_position (OVERLAY_END (overlay)));
3206}
3207
3208DEFUN ("overlay-buffer", Foverlay_buffer, Soverlay_buffer, 1, 1, 0,
3209 "Return the buffer OVERLAY belongs to.")
3210 (overlay)
3211 Lisp_Object overlay;
3212{
3213 CHECK_OVERLAY (overlay, 0);
3214
3215 return Fmarker_buffer (OVERLAY_START (overlay));
3216}
3217
3218DEFUN ("overlay-properties", Foverlay_properties, Soverlay_properties, 1, 1, 0,
3219 "Return a list of the properties on OVERLAY.\n\
3220This is a copy of OVERLAY's plist; modifying its conses has no effect on\n\
3221OVERLAY.")
3222 (overlay)
3223 Lisp_Object overlay;
3224{
3225 CHECK_OVERLAY (overlay, 0);
3226
48e2e3ba 3227 return Fcopy_sequence (XOVERLAY (overlay)->plist);
8ebafa8d
JB
3228}
3229
3230\f
2eec3b4e 3231DEFUN ("overlays-at", Foverlays_at, Soverlays_at, 1, 1, 0,
eb8c3be9 3232 "Return a list of the overlays that contain position POS.")
2eec3b4e
RS
3233 (pos)
3234 Lisp_Object pos;
3235{
3236 int noverlays;
2eec3b4e
RS
3237 Lisp_Object *overlay_vec;
3238 int len;
3239 Lisp_Object result;
3240
3241 CHECK_NUMBER_COERCE_MARKER (pos, 0);
3242
3243 len = 10;
3244 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
3245
3246 /* Put all the overlays we want in a vector in overlay_vec.
3247 Store the length in len. */
2a77a7d7
RS
3248 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
3249 (int *) 0, (int *) 0);
2eec3b4e
RS
3250
3251 /* Make a list of them all. */
3252 result = Flist (noverlays, overlay_vec);
3253
9ac0d9e0 3254 xfree (overlay_vec);
2eec3b4e
RS
3255 return result;
3256}
3257
74514898 3258DEFUN ("overlays-in", Foverlays_in, Soverlays_in, 2, 2, 0,
2a3eeee7
RS
3259 "Return a list of the overlays that overlap the region BEG ... END.\n\
3260Overlap means that at least one character is contained within the overlay\n\
3261and also contained within the specified region.\n\
3262Empty overlays are included in the result if they are located at BEG\n\
3263or between BEG and END.")
74514898
RS
3264 (beg, end)
3265 Lisp_Object beg, end;
3266{
3267 int noverlays;
3268 Lisp_Object *overlay_vec;
3269 int len;
3270 Lisp_Object result;
3271
3272 CHECK_NUMBER_COERCE_MARKER (beg, 0);
3273 CHECK_NUMBER_COERCE_MARKER (end, 0);
3274
3275 len = 10;
3276 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
3277
3278 /* Put all the overlays we want in a vector in overlay_vec.
3279 Store the length in len. */
3280 noverlays = overlays_in (XINT (beg), XINT (end), 1, &overlay_vec, &len,
3281 (int *) 0, (int *) 0);
3282
3283 /* Make a list of them all. */
3284 result = Flist (noverlays, overlay_vec);
3285
3286 xfree (overlay_vec);
3287 return result;
3288}
3289
2eec3b4e
RS
3290DEFUN ("next-overlay-change", Fnext_overlay_change, Snext_overlay_change,
3291 1, 1, 0,
bbe20e81
KH
3292 "Return the next position after POS where an overlay starts or ends.\n\
3293If there are no more overlay boundaries after POS, return (point-max).")
2eec3b4e
RS
3294 (pos)
3295 Lisp_Object pos;
3296{
3297 int noverlays;
3298 int endpos;
3299 Lisp_Object *overlay_vec;
3300 int len;
2eec3b4e
RS
3301 int i;
3302
3303 CHECK_NUMBER_COERCE_MARKER (pos, 0);
3304
3305 len = 10;
3306 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
3307
3308 /* Put all the overlays we want in a vector in overlay_vec.
3309 Store the length in len.
3310 endpos gets the position where the next overlay starts. */
2a77a7d7
RS
3311 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
3312 &endpos, (int *) 0);
2eec3b4e
RS
3313
3314 /* If any of these overlays ends before endpos,
3315 use its ending point instead. */
3316 for (i = 0; i < noverlays; i++)
3317 {
3318 Lisp_Object oend;
3319 int oendpos;
3320
3321 oend = OVERLAY_END (overlay_vec[i]);
3322 oendpos = OVERLAY_POSITION (oend);
3323 if (oendpos < endpos)
3324 endpos = oendpos;
1ab256cb
RM
3325 }
3326
9ac0d9e0 3327 xfree (overlay_vec);
2eec3b4e
RS
3328 return make_number (endpos);
3329}
239c932b
RS
3330
3331DEFUN ("previous-overlay-change", Fprevious_overlay_change,
3332 Sprevious_overlay_change, 1, 1, 0,
3333 "Return the previous position before POS where an overlay starts or ends.\n\
624bbdc4 3334If there are no more overlay boundaries before POS, return (point-min).")
239c932b
RS
3335 (pos)
3336 Lisp_Object pos;
3337{
3338 int noverlays;
3339 int prevpos;
3340 Lisp_Object *overlay_vec;
3341 int len;
3342 int i;
624bbdc4 3343 Lisp_Object tail;
239c932b
RS
3344
3345 CHECK_NUMBER_COERCE_MARKER (pos, 0);
3346
3347 len = 10;
3348 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
3349
624bbdc4
RS
3350 /* At beginning of buffer, we know the answer;
3351 avoid bug subtracting 1 below. */
3352 if (XINT (pos) == BEGV)
3353 return pos;
3354
239c932b
RS
3355 /* Put all the overlays we want in a vector in overlay_vec.
3356 Store the length in len.
3357 prevpos gets the position of an overlay end. */
2a77a7d7
RS
3358 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
3359 (int *) 0, &prevpos);
239c932b 3360
624bbdc4 3361 /* If any of these overlays starts after prevpos,
239c932b
RS
3362 maybe use its starting point instead. */
3363 for (i = 0; i < noverlays; i++)
3364 {
3365 Lisp_Object ostart;
3366 int ostartpos;
3367
3368 ostart = OVERLAY_START (overlay_vec[i]);
3369 ostartpos = OVERLAY_POSITION (ostart);
3370 if (ostartpos > prevpos && ostartpos < XINT (pos))
3371 prevpos = ostartpos;
3372 }
3373
624bbdc4
RS
3374 /* If any overlay ends at pos, consider its starting point too. */
3375 for (tail = current_buffer->overlays_before;
3376 GC_CONSP (tail);
3377 tail = XCONS (tail)->cdr)
3378 {
3379 Lisp_Object overlay, ostart;
3380 int ostartpos;
3381
3382 overlay = XCONS (tail)->car;
3383
3384 ostart = OVERLAY_START (overlay);
3385 ostartpos = OVERLAY_POSITION (ostart);
3386 if (ostartpos > prevpos && ostartpos < XINT (pos))
3387 prevpos = ostartpos;
3388 }
3389
239c932b
RS
3390 xfree (overlay_vec);
3391 return make_number (prevpos);
3392}
2eec3b4e
RS
3393\f
3394/* These functions are for debugging overlays. */
3395
3396DEFUN ("overlay-lists", Foverlay_lists, Soverlay_lists, 0, 0, 0,
3397 "Return a pair of lists giving all the overlays of the current buffer.\n\
3398The car has all the overlays before the overlay center;\n\
bbe20e81 3399the cdr has all the overlays after the overlay center.\n\
2eec3b4e
RS
3400Recentering overlays moves overlays between these lists.\n\
3401The lists you get are copies, so that changing them has no effect.\n\
3402However, the overlays you get are the real objects that the buffer uses.")
3403 ()
3404{
3405 Lisp_Object before, after;
3406 before = current_buffer->overlays_before;
3407 if (CONSP (before))
3408 before = Fcopy_sequence (before);
3409 after = current_buffer->overlays_after;
3410 if (CONSP (after))
3411 after = Fcopy_sequence (after);
3412
3413 return Fcons (before, after);
3414}
3415
3416DEFUN ("overlay-recenter", Foverlay_recenter, Soverlay_recenter, 1, 1, 0,
3417 "Recenter the overlays of the current buffer around position POS.")
3418 (pos)
3419 Lisp_Object pos;
3420{
3421 CHECK_NUMBER_COERCE_MARKER (pos, 0);
3422
5c4f68f1 3423 recenter_overlay_lists (current_buffer, XINT (pos));
2eec3b4e
RS
3424 return Qnil;
3425}
3426\f
3427DEFUN ("overlay-get", Foverlay_get, Soverlay_get, 2, 2, 0,
a2428fa2 3428 "Get the property of overlay OVERLAY with property name PROP.")
2eec3b4e
RS
3429 (overlay, prop)
3430 Lisp_Object overlay, prop;
3431{
cab4777e 3432 Lisp_Object plist, fallback;
52f8ec73
JB
3433
3434 CHECK_OVERLAY (overlay, 0);
3435
cab4777e
RS
3436 fallback = Qnil;
3437
48e2e3ba 3438 for (plist = XOVERLAY (overlay)->plist;
2eec3b4e
RS
3439 CONSP (plist) && CONSP (XCONS (plist)->cdr);
3440 plist = XCONS (XCONS (plist)->cdr)->cdr)
3441 {
3442 if (EQ (XCONS (plist)->car, prop))
3443 return XCONS (XCONS (plist)->cdr)->car;
cab4777e
RS
3444 else if (EQ (XCONS (plist)->car, Qcategory))
3445 {
3446 Lisp_Object tem;
3447 tem = Fcar (Fcdr (plist));
3448 if (SYMBOLP (tem))
3449 fallback = Fget (tem, prop);
3450 }
2eec3b4e 3451 }
52f8ec73 3452
cab4777e 3453 return fallback;
2eec3b4e
RS
3454}
3455
3456DEFUN ("overlay-put", Foverlay_put, Soverlay_put, 3, 3, 0,
3457 "Set one property of overlay OVERLAY: give property PROP value VALUE.")
3458 (overlay, prop, value)
3459 Lisp_Object overlay, prop, value;
3460{
48e2e3ba 3461 Lisp_Object tail, buffer;
9d7608b7 3462 int changed;
2eec3b4e 3463
52f8ec73 3464 CHECK_OVERLAY (overlay, 0);
b61982dd 3465
274a9425
RS
3466 buffer = Fmarker_buffer (OVERLAY_START (overlay));
3467
48e2e3ba 3468 for (tail = XOVERLAY (overlay)->plist;
2eec3b4e
RS
3469 CONSP (tail) && CONSP (XCONS (tail)->cdr);
3470 tail = XCONS (XCONS (tail)->cdr)->cdr)
274a9425
RS
3471 if (EQ (XCONS (tail)->car, prop))
3472 {
9d7608b7
KH
3473 changed = !EQ (XCONS (XCONS (tail)->cdr)->car, value);
3474 XCONS (XCONS (tail)->cdr)->car = value;
3475 goto found;
274a9425 3476 }
9d7608b7
KH
3477 /* It wasn't in the list, so add it to the front. */
3478 changed = !NILP (value);
48e2e3ba
KH
3479 XOVERLAY (overlay)->plist
3480 = Fcons (prop, Fcons (value, XOVERLAY (overlay)->plist));
9d7608b7
KH
3481 found:
3482 if (! NILP (buffer))
3483 {
3484 if (changed)
876aa27c 3485 modify_overlay (XBUFFER (buffer),
9d7608b7
KH
3486 marker_position (OVERLAY_START (overlay)),
3487 marker_position (OVERLAY_END (overlay)));
3488 if (EQ (prop, Qevaporate) && ! NILP (value)
3489 && (OVERLAY_POSITION (OVERLAY_START (overlay))
3490 == OVERLAY_POSITION (OVERLAY_END (overlay))))
3491 Fdelete_overlay (overlay);
3492 }
2eec3b4e 3493 return value;
1ab256cb
RM
3494}
3495\f
9115729e
KH
3496/* Subroutine of report_overlay_modification. */
3497
3498/* Lisp vector holding overlay hook functions to call.
3499 Vector elements come in pairs.
3500 Each even-index element is a list of hook functions.
3501 The following odd-index element is the overlay they came from.
3502
3503 Before the buffer change, we fill in this vector
3504 as we call overlay hook functions.
3505 After the buffer change, we get the functions to call from this vector.
3506 This way we always call the same functions before and after the change. */
3507static Lisp_Object last_overlay_modification_hooks;
3508
3509/* Number of elements actually used in last_overlay_modification_hooks. */
3510static int last_overlay_modification_hooks_used;
3511
3512/* Add one functionlist/overlay pair
3513 to the end of last_overlay_modification_hooks. */
3514
3515static void
3516add_overlay_mod_hooklist (functionlist, overlay)
3517 Lisp_Object functionlist, overlay;
3518{
3519 int oldsize = XVECTOR (last_overlay_modification_hooks)->size;
3520
3521 if (last_overlay_modification_hooks_used == oldsize)
3522 {
3523 Lisp_Object old;
3524 old = last_overlay_modification_hooks;
3525 last_overlay_modification_hooks
3526 = Fmake_vector (make_number (oldsize * 2), Qnil);
0b1f1b09
RS
3527 bcopy (XVECTOR (old)->contents,
3528 XVECTOR (last_overlay_modification_hooks)->contents,
9115729e
KH
3529 sizeof (Lisp_Object) * oldsize);
3530 }
3531 XVECTOR (last_overlay_modification_hooks)->contents[last_overlay_modification_hooks_used++] = functionlist;
3532 XVECTOR (last_overlay_modification_hooks)->contents[last_overlay_modification_hooks_used++] = overlay;
3533}
3534\f
173f2a64
RS
3535/* Run the modification-hooks of overlays that include
3536 any part of the text in START to END.
9115729e
KH
3537 If this change is an insertion, also
3538 run the insert-before-hooks of overlay starting at END,
930a9140
RS
3539 and the insert-after-hooks of overlay ending at START.
3540
3541 This is called both before and after the modification.
3542 AFTER is nonzero when we call after the modification.
3543
9115729e
KH
3544 ARG1, ARG2, ARG3 are arguments to pass to the hook functions.
3545 When AFTER is nonzero, they are the start position,
3546 the position after the inserted new text,
3547 and the length of deleted or replaced old text. */
173f2a64
RS
3548
3549void
930a9140 3550report_overlay_modification (start, end, after, arg1, arg2, arg3)
173f2a64 3551 Lisp_Object start, end;
930a9140
RS
3552 int after;
3553 Lisp_Object arg1, arg2, arg3;
173f2a64
RS
3554{
3555 Lisp_Object prop, overlay, tail;
9115729e
KH
3556 /* 1 if this change is an insertion. */
3557 int insertion = (after ? XFASTINT (arg3) == 0 : EQ (start, end));
55b48893 3558 int tail_copied;
930a9140 3559 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
55b48893
RS
3560
3561 overlay = Qnil;
3562 tail = Qnil;
930a9140 3563 GCPRO5 (overlay, tail, arg1, arg2, arg3);
173f2a64 3564
9115729e
KH
3565 if (after)
3566 {
3567 /* Call the functions recorded in last_overlay_modification_hooks
3568 rather than scanning the overlays again.
3569 First copy the vector contents, in case some of these hooks
3570 do subsequent modification of the buffer. */
3571 int size = last_overlay_modification_hooks_used;
3572 Lisp_Object *copy = (Lisp_Object *) alloca (size * sizeof (Lisp_Object));
3573 int i;
3574
3575 bcopy (XVECTOR (last_overlay_modification_hooks)->contents,
3576 copy, size * sizeof (Lisp_Object));
3577 gcpro1.var = copy;
3578 gcpro1.nvars = size;
3579
3580 for (i = 0; i < size;)
3581 {
3582 Lisp_Object prop, overlay;
3583 prop = copy[i++];
3584 overlay = copy[i++];
3585 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
3586 }
3587 UNGCPRO;
3588 return;
3589 }
3590
3591 /* We are being called before a change.
3592 Scan the overlays to find the functions to call. */
3593 last_overlay_modification_hooks_used = 0;
55b48893 3594 tail_copied = 0;
173f2a64
RS
3595 for (tail = current_buffer->overlays_before;
3596 CONSP (tail);
3597 tail = XCONS (tail)->cdr)
3598 {
3599 int startpos, endpos;
be8b1c6b 3600 Lisp_Object ostart, oend;
173f2a64
RS
3601
3602 overlay = XCONS (tail)->car;
3603
3604 ostart = OVERLAY_START (overlay);
3605 oend = OVERLAY_END (overlay);
3606 endpos = OVERLAY_POSITION (oend);
3607 if (XFASTINT (start) > endpos)
3608 break;
3609 startpos = OVERLAY_POSITION (ostart);
9115729e
KH
3610 if (insertion && (XFASTINT (start) == startpos
3611 || XFASTINT (end) == startpos))
173f2a64
RS
3612 {
3613 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
5fb5aa33
RS
3614 if (!NILP (prop))
3615 {
3616 /* Copy TAIL in case the hook recenters the overlay lists. */
55b48893
RS
3617 if (!tail_copied)
3618 tail = Fcopy_sequence (tail);
3619 tail_copied = 1;
930a9140 3620 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
5fb5aa33 3621 }
173f2a64 3622 }
9115729e
KH
3623 if (insertion && (XFASTINT (start) == endpos
3624 || XFASTINT (end) == endpos))
173f2a64
RS
3625 {
3626 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
5fb5aa33
RS
3627 if (!NILP (prop))
3628 {
55b48893
RS
3629 if (!tail_copied)
3630 tail = Fcopy_sequence (tail);
3631 tail_copied = 1;
930a9140 3632 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
5fb5aa33 3633 }
173f2a64 3634 }
3bd13e92
KH
3635 /* Test for intersecting intervals. This does the right thing
3636 for both insertion and deletion. */
3637 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
173f2a64
RS
3638 {
3639 prop = Foverlay_get (overlay, Qmodification_hooks);
5fb5aa33
RS
3640 if (!NILP (prop))
3641 {
55b48893
RS
3642 if (!tail_copied)
3643 tail = Fcopy_sequence (tail);
3644 tail_copied = 1;
930a9140 3645 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
5fb5aa33 3646 }
173f2a64
RS
3647 }
3648 }
3649
55b48893 3650 tail_copied = 0;
173f2a64
RS
3651 for (tail = current_buffer->overlays_after;
3652 CONSP (tail);
3653 tail = XCONS (tail)->cdr)
3654 {
3655 int startpos, endpos;
be8b1c6b 3656 Lisp_Object ostart, oend;
173f2a64
RS
3657
3658 overlay = XCONS (tail)->car;
3659
3660 ostart = OVERLAY_START (overlay);
3661 oend = OVERLAY_END (overlay);
3662 startpos = OVERLAY_POSITION (ostart);
cdf0b096 3663 endpos = OVERLAY_POSITION (oend);
173f2a64
RS
3664 if (XFASTINT (end) < startpos)
3665 break;
9115729e
KH
3666 if (insertion && (XFASTINT (start) == startpos
3667 || XFASTINT (end) == startpos))
173f2a64
RS
3668 {
3669 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
5fb5aa33
RS
3670 if (!NILP (prop))
3671 {
55b48893
RS
3672 if (!tail_copied)
3673 tail = Fcopy_sequence (tail);
3674 tail_copied = 1;
930a9140 3675 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
5fb5aa33 3676 }
173f2a64 3677 }
9115729e
KH
3678 if (insertion && (XFASTINT (start) == endpos
3679 || XFASTINT (end) == endpos))
173f2a64
RS
3680 {
3681 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
5fb5aa33
RS
3682 if (!NILP (prop))
3683 {
55b48893
RS
3684 if (!tail_copied)
3685 tail = Fcopy_sequence (tail);
3686 tail_copied = 1;
930a9140 3687 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
5fb5aa33 3688 }
173f2a64 3689 }
3bd13e92
KH
3690 /* Test for intersecting intervals. This does the right thing
3691 for both insertion and deletion. */
3692 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
173f2a64
RS
3693 {
3694 prop = Foverlay_get (overlay, Qmodification_hooks);
5fb5aa33
RS
3695 if (!NILP (prop))
3696 {
55b48893
RS
3697 if (!tail_copied)
3698 tail = Fcopy_sequence (tail);
3699 tail_copied = 1;
930a9140 3700 call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
5fb5aa33 3701 }
173f2a64
RS
3702 }
3703 }
55b48893
RS
3704
3705 UNGCPRO;
173f2a64
RS
3706}
3707
3708static void
930a9140
RS
3709call_overlay_mod_hooks (list, overlay, after, arg1, arg2, arg3)
3710 Lisp_Object list, overlay;
3711 int after;
3712 Lisp_Object arg1, arg2, arg3;
173f2a64 3713{
930a9140 3714 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
9115729e 3715
930a9140 3716 GCPRO4 (list, arg1, arg2, arg3);
9115729e
KH
3717 if (! after)
3718 add_overlay_mod_hooklist (list, overlay);
3719
173f2a64
RS
3720 while (!NILP (list))
3721 {
930a9140
RS
3722 if (NILP (arg3))
3723 call4 (Fcar (list), overlay, after ? Qt : Qnil, arg1, arg2);
3724 else
3725 call5 (Fcar (list), overlay, after ? Qt : Qnil, arg1, arg2, arg3);
173f2a64
RS
3726 list = Fcdr (list);
3727 }
3728 UNGCPRO;
3729}
9d7608b7
KH
3730
3731/* Delete any zero-sized overlays at position POS, if the `evaporate'
3732 property is set. */
3733void
3734evaporate_overlays (pos)
3735 int pos;
3736{
3737 Lisp_Object tail, overlay, hit_list;
3738
3739 hit_list = Qnil;
3740 if (pos <= XFASTINT (current_buffer->overlay_center))
3741 for (tail = current_buffer->overlays_before; CONSP (tail);
3742 tail = XCONS (tail)->cdr)
3743 {
3744 int endpos;
3745 overlay = XCONS (tail)->car;
3746 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
3747 if (endpos < pos)
3748 break;
3749 if (endpos == pos && OVERLAY_POSITION (OVERLAY_START (overlay)) == pos
c3935f9d 3750 && ! NILP (Foverlay_get (overlay, Qevaporate)))
9d7608b7
KH
3751 hit_list = Fcons (overlay, hit_list);
3752 }
3753 else
3754 for (tail = current_buffer->overlays_after; CONSP (tail);
3755 tail = XCONS (tail)->cdr)
3756 {
3757 int startpos;
889bf329 3758 overlay = XCONS (tail)->car;
9d7608b7
KH
3759 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
3760 if (startpos > pos)
3761 break;
3762 if (startpos == pos && OVERLAY_POSITION (OVERLAY_END (overlay)) == pos
c3935f9d 3763 && ! NILP (Foverlay_get (overlay, Qevaporate)))
9d7608b7
KH
3764 hit_list = Fcons (overlay, hit_list);
3765 }
3766 for (; CONSP (hit_list); hit_list = XCONS (hit_list)->cdr)
3767 Fdelete_overlay (XCONS (hit_list)->car);
3768}
173f2a64 3769\f
54dfdeb0 3770/* Somebody has tried to store a value with an unacceptable type
1bf08baf
KH
3771 in the slot with offset OFFSET. */
3772
0fa3ba92 3773void
54dfdeb0
KH
3774buffer_slot_type_mismatch (offset)
3775 int offset;
0fa3ba92 3776{
54dfdeb0 3777 Lisp_Object sym;
0fa3ba92 3778 char *type_name;
54dfdeb0 3779 sym = *(Lisp_Object *)(offset + (char *)&buffer_local_symbols);
0fa3ba92
JB
3780 switch (XINT (*(Lisp_Object *)(offset + (char *)&buffer_local_types)))
3781 {
3782 case Lisp_Int: type_name = "integers"; break;
3783 case Lisp_String: type_name = "strings"; break;
0fa3ba92 3784 case Lisp_Symbol: type_name = "symbols"; break;
1bf08baf 3785
0fa3ba92
JB
3786 default:
3787 abort ();
3788 }
3789
1bf08baf 3790 error ("Only %s should be stored in the buffer-local variable %s",
54dfdeb0 3791 type_name, XSYMBOL (sym)->name->data);
0fa3ba92
JB
3792}
3793\f
dfcf069d 3794void
1ab256cb
RM
3795init_buffer_once ()
3796{
3797 register Lisp_Object tem;
3798
13de9290
RS
3799 buffer_permanent_local_flags = 0;
3800
1ab256cb
RM
3801 /* Make sure all markable slots in buffer_defaults
3802 are initialized reasonably, so mark_buffer won't choke. */
3803 reset_buffer (&buffer_defaults);
13de9290 3804 reset_buffer_local_variables (&buffer_defaults, 1);
1ab256cb 3805 reset_buffer (&buffer_local_symbols);
13de9290 3806 reset_buffer_local_variables (&buffer_local_symbols, 1);
336cd056
RS
3807 /* Prevent GC from getting confused. */
3808 buffer_defaults.text = &buffer_defaults.own_text;
3809 buffer_local_symbols.text = &buffer_local_symbols.own_text;
3810#ifdef USE_TEXT_PROPERTIES
3811 BUF_INTERVALS (&buffer_defaults) = 0;
3812 BUF_INTERVALS (&buffer_local_symbols) = 0;
3813#endif
67180c6a
KH
3814 XSETBUFFER (Vbuffer_defaults, &buffer_defaults);
3815 XSETBUFFER (Vbuffer_local_symbols, &buffer_local_symbols);
1ab256cb
RM
3816
3817 /* Set up the default values of various buffer slots. */
3818 /* Must do these before making the first buffer! */
3819
3820 /* real setup is done in loaddefs.el */
3821 buffer_defaults.mode_line_format = build_string ("%-");
3822 buffer_defaults.abbrev_mode = Qnil;
3823 buffer_defaults.overwrite_mode = Qnil;
3824 buffer_defaults.case_fold_search = Qt;
3825 buffer_defaults.auto_fill_function = Qnil;
3826 buffer_defaults.selective_display = Qnil;
3827#ifndef old
3828 buffer_defaults.selective_display_ellipses = Qt;
3829#endif
3830 buffer_defaults.abbrev_table = Qnil;
3831 buffer_defaults.display_table = Qnil;
1ab256cb 3832 buffer_defaults.undo_list = Qnil;
c48f61ef 3833 buffer_defaults.mark_active = Qnil;
be9aafdd 3834 buffer_defaults.file_format = Qnil;
2eec3b4e
RS
3835 buffer_defaults.overlays_before = Qnil;
3836 buffer_defaults.overlays_after = Qnil;
bbbe9545 3837 XSETFASTINT (buffer_defaults.overlay_center, BEG);
1ab256cb 3838
8d7a4592 3839 XSETFASTINT (buffer_defaults.tab_width, 8);
1ab256cb
RM
3840 buffer_defaults.truncate_lines = Qnil;
3841 buffer_defaults.ctl_arrow = Qt;
3b06f880 3842 buffer_defaults.direction_reversed = Qnil;
1ab256cb 3843
f7975d07 3844#ifdef DOS_NT
0776cb1b 3845 buffer_defaults.buffer_file_type = Qnil; /* TEXT */
54ad07d3 3846#endif
a1a17b61 3847 buffer_defaults.enable_multibyte_characters = Qt;
c71b5d9b 3848 buffer_defaults.buffer_file_coding_system = Qnil;
8d7a4592
KH
3849 XSETFASTINT (buffer_defaults.fill_column, 70);
3850 XSETFASTINT (buffer_defaults.left_margin, 0);
28e969dd 3851 buffer_defaults.cache_long_line_scans = Qnil;
f6ed2e84 3852 buffer_defaults.file_truename = Qnil;
7962a441 3853 XSETFASTINT (buffer_defaults.display_count, 0);
1ab256cb
RM
3854
3855 /* Assign the local-flags to the slots that have default values.
3856 The local flag is a bit that is used in the buffer
3857 to say that it has its own local value for the slot.
3858 The local flag bits are in the local_var_flags slot of the buffer. */
3859
3860 /* Nothing can work if this isn't true */
4d2f1389 3861 if (sizeof (EMACS_INT) != sizeof (Lisp_Object)) abort ();
1ab256cb
RM
3862
3863 /* 0 means not a lisp var, -1 means always local, else mask */
3864 bzero (&buffer_local_flags, sizeof buffer_local_flags);
aab80822
KH
3865 XSETINT (buffer_local_flags.filename, -1);
3866 XSETINT (buffer_local_flags.directory, -1);
3867 XSETINT (buffer_local_flags.backed_up, -1);
3868 XSETINT (buffer_local_flags.save_length, -1);
3869 XSETINT (buffer_local_flags.auto_save_file_name, -1);
3870 XSETINT (buffer_local_flags.read_only, -1);
3871 XSETINT (buffer_local_flags.major_mode, -1);
3872 XSETINT (buffer_local_flags.mode_name, -1);
3873 XSETINT (buffer_local_flags.undo_list, -1);
3874 XSETINT (buffer_local_flags.mark_active, -1);
943e065b 3875 XSETINT (buffer_local_flags.point_before_scroll, -1);
f6ed2e84 3876 XSETINT (buffer_local_flags.file_truename, -1);
3cb719bd 3877 XSETINT (buffer_local_flags.invisibility_spec, -1);
55ac8536 3878 XSETINT (buffer_local_flags.file_format, -1);
7962a441 3879 XSETINT (buffer_local_flags.display_count, -1);
1bf08baf 3880 XSETINT (buffer_local_flags.enable_multibyte_characters, -1);
8d7a4592
KH
3881
3882 XSETFASTINT (buffer_local_flags.mode_line_format, 1);
3883 XSETFASTINT (buffer_local_flags.abbrev_mode, 2);
3884 XSETFASTINT (buffer_local_flags.overwrite_mode, 4);
3885 XSETFASTINT (buffer_local_flags.case_fold_search, 8);
3886 XSETFASTINT (buffer_local_flags.auto_fill_function, 0x10);
3887 XSETFASTINT (buffer_local_flags.selective_display, 0x20);
1ab256cb 3888#ifndef old
8d7a4592 3889 XSETFASTINT (buffer_local_flags.selective_display_ellipses, 0x40);
1ab256cb 3890#endif
8d7a4592
KH
3891 XSETFASTINT (buffer_local_flags.tab_width, 0x80);
3892 XSETFASTINT (buffer_local_flags.truncate_lines, 0x100);
3893 XSETFASTINT (buffer_local_flags.ctl_arrow, 0x200);
3894 XSETFASTINT (buffer_local_flags.fill_column, 0x400);
3895 XSETFASTINT (buffer_local_flags.left_margin, 0x800);
3896 XSETFASTINT (buffer_local_flags.abbrev_table, 0x1000);
3897 XSETFASTINT (buffer_local_flags.display_table, 0x2000);
f7975d07 3898#ifdef DOS_NT
8d7a4592 3899 XSETFASTINT (buffer_local_flags.buffer_file_type, 0x4000);
13de9290
RS
3900 /* Make this one a permanent local. */
3901 buffer_permanent_local_flags |= 0x4000;
54ad07d3 3902#endif
2e716096
RS
3903 XSETFASTINT (buffer_local_flags.syntax_table, 0x8000);
3904 XSETFASTINT (buffer_local_flags.cache_long_line_scans, 0x10000);
3b06f880
KH
3905 XSETFASTINT (buffer_local_flags.category_table, 0x20000);
3906 XSETFASTINT (buffer_local_flags.direction_reversed, 0x40000);
1bf08baf 3907 XSETFASTINT (buffer_local_flags.buffer_file_coding_system, 0x80000);
a1a17b61
KH
3908 /* Make this one a permanent local. */
3909 buffer_permanent_local_flags |= 0x80000;
c71b5d9b 3910
1ab256cb
RM
3911 Vbuffer_alist = Qnil;
3912 current_buffer = 0;
3913 all_buffers = 0;
3914
3915 QSFundamental = build_string ("Fundamental");
3916
3917 Qfundamental_mode = intern ("fundamental-mode");
3918 buffer_defaults.major_mode = Qfundamental_mode;
3919
3920 Qmode_class = intern ("mode-class");
3921
3922 Qprotected_field = intern ("protected-field");
3923
3924 Qpermanent_local = intern ("permanent-local");
3925
3926 Qkill_buffer_hook = intern ("kill-buffer-hook");
3927
3928 Vprin1_to_string_buffer = Fget_buffer_create (build_string (" prin1"));
000f8083 3929
1ab256cb
RM
3930 /* super-magic invisible buffer */
3931 Vbuffer_alist = Qnil;
3932
ffd56f97 3933 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
1ab256cb
RM
3934}
3935
dfcf069d 3936void
1ab256cb
RM
3937init_buffer ()
3938{
3939 char buf[MAXPATHLEN+1];
2381d133
JB
3940 char *pwd;
3941 struct stat dotstat, pwdstat;
136351b7 3942 Lisp_Object temp;
f7975d07 3943 int rc;
1ab256cb
RM
3944
3945 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
3d871c85
RS
3946 if (NILP (buffer_defaults.enable_multibyte_characters))
3947 Fset_buffer_multibyte (Qnil);
2381d133
JB
3948
3949 /* If PWD is accurate, use it instead of calling getwd. This is faster
3950 when PWD is right, and may avoid a fatal error. */
f7975d07 3951 if ((pwd = getenv ("PWD")) != 0 && IS_DIRECTORY_SEP (*pwd)
2381d133
JB
3952 && stat (pwd, &pwdstat) == 0
3953 && stat (".", &dotstat) == 0
3954 && dotstat.st_ino == pwdstat.st_ino
3955 && dotstat.st_dev == pwdstat.st_dev
3956 && strlen (pwd) < MAXPATHLEN)
3957 strcpy (buf, pwd);
6335beb0
RS
3958#ifdef HAVE_GETCWD
3959 else if (getcwd (buf, MAXPATHLEN+1) == 0)
9dde47f5 3960 fatal ("`getcwd' failed: %s\n", strerror (errno));
6335beb0 3961#else
2381d133 3962 else if (getwd (buf) == 0)
cf1e6391 3963 fatal ("`getwd' failed: %s\n", buf);
6335beb0 3964#endif
1ab256cb
RM
3965
3966#ifndef VMS
3967 /* Maybe this should really use some standard subroutine
3968 whose definition is filename syntax dependent. */
f7975d07
RS
3969 rc = strlen (buf);
3970 if (!(IS_DIRECTORY_SEP (buf[rc - 1])))
3971 {
3972 buf[rc] = DIRECTORY_SEP;
3973 buf[rc + 1] = '\0';
3974 }
1ab256cb 3975#endif /* not VMS */
0995fa35 3976
1ab256cb 3977 current_buffer->directory = build_string (buf);
136351b7 3978
0995fa35
RS
3979 /* Add /: to the front of the name
3980 if it would otherwise be treated as magic. */
3981 temp = Ffind_file_name_handler (current_buffer->directory, Qt);
81ab2e07
KH
3982 if (! NILP (temp)
3983 /* If the default dir is just /, TEMP is non-nil
3984 because of the ange-ftp completion handler.
3985 However, it is not necessary to turn / into /:/.
3986 So avoid doing that. */
3987 && strcmp ("/", XSTRING (current_buffer->directory)->data))
0995fa35
RS
3988 current_buffer->directory
3989 = concat2 (build_string ("/:"), current_buffer->directory);
3990
136351b7
RS
3991 temp = get_minibuffer (0);
3992 XBUFFER (temp)->directory = current_buffer->directory;
1ab256cb
RM
3993}
3994
3995/* initialize the buffer routines */
dfcf069d 3996void
1ab256cb
RM
3997syms_of_buffer ()
3998{
188d4d11
RM
3999 extern Lisp_Object Qdisabled;
4000
9115729e
KH
4001 staticpro (&last_overlay_modification_hooks);
4002 last_overlay_modification_hooks
4003 = Fmake_vector (make_number (10), Qnil);
4004
1ab256cb
RM
4005 staticpro (&Vbuffer_defaults);
4006 staticpro (&Vbuffer_local_symbols);
4007 staticpro (&Qfundamental_mode);
4008 staticpro (&Qmode_class);
4009 staticpro (&QSFundamental);
4010 staticpro (&Vbuffer_alist);
4011 staticpro (&Qprotected_field);
4012 staticpro (&Qpermanent_local);
4013 staticpro (&Qkill_buffer_hook);
22378665 4014 Qoverlayp = intern ("overlayp");
52f8ec73 4015 staticpro (&Qoverlayp);
9d7608b7
KH
4016 Qevaporate = intern ("evaporate");
4017 staticpro (&Qevaporate);
294d215f 4018 Qmodification_hooks = intern ("modification-hooks");
22378665 4019 staticpro (&Qmodification_hooks);
294d215f 4020 Qinsert_in_front_hooks = intern ("insert-in-front-hooks");
22378665 4021 staticpro (&Qinsert_in_front_hooks);
294d215f 4022 Qinsert_behind_hooks = intern ("insert-behind-hooks");
22378665 4023 staticpro (&Qinsert_behind_hooks);
5fe0b67e 4024 Qget_file_buffer = intern ("get-file-buffer");
22378665 4025 staticpro (&Qget_file_buffer);
5985d248
KH
4026 Qpriority = intern ("priority");
4027 staticpro (&Qpriority);
4028 Qwindow = intern ("window");
4029 staticpro (&Qwindow);
bbbe9545
KH
4030 Qbefore_string = intern ("before-string");
4031 staticpro (&Qbefore_string);
4032 Qafter_string = intern ("after-string");
4033 staticpro (&Qafter_string);
22378665
RS
4034 Qfirst_change_hook = intern ("first-change-hook");
4035 staticpro (&Qfirst_change_hook);
4036 Qbefore_change_functions = intern ("before-change-functions");
4037 staticpro (&Qbefore_change_functions);
4038 Qafter_change_functions = intern ("after-change-functions");
4039 staticpro (&Qafter_change_functions);
1ab256cb
RM
4040
4041 Fput (Qprotected_field, Qerror_conditions,
4042 Fcons (Qprotected_field, Fcons (Qerror, Qnil)));
4043 Fput (Qprotected_field, Qerror_message,
4044 build_string ("Attempt to modify a protected field"));
4045
4046 /* All these use DEFVAR_LISP_NOPRO because the slots in
4047 buffer_defaults will all be marked via Vbuffer_defaults. */
4048
4049 DEFVAR_LISP_NOPRO ("default-mode-line-format",
4050 &buffer_defaults.mode_line_format,
4051 "Default value of `mode-line-format' for buffers that don't override it.\n\
4052This is the same as (default-value 'mode-line-format).");
4053
4054 DEFVAR_LISP_NOPRO ("default-abbrev-mode",
4055 &buffer_defaults.abbrev_mode,
4056 "Default value of `abbrev-mode' for buffers that do not override it.\n\
4057This is the same as (default-value 'abbrev-mode).");
4058
4059 DEFVAR_LISP_NOPRO ("default-ctl-arrow",
4060 &buffer_defaults.ctl_arrow,
4061 "Default value of `ctl-arrow' for buffers that do not override it.\n\
4062This is the same as (default-value 'ctl-arrow).");
4063
3b06f880
KH
4064 DEFVAR_LISP_NOPRO ("default-direction-reversed",
4065 &buffer_defaults.direction_reversed,
4066 "Default value of `direction_reversed' for buffers that do not override it.\n\
4067 This is the same as (default-value 'direction-reversed).");
4068
a1a17b61
KH
4069 DEFVAR_LISP_NOPRO ("default-enable-multibyte-characters",
4070 &buffer_defaults.enable_multibyte_characters,
4071 "Default value of `enable-multibyte-characters' for buffers not overriding it.\n\
4072 This is the same as (default-value 'enable-multibyte-characters).");
4073
c71b5d9b
KH
4074 DEFVAR_LISP_NOPRO ("default-buffer-file-coding-system",
4075 &buffer_defaults.buffer_file_coding_system,
4076 "Default value of `buffer-file-coding-system' for buffers not overriding it.\n\
4077 This is the same as (default-value 'buffer-file-coding-system).");
4078
1ab256cb
RM
4079 DEFVAR_LISP_NOPRO ("default-truncate-lines",
4080 &buffer_defaults.truncate_lines,
4081 "Default value of `truncate-lines' for buffers that do not override it.\n\
4082This is the same as (default-value 'truncate-lines).");
4083
4084 DEFVAR_LISP_NOPRO ("default-fill-column",
4085 &buffer_defaults.fill_column,
4086 "Default value of `fill-column' for buffers that do not override it.\n\
4087This is the same as (default-value 'fill-column).");
4088
4089 DEFVAR_LISP_NOPRO ("default-left-margin",
4090 &buffer_defaults.left_margin,
4091 "Default value of `left-margin' for buffers that do not override it.\n\
4092This is the same as (default-value 'left-margin).");
4093
4094 DEFVAR_LISP_NOPRO ("default-tab-width",
4095 &buffer_defaults.tab_width,
4096 "Default value of `tab-width' for buffers that do not override it.\n\
4097This is the same as (default-value 'tab-width).");
4098
4099 DEFVAR_LISP_NOPRO ("default-case-fold-search",
4100 &buffer_defaults.case_fold_search,
4101 "Default value of `case-fold-search' for buffers that don't override it.\n\
4102This is the same as (default-value 'case-fold-search).");
4103
f7975d07 4104#ifdef DOS_NT
54ad07d3
RS
4105 DEFVAR_LISP_NOPRO ("default-buffer-file-type",
4106 &buffer_defaults.buffer_file_type,
4107 "Default file type for buffers that do not override it.\n\
4108This is the same as (default-value 'buffer-file-type).\n\
4109The file type is nil for text, t for binary.");
4110#endif
4111
0fa3ba92
JB
4112 DEFVAR_PER_BUFFER ("mode-line-format", &current_buffer->mode_line_format,
4113 Qnil, 0);
1ab256cb
RM
4114
4115/* This doc string is too long for cpp; cpp dies if it isn't in a comment.
4116 But make-docfile finds it!
4117 DEFVAR_PER_BUFFER ("mode-line-format", &current_buffer->mode_line_format,
bec44fd6 4118 Qnil,
1ab256cb
RM
4119 "Template for displaying mode line for current buffer.\n\
4120Each buffer has its own value of this variable.\n\
4121Value may be a string, a symbol or a list or cons cell.\n\
4122For a symbol, its value is used (but it is ignored if t or nil).\n\
4123 A string appearing directly as the value of a symbol is processed verbatim\n\
4124 in that the %-constructs below are not recognized.\n\
4125For a list whose car is a symbol, the symbol's value is taken,\n\
4126 and if that is non-nil, the cadr of the list is processed recursively.\n\
4127 Otherwise, the caddr of the list (if there is one) is processed.\n\
4128For a list whose car is a string or list, each element is processed\n\
4129 recursively and the results are effectively concatenated.\n\
4130For a list whose car is an integer, the cdr of the list is processed\n\
4131 and padded (if the number is positive) or truncated (if negative)\n\
4132 to the width specified by that number.\n\
4133A string is printed verbatim in the mode line except for %-constructs:\n\
4134 (%-constructs are allowed when the string is the entire mode-line-format\n\
4135 or when it is found in a cons-cell or a list)\n\
4136 %b -- print buffer name. %f -- print visited file name.\n\
5d516f2d 4137 %F -- print frame name.\n\
c2ff34f7
RS
4138 %* -- print %, * or hyphen. %+ -- print *, % or hyphen.\n\
4139 % means buffer is read-only and * means it is modified.\n\
4140 For a modified read-only buffer, %* gives % and %+ gives *.\n\
a97c374a 4141 %s -- print process status. %l -- print the current line number.\n\
07924294 4142 %c -- print the current column number (this makes editing slower).\n\
6a567ad8
RS
4143 To make the column number update correctly in all cases,\n\
4144 `column-number-mode' must be non-nil.\n\
dd24e6a6 4145 %p -- print percent of buffer above top of window, or Top, Bot or All.\n\
9d130ffc 4146 %P -- print percent of buffer above bottom of window, perhaps plus Top,\n\
dd24e6a6 4147 or print Bottom or All.\n\
1ab256cb 4148 %n -- print Narrow if appropriate.\n\
b77087c5 4149 %t -- print T if file is text, B if binary.\n\
1ab256cb
RM
4150 %[ -- print one [ for each recursive editing level. %] similar.\n\
4151 %% -- print %. %- -- print infinitely many dashes.\n\
4152Decimal digits after the % specify field width to which to pad.");
4153*/
4154
4155 DEFVAR_LISP_NOPRO ("default-major-mode", &buffer_defaults.major_mode,
4156 "*Major mode for new buffers. Defaults to `fundamental-mode'.\n\
4157nil here means use current buffer's major mode.");
4158
4159 DEFVAR_PER_BUFFER ("major-mode", &current_buffer->major_mode,
0fa3ba92 4160 make_number (Lisp_Symbol),
1ab256cb
RM
4161 "Symbol for current buffer's major mode.");
4162
4163 DEFVAR_PER_BUFFER ("mode-name", &current_buffer->mode_name,
0fa3ba92 4164 make_number (Lisp_String),
1ab256cb
RM
4165 "Pretty name of current buffer's major mode (a string).");
4166
0fa3ba92 4167 DEFVAR_PER_BUFFER ("abbrev-mode", &current_buffer->abbrev_mode, Qnil,
1ab256cb
RM
4168 "Non-nil turns on automatic expansion of abbrevs as they are inserted.\n\
4169Automatically becomes buffer-local when set in any fashion.");
4170
4171 DEFVAR_PER_BUFFER ("case-fold-search", &current_buffer->case_fold_search,
0fa3ba92 4172 Qnil,
1ab256cb
RM
4173 "*Non-nil if searches should ignore case.\n\
4174Automatically becomes buffer-local when set in any fashion.");
4175
4176 DEFVAR_PER_BUFFER ("fill-column", &current_buffer->fill_column,
0fa3ba92 4177 make_number (Lisp_Int),
1ab256cb
RM
4178 "*Column beyond which automatic line-wrapping should happen.\n\
4179Automatically becomes buffer-local when set in any fashion.");
4180
4181 DEFVAR_PER_BUFFER ("left-margin", &current_buffer->left_margin,
0fa3ba92 4182 make_number (Lisp_Int),
1ab256cb
RM
4183 "*Column for the default indent-line-function to indent to.\n\
4184Linefeed indents to this column in Fundamental mode.\n\
4185Automatically becomes buffer-local when set in any fashion.");
4186
4187 DEFVAR_PER_BUFFER ("tab-width", &current_buffer->tab_width,
0fa3ba92 4188 make_number (Lisp_Int),
1ab256cb
RM
4189 "*Distance between tab stops (for display of tab characters), in columns.\n\
4190Automatically becomes buffer-local when set in any fashion.");
4191
0fa3ba92 4192 DEFVAR_PER_BUFFER ("ctl-arrow", &current_buffer->ctl_arrow, Qnil,
1ab256cb 4193 "*Non-nil means display control chars with uparrow.\n\
6a99d31d 4194A value of nil means use backslash and octal digits.\n\
1ab256cb
RM
4195Automatically becomes buffer-local when set in any fashion.\n\
4196This variable does not apply to characters whose display is specified\n\
4197in the current display table (if there is one).");
4198
3b06f880 4199 DEFVAR_PER_BUFFER ("enable-multibyte-characters",
1bf08baf
KH
4200 &current_buffer->enable_multibyte_characters,
4201 make_number (-1),
c807f767 4202 "*Non-nil means the buffer contents are regarded as multi-byte form\n\
3b06f880
KH
4203of characters, not a binary code. This affects the display, file I/O,\n\
4204and behaviors of various editing commands.");
4205
c71b5d9b
KH
4206 DEFVAR_PER_BUFFER ("buffer-file-coding-system",
4207 &current_buffer->buffer_file_coding_system, Qnil,
4208 "Coding system to be used for encoding the buffer contents on saving.\n\
4209If it is nil, the buffer is saved without any code conversion unless\n\
6c0316ae 4210some coding system is specified in `file-coding-system-alist'\n\
c71b5d9b
KH
4211for the buffer file.\n\
4212\n\
4213This variable is never applied to a way of decoding\n\
4214a file while reading it.");
4215
3b06f880
KH
4216 DEFVAR_PER_BUFFER ("direction-reversed", &current_buffer->direction_reversed,
4217 Qnil,
4218 "*Non-nil means lines in the buffer are displayed right to left.");
4219
0fa3ba92 4220 DEFVAR_PER_BUFFER ("truncate-lines", &current_buffer->truncate_lines, Qnil,
1ab256cb
RM
4221 "*Non-nil means do not display continuation lines;\n\
4222give each line of text one screen line.\n\
4223Automatically becomes buffer-local when set in any fashion.\n\
4224\n\
4225Note that this is overridden by the variable\n\
4226`truncate-partial-width-windows' if that variable is non-nil\n\
502b9b64 4227and this buffer is not full-frame width.");
1ab256cb 4228
f7975d07 4229#ifdef DOS_NT
54ad07d3
RS
4230 DEFVAR_PER_BUFFER ("buffer-file-type", &current_buffer->buffer_file_type,
4231 Qnil,
006d3d34
RS
4232 "Non-nil if the visited file is a binary file.\n\
4233This variable is meaningful on MS-DOG and Windows NT.\n\
4234On those systems, it is automatically local in every buffer.\n\
e0585c64 4235On other systems, this variable is normally always nil.");
54ad07d3
RS
4236#endif
4237
1ab256cb 4238 DEFVAR_PER_BUFFER ("default-directory", &current_buffer->directory,
0fa3ba92 4239 make_number (Lisp_String),
1ab256cb
RM
4240 "Name of default directory of current buffer. Should end with slash.\n\
4241Each buffer has its own value of this variable.");
4242
4243 DEFVAR_PER_BUFFER ("auto-fill-function", &current_buffer->auto_fill_function,
0fa3ba92 4244 Qnil,
1ab256cb 4245 "Function called (if non-nil) to perform auto-fill.\n\
54158e68 4246It is called after self-inserting a space or newline.\n\
1ab256cb 4247Each buffer has its own value of this variable.\n\
54158e68
KH
4248NOTE: This variable is not a hook;\n\
4249its value may not be a list of functions.");
1ab256cb
RM
4250
4251 DEFVAR_PER_BUFFER ("buffer-file-name", &current_buffer->filename,
0fa3ba92 4252 make_number (Lisp_String),
1ab256cb
RM
4253 "Name of file visited in current buffer, or nil if not visiting a file.\n\
4254Each buffer has its own value of this variable.");
4255
f6ed2e84
RS
4256 DEFVAR_PER_BUFFER ("buffer-file-truename", &current_buffer->file_truename,
4257 make_number (Lisp_String),
bb4c204e 4258 "Abbreviated truename of file visited in current buffer, or nil if none.\n\
b1c03e64
RS
4259The truename of a file is calculated by `file-truename'\n\
4260and then abbreviated with `abbreviate-file-name'.\n\
f6ed2e84
RS
4261Each buffer has its own value of this variable.");
4262
1ab256cb 4263 DEFVAR_PER_BUFFER ("buffer-auto-save-file-name",
3f5fcd47 4264 &current_buffer->auto_save_file_name,
0fa3ba92 4265 make_number (Lisp_String),
1ab256cb
RM
4266 "Name of file for auto-saving current buffer,\n\
4267or nil if buffer should not be auto-saved.\n\
4268Each buffer has its own value of this variable.");
4269
0fa3ba92 4270 DEFVAR_PER_BUFFER ("buffer-read-only", &current_buffer->read_only, Qnil,
1ab256cb
RM
4271 "Non-nil if this buffer is read-only.\n\
4272Each buffer has its own value of this variable.");
4273
0fa3ba92 4274 DEFVAR_PER_BUFFER ("buffer-backed-up", &current_buffer->backed_up, Qnil,
1ab256cb
RM
4275 "Non-nil if this buffer's file has been backed up.\n\
4276Backing up is done before the first time the file is saved.\n\
4277Each buffer has its own value of this variable.");
4278
4279 DEFVAR_PER_BUFFER ("buffer-saved-size", &current_buffer->save_length,
0fa3ba92 4280 make_number (Lisp_Int),
1ab256cb
RM
4281 "Length of current buffer when last read in, saved or auto-saved.\n\
42820 initially.\n\
4283Each buffer has its own value of this variable.");
4284
4285 DEFVAR_PER_BUFFER ("selective-display", &current_buffer->selective_display,
0fa3ba92 4286 Qnil,
1ab256cb
RM
4287 "Non-nil enables selective display:\n\
4288Integer N as value means display only lines\n\
4289 that start with less than n columns of space.\n\
4290A value of t means, after a ^M, all the rest of the line is invisible.\n\
4291 Then ^M's in the file are written into files as newlines.\n\n\
4292Automatically becomes buffer-local when set in any fashion.");
4293
4294#ifndef old
4295 DEFVAR_PER_BUFFER ("selective-display-ellipses",
4296 &current_buffer->selective_display_ellipses,
0fa3ba92 4297 Qnil,
1ab256cb
RM
4298 "t means display ... on previous line when a line is invisible.\n\
4299Automatically becomes buffer-local when set in any fashion.");
4300#endif
4301
0fa3ba92 4302 DEFVAR_PER_BUFFER ("overwrite-mode", &current_buffer->overwrite_mode, Qnil,
1ab256cb 4303 "Non-nil if self-insertion should replace existing text.\n\
5e05d0a5
RS
4304The value should be one of `overwrite-mode-textual',\n\
4305`overwrite-mode-binary', or nil.\n\
4306If it is `overwrite-mode-textual', self-insertion still\n\
6bbb0d4a 4307inserts at the end of a line, and inserts when point is before a tab,\n\
2e94b813 4308until the tab is filled in.\n\
6bbb0d4a 4309If `overwrite-mode-binary', self-insertion replaces newlines and tabs too.\n\
1ab256cb
RM
4310Automatically becomes buffer-local when set in any fashion.");
4311
54939090
RS
4312#if 0 /* The doc string is too long for some compilers,
4313 but make-docfile can find it in this comment. */
1ab256cb 4314 DEFVAR_PER_BUFFER ("buffer-display-table", &current_buffer->display_table,
5d305367 4315 Qnil,
1ab256cb
RM
4316 "Display table that controls display of the contents of current buffer.\n\
4317Automatically becomes buffer-local when set in any fashion.\n\
6fdc249f
EN
4318The display table is a char-table created with `make-display-table'.\n\
4319The ordinary char-table elements control how to display each possible text\n\
4320character. Each value should be a vector of characters or nil;\n\
1ab256cb 4321nil means display the character in the default fashion.\n\
6fdc249f
EN
4322There are six extra slots to control the display of\n\
4323 the end of a truncated screen line (extra-slot 0, a single character);\n\
4324 the end of a continued line (extra-slot 1, a single character);\n\
6158b3b0 4325 the escape character used to display character codes in octal\n\
6fdc249f
EN
4326 (extra-slot 2, a single character);\n\
4327 the character used as an arrow for control characters (extra-slot 3,\n\
6158b3b0 4328 a single character);\n\
6fdc249f 4329 the decoration indicating the presence of invisible lines (extra-slot 4,\n\
a45e35e1
JB
4330 a vector of characters);\n\
4331 the character used to draw the border between side-by-side windows\n\
6fdc249f
EN
4332 (extra-slot 5, a single character).\n\
4333See also the functions `display-table-slot' and `set-display-table-slot'.\n\
1ab256cb
RM
4334If this variable is nil, the value of `standard-display-table' is used.\n\
4335Each window can have its own, overriding display table.");
54939090
RS
4336#endif
4337 DEFVAR_PER_BUFFER ("buffer-display-table", &current_buffer->display_table,
de15914a 4338 Qnil, 0);
1ab256cb 4339
1ab256cb
RM
4340/*DEFVAR_LISP ("debug-check-symbol", &Vcheck_symbol,
4341 "Don't ask.");
4342*/
01050cb5 4343 DEFVAR_LISP ("before-change-function", &Vbefore_change_function,
f0724bcb 4344 "If non-nil, a function to call before each text change (obsolete).\n\
1ab256cb
RM
4345Two arguments are passed to the function: the positions of\n\
4346the beginning and end of the range of old text to be changed.\n\
4347\(For an insertion, the beginning and end are at the same place.)\n\
4348No information is given about the length of the text after the change.\n\
1ab256cb 4349\n\
5f079267 4350Buffer changes made while executing the `before-change-function'\n\
b86344d0
RS
4351don't call any before-change or after-change functions.\n\
4352That's because these variables are temporarily set to nil.\n\
4353As a result, a hook function cannot straightforwardly alter the value of\n\
4354these variables. See the Emacs Lisp manual for a way of\n\
f0724bcb
RS
4355accomplishing an equivalent result by using other variables.\n\n\
4356This variable is obsolete; use `before-change-functions' instead.");
1ab256cb
RM
4357 Vbefore_change_function = Qnil;
4358
4359 DEFVAR_LISP ("after-change-function", &Vafter_change_function,
f0724bcb 4360 "If non-nil, a Function to call after each text change (obsolete).\n\
1ab256cb
RM
4361Three arguments are passed to the function: the positions of\n\
4362the beginning and end of the range of changed text,\n\
4363and the length of the pre-change text replaced by that range.\n\
4364\(For an insertion, the pre-change length is zero;\n\
839dd834 4365for a deletion, that length is the number of bytes deleted,\n\
1ab256cb
RM
4366and the post-change beginning and end are at the same place.)\n\
4367\n\
5f079267 4368Buffer changes made while executing the `after-change-function'\n\
b86344d0
RS
4369don't call any before-change or after-change functions.\n\
4370That's because these variables are temporarily set to nil.\n\
4371As a result, a hook function cannot straightforwardly alter the value of\n\
4372these variables. See the Emacs Lisp manual for a way of\n\
f0724bcb
RS
4373accomplishing an equivalent result by using other variables.\n\n\
4374This variable is obsolete; use `after-change-functions' instead.");
1ab256cb
RM
4375 Vafter_change_function = Qnil;
4376
5f079267
RS
4377 DEFVAR_LISP ("before-change-functions", &Vbefore_change_functions,
4378 "List of functions to call before each text change.\n\
4379Two arguments are passed to each function: the positions of\n\
4380the beginning and end of the range of old text to be changed.\n\
4381\(For an insertion, the beginning and end are at the same place.)\n\
4382No information is given about the length of the text after the change.\n\
5f079267
RS
4383\n\
4384Buffer changes made while executing the `before-change-functions'\n\
b86344d0
RS
4385don't call any before-change or after-change functions.\n\
4386That's because these variables are temporarily set to nil.\n\
4387As a result, a hook function cannot straightforwardly alter the value of\n\
4388these variables. See the Emacs Lisp manual for a way of\n\
d59698c4 4389accomplishing an equivalent result by using other variables.");
5f079267
RS
4390 Vbefore_change_functions = Qnil;
4391
4392 DEFVAR_LISP ("after-change-functions", &Vafter_change_functions,
4393 "List of function to call after each text change.\n\
4394Three arguments are passed to each function: the positions of\n\
4395the beginning and end of the range of changed text,\n\
839dd834 4396and the length in bytes of the pre-change text replaced by that range.\n\
5f079267 4397\(For an insertion, the pre-change length is zero;\n\
839dd834 4398for a deletion, that length is the number of bytes deleted,\n\
5f079267
RS
4399and the post-change beginning and end are at the same place.)\n\
4400\n\
4401Buffer changes made while executing the `after-change-functions'\n\
b86344d0
RS
4402don't call any before-change or after-change functions.\n\
4403That's because these variables are temporarily set to nil.\n\
4404As a result, a hook function cannot straightforwardly alter the value of\n\
4405these variables. See the Emacs Lisp manual for a way of\n\
d59698c4 4406accomplishing an equivalent result by using other variables.");
b86344d0 4407
5f079267
RS
4408 Vafter_change_functions = Qnil;
4409
dbc4e1c1
JB
4410 DEFVAR_LISP ("first-change-hook", &Vfirst_change_hook,
4411 "A list of functions to call before changing a buffer which is unmodified.\n\
4412The functions are run using the `run-hooks' function.");
4413 Vfirst_change_hook = Qnil;
1ab256cb 4414
54939090
RS
4415#if 0 /* The doc string is too long for some compilers,
4416 but make-docfile can find it in this comment. */
3f5fcd47 4417 DEFVAR_PER_BUFFER ("buffer-undo-list", &current_buffer->undo_list, Qnil,
1ab256cb
RM
4418 "List of undo entries in current buffer.\n\
4419Recent changes come first; older changes follow newer.\n\
4420\n\
630f4018
KH
4421An entry (BEG . END) represents an insertion which begins at\n\
4422position BEG and ends at position END.\n\
1ab256cb
RM
4423\n\
4424An entry (TEXT . POSITION) represents the deletion of the string TEXT\n\
4425from (abs POSITION). If POSITION is positive, point was at the front\n\
4426of the text being deleted; if negative, point was at the end.\n\
4427\n\
6c0df54a
RS
4428An entry (t HIGH . LOW) indicates that the buffer previously had\n\
4429\"unmodified\" status. HIGH and LOW are the high and low 16-bit portions\n\
4430of the visited file's modification time, as of that time. If the\n\
4431modification time of the most recent save is different, this entry is\n\
1ab256cb
RM
4432obsolete.\n\
4433\n\
6c0df54a
RS
4434An entry (nil PROPERTY VALUE BEG . END) indicates that a text property\n\
4435was modified between BEG and END. PROPERTY is the property name,\n\
4436and VALUE is the old value.\n\
483c1fd3 4437\n\
da1c183c
RS
4438An entry (MARKER . DISTANCE) indicates that the marker MARKER\n\
4439was adjusted in position by the offset DISTANCE (an integer).\n\
4440\n\
bec44fd6
JB
4441An entry of the form POSITION indicates that point was at the buffer\n\
4442location given by the integer. Undoing an entry of this form places\n\
4443point at POSITION.\n\
4444\n\
1ab256cb
RM
4445nil marks undo boundaries. The undo command treats the changes\n\
4446between two undo boundaries as a single step to be undone.\n\
4447\n\
bec44fd6 4448If the value of the variable is t, undo information is not recorded.");
54939090
RS
4449#endif
4450 DEFVAR_PER_BUFFER ("buffer-undo-list", &current_buffer->undo_list, Qnil,
de15914a 4451 0);
1ab256cb 4452
c48f61ef
RS
4453 DEFVAR_PER_BUFFER ("mark-active", &current_buffer->mark_active, Qnil,
4454 "Non-nil means the mark and region are currently active in this buffer.\n\
4455Automatically local in all buffers.");
4456
28e969dd 4457 DEFVAR_PER_BUFFER ("cache-long-line-scans", &current_buffer->cache_long_line_scans, Qnil,
f0c5b712
JB
4458 "Non-nil means that Emacs should use caches to handle long lines more quickly.\n\
4459This variable is buffer-local, in all buffers.\n\
28e969dd 4460\n\
f0c5b712
JB
4461Normally, the line-motion functions work by scanning the buffer for\n\
4462newlines. Columnar operations (like move-to-column and\n\
4463compute-motion) also work by scanning the buffer, summing character\n\
4464widths as they go. This works well for ordinary text, but if the\n\
28e969dd 4465buffer's lines are very long (say, more than 500 characters), these\n\
f0c5b712
JB
4466motion functions will take longer to execute. Emacs may also take\n\
4467longer to update the display.\n\
28e969dd 4468\n\
f0c5b712
JB
4469If cache-long-line-scans is non-nil, these motion functions cache the\n\
4470results of their scans, and consult the cache to avoid rescanning\n\
4471regions of the buffer until the text is modified. The caches are most\n\
4472beneficial when they prevent the most searching---that is, when the\n\
4473buffer contains long lines and large regions of characters with the\n\
4474same, fixed screen width.\n\
28e969dd 4475\n\
f0c5b712
JB
4476When cache-long-line-scans is non-nil, processing short lines will\n\
4477become slightly slower (because of the overhead of consulting the\n\
4478cache), and the caches will use memory roughly proportional to the\n\
4479number of newlines and characters whose screen width varies.\n\
4480\n\
4481The caches require no explicit maintenance; their accuracy is\n\
4482maintained internally by the Emacs primitives. Enabling or disabling\n\
4483the cache should not affect the behavior of any of the motion\n\
4484functions; it should only affect their performance.");
28e969dd 4485
943e065b
RS
4486 DEFVAR_PER_BUFFER ("point-before-scroll", &current_buffer->point_before_scroll, Qnil,
4487 "Value of point before the last series of scroll operations, or nil.");
4488
be9aafdd
BG
4489 DEFVAR_PER_BUFFER ("buffer-file-format", &current_buffer->file_format, Qnil,
4490 "List of formats to use when saving this buffer.\n\
4491Formats are defined by `format-alist'. This variable is\n\
4492set when a file is visited. Automatically local in all buffers.");
4493
3cb719bd
RS
4494 DEFVAR_PER_BUFFER ("buffer-invisibility-spec",
4495 &current_buffer->invisibility_spec, Qnil,
4496 "Invisibility spec of this buffer.\n\
4497The default is t, which means that text is invisible\n\
4498if it has a non-nil `invisible' property.\n\
4499If the value is a list, a text character is invisible if its `invisible'\n\
4500property is an element in that list.\n\
554216ad
KH
4501If an element is a cons cell of the form (PROP . ELLIPSIS),\n\
4502then characters with property value PROP are invisible,\n\
3cb719bd
RS
4503and they have an ellipsis as well if ELLIPSIS is non-nil.");
4504
7962a441
RS
4505 DEFVAR_PER_BUFFER ("buffer-display-count",
4506 &current_buffer->display_count, Qnil,
4507 "A number incremented each time the buffer is displayed in a window.");
4508
c48f61ef 4509 DEFVAR_LISP ("transient-mark-mode", &Vtransient_mark_mode,
319c537c
RS
4510 "*Non-nil means deactivate the mark when the buffer contents change.\n\
4511Non-nil also enables highlighting of the region whenever the mark is active.\n\
4512The variable `highlight-nonselected-windows' controls whether to highlight\n\
4513all windows or just the selected window.");
c48f61ef
RS
4514 Vtransient_mark_mode = Qnil;
4515
0a4469c9 4516 DEFVAR_LISP ("inhibit-read-only", &Vinhibit_read_only,
a96b68f1
RS
4517 "*Non-nil means disregard read-only status of buffers or characters.\n\
4518If the value is t, disregard `buffer-read-only' and all `read-only'\n\
4519text properties. If the value is a list, disregard `buffer-read-only'\n\
4520and disregard a `read-only' text property if the property value\n\
4521is a member of the list.");
4522 Vinhibit_read_only = Qnil;
4523
dcdffbf6
RS
4524 DEFVAR_LISP ("kill-buffer-query-functions", &Vkill_buffer_query_functions,
4525 "List of functions called with no args to query before killing a buffer.");
4526 Vkill_buffer_query_functions = Qnil;
4527
0dc88e60 4528 defsubr (&Sbuffer_live_p);
1ab256cb
RM
4529 defsubr (&Sbuffer_list);
4530 defsubr (&Sget_buffer);
4531 defsubr (&Sget_file_buffer);
4532 defsubr (&Sget_buffer_create);
336cd056 4533 defsubr (&Smake_indirect_buffer);
01050cb5 4534 defsubr (&Sgenerate_new_buffer_name);
1ab256cb
RM
4535 defsubr (&Sbuffer_name);
4536/*defsubr (&Sbuffer_number);*/
4537 defsubr (&Sbuffer_file_name);
336cd056 4538 defsubr (&Sbuffer_base_buffer);
1ab256cb
RM
4539 defsubr (&Sbuffer_local_variables);
4540 defsubr (&Sbuffer_modified_p);
4541 defsubr (&Sset_buffer_modified_p);
4542 defsubr (&Sbuffer_modified_tick);
4543 defsubr (&Srename_buffer);
4544 defsubr (&Sother_buffer);
4545 defsubr (&Sbuffer_disable_undo);
4546 defsubr (&Sbuffer_enable_undo);
4547 defsubr (&Skill_buffer);
a9ee7a59 4548 defsubr (&Sset_buffer_major_mode);
1ab256cb
RM
4549 defsubr (&Sswitch_to_buffer);
4550 defsubr (&Spop_to_buffer);
4551 defsubr (&Scurrent_buffer);
4552 defsubr (&Sset_buffer);
4553 defsubr (&Sbarf_if_buffer_read_only);
4554 defsubr (&Sbury_buffer);
3ac81adb
RS
4555 defsubr (&Serase_buffer);
4556 defsubr (&Sset_buffer_multibyte);
1ab256cb 4557 defsubr (&Skill_all_local_variables);
2eec3b4e 4558
52f8ec73 4559 defsubr (&Soverlayp);
2eec3b4e
RS
4560 defsubr (&Smake_overlay);
4561 defsubr (&Sdelete_overlay);
4562 defsubr (&Smove_overlay);
8ebafa8d
JB
4563 defsubr (&Soverlay_start);
4564 defsubr (&Soverlay_end);
4565 defsubr (&Soverlay_buffer);
4566 defsubr (&Soverlay_properties);
2eec3b4e 4567 defsubr (&Soverlays_at);
74514898 4568 defsubr (&Soverlays_in);
2eec3b4e 4569 defsubr (&Snext_overlay_change);
239c932b 4570 defsubr (&Sprevious_overlay_change);
2eec3b4e
RS
4571 defsubr (&Soverlay_recenter);
4572 defsubr (&Soverlay_lists);
4573 defsubr (&Soverlay_get);
4574 defsubr (&Soverlay_put);
1ab256cb
RM
4575}
4576
dfcf069d 4577void
1ab256cb
RM
4578keys_of_buffer ()
4579{
4580 initial_define_key (control_x_map, 'b', "switch-to-buffer");
4581 initial_define_key (control_x_map, 'k', "kill-buffer");
4158c17d
RM
4582
4583 /* This must not be in syms_of_buffer, because Qdisabled is not
4584 initialized when that function gets called. */
4585 Fput (intern ("erase-buffer"), Qdisabled, Qt);
1ab256cb 4586}