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