(completion-setup-function): Add mouse-face properties.
[bpt/emacs.git] / src / buffer.c
CommitLineData
1ab256cb 1/* Buffer manipulation primitives for GNU Emacs.
4158c17d 2 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994
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
19the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
20
21
2381d133
JB
22#include <sys/types.h>
23#include <sys/stat.h>
1ab256cb
RM
24#include <sys/param.h>
25
26#ifndef MAXPATHLEN
27/* in 4.1, param.h fails to define this. */
28#define MAXPATHLEN 1024
29#endif /* not MAXPATHLEN */
30
18160b98 31#include <config.h>
1ab256cb 32#include "lisp.h"
21cf4cf8 33#include "intervals.h"
1ab256cb
RM
34#include "window.h"
35#include "commands.h"
36#include "buffer.h"
1ab256cb 37#include "indent.h"
d014bf88 38#include "blockinput.h"
1ab256cb
RM
39
40struct buffer *current_buffer; /* the current buffer */
41
42/* First buffer in chain of all buffers (in reverse order of creation).
43 Threaded through ->next. */
44
45struct buffer *all_buffers;
46
47/* This structure holds the default values of the buffer-local variables
48 defined with DEFVAR_PER_BUFFER, that have special slots in each buffer.
49 The default value occupies the same slot in this structure
50 as an individual buffer's value occupies in that buffer.
51 Setting the default value also goes through the alist of buffers
52 and stores into each buffer that does not say it has a local value. */
53
54struct buffer buffer_defaults;
55
56/* A Lisp_Object pointer to the above, used for staticpro */
57
58static Lisp_Object Vbuffer_defaults;
59
60/* This structure marks which slots in a buffer have corresponding
61 default values in buffer_defaults.
62 Each such slot has a nonzero value in this structure.
63 The value has only one nonzero bit.
64
65 When a buffer has its own local value for a slot,
66 the bit for that slot (found in the same slot in this structure)
67 is turned on in the buffer's local_var_flags slot.
68
69 If a slot in this structure is -1, then even though there may
70 be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
71 and the corresponding slot in buffer_defaults is not used.
72
73 If a slot is -2, then there is no DEFVAR_PER_BUFFER for it,
74 but there is a default value which is copied into each buffer.
75
76 If a slot in this structure is negative, then even though there may
77 be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
78 and the corresponding slot in buffer_defaults is not used.
79
80 If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is
81 zero, that is a bug */
82
83struct buffer buffer_local_flags;
84
85/* This structure holds the names of symbols whose values may be
86 buffer-local. It is indexed and accessed in the same way as the above. */
87
88struct buffer buffer_local_symbols;
89/* A Lisp_Object pointer to the above, used for staticpro */
90static Lisp_Object Vbuffer_local_symbols;
91
0fa3ba92
JB
92/* This structure holds the required types for the values in the
93 buffer-local slots. If a slot contains Qnil, then the
94 corresponding buffer slot may contain a value of any type. If a
95 slot contains an integer, then prospective values' tags must be
96 equal to that integer. When a tag does not match, the function
97 buffer_slot_type_mismatch will signal an error. */
98struct buffer buffer_local_types;
99
1ab256cb 100Lisp_Object Fset_buffer ();
01050cb5 101void set_buffer_internal ();
173f2a64 102static void call_overlay_mod_hooks ();
1ab256cb
RM
103
104/* Alist of all buffer names vs the buffers. */
105/* This used to be a variable, but is no longer,
106 to prevent lossage due to user rplac'ing this alist or its elements. */
107Lisp_Object Vbuffer_alist;
108
109/* Functions to call before and after each text change. */
110Lisp_Object Vbefore_change_function;
111Lisp_Object Vafter_change_function;
112
c48f61ef
RS
113Lisp_Object Vtransient_mark_mode;
114
a96b68f1
RS
115/* t means ignore all read-only text properties.
116 A list means ignore such a property if its value is a member of the list.
117 Any non-nil value means ignore buffer-read-only. */
118Lisp_Object Vinhibit_read_only;
119
dcdffbf6
RS
120/* List of functions to call that can query about killing a buffer.
121 If any of these functions returns nil, we don't kill it. */
122Lisp_Object Vkill_buffer_query_functions;
123
dbc4e1c1
JB
124/* List of functions to call before changing an unmodified buffer. */
125Lisp_Object Vfirst_change_hook;
126Lisp_Object Qfirst_change_hook;
1ab256cb
RM
127
128Lisp_Object Qfundamental_mode, Qmode_class, Qpermanent_local;
129
130Lisp_Object Qprotected_field;
131
132Lisp_Object QSFundamental; /* A string "Fundamental" */
133
134Lisp_Object Qkill_buffer_hook;
135
5fe0b67e
RS
136Lisp_Object Qget_file_buffer;
137
52f8ec73
JB
138Lisp_Object Qoverlayp;
139
5985d248
KH
140Lisp_Object Qpriority, Qwindow;
141
294d215f
RS
142Lisp_Object Qmodification_hooks;
143Lisp_Object Qinsert_in_front_hooks;
144Lisp_Object Qinsert_behind_hooks;
145
1ab256cb
RM
146/* For debugging; temporary. See set_buffer_internal. */
147/* Lisp_Object Qlisp_mode, Vcheck_symbol; */
148
54ad07d3
RS
149#ifdef MSDOS
150Lisp_Object Qbuffer_file_type;
151#endif
152
1ab256cb
RM
153nsberror (spec)
154 Lisp_Object spec;
155{
156 if (XTYPE (spec) == Lisp_String)
157 error ("No buffer named %s", XSTRING (spec)->data);
158 error ("Invalid buffer argument");
159}
160\f
161DEFUN ("buffer-list", Fbuffer_list, Sbuffer_list, 0, 0, 0,
162 "Return a list of all existing live buffers.")
163 ()
164{
165 return Fmapcar (Qcdr, Vbuffer_alist);
166}
167
168DEFUN ("get-buffer", Fget_buffer, Sget_buffer, 1, 1, 0,
169 "Return the buffer named NAME (a string).\n\
170If there is no live buffer named NAME, return nil.\n\
171NAME may also be a buffer; if so, the value is that buffer.")
172 (name)
173 register Lisp_Object name;
174{
175 if (XTYPE (name) == Lisp_Buffer)
176 return name;
177 CHECK_STRING (name, 0);
178
179 return Fcdr (Fassoc (name, Vbuffer_alist));
180}
181
182DEFUN ("get-file-buffer", Fget_file_buffer, Sget_file_buffer, 1, 1, 0,
183 "Return the buffer visiting file FILENAME (a string).\n\
92194d02 184The buffer's `buffer-file-name' must match exactly the expansion of FILENAME.\n\
1ab256cb
RM
185If there is no such live buffer, return nil.")
186 (filename)
187 register Lisp_Object filename;
188{
189 register Lisp_Object tail, buf, tem;
5fe0b67e
RS
190 Lisp_Object handler;
191
1ab256cb
RM
192 CHECK_STRING (filename, 0);
193 filename = Fexpand_file_name (filename, Qnil);
194
5fe0b67e
RS
195 /* If the file name has special constructs in it,
196 call the corresponding file handler. */
197 handler = Ffind_file_name_handler (filename);
198 if (!NILP (handler))
199 return call2 (handler, Qget_file_buffer, filename);
200
1ab256cb
RM
201 for (tail = Vbuffer_alist; CONSP (tail); tail = XCONS (tail)->cdr)
202 {
203 buf = Fcdr (XCONS (tail)->car);
204 if (XTYPE (buf) != Lisp_Buffer) continue;
205 if (XTYPE (XBUFFER (buf)->filename) != Lisp_String) continue;
206 tem = Fstring_equal (XBUFFER (buf)->filename, filename);
265a9e55 207 if (!NILP (tem))
1ab256cb
RM
208 return buf;
209 }
210 return Qnil;
211}
212
213/* Incremented for each buffer created, to assign the buffer number. */
214int buffer_count;
215
216DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 1, 0,
217 "Return the buffer named NAME, or create such a buffer and return it.\n\
218A new buffer is created if there is no live buffer named NAME.\n\
b44895bc 219If NAME starts with a space, the new buffer does not keep undo information.\n\
1ab256cb
RM
220If NAME is a buffer instead of a string, then it is the value returned.\n\
221The value is never nil.")
222 (name)
223 register Lisp_Object name;
224{
225 register Lisp_Object buf, function, tem;
226 int count = specpdl_ptr - specpdl;
227 register struct buffer *b;
228
229 buf = Fget_buffer (name);
265a9e55 230 if (!NILP (buf))
1ab256cb
RM
231 return buf;
232
9ac0d9e0 233 b = (struct buffer *) xmalloc (sizeof (struct buffer));
1ab256cb
RM
234
235 BUF_GAP_SIZE (b) = 20;
9ac0d9e0 236 BLOCK_INPUT;
1ab256cb 237 BUFFER_ALLOC (BUF_BEG_ADDR (b), BUF_GAP_SIZE (b));
9ac0d9e0 238 UNBLOCK_INPUT;
1ab256cb
RM
239 if (! BUF_BEG_ADDR (b))
240 memory_full ();
241
242 BUF_PT (b) = 1;
243 BUF_GPT (b) = 1;
244 BUF_BEGV (b) = 1;
245 BUF_ZV (b) = 1;
246 BUF_Z (b) = 1;
247 BUF_MODIFF (b) = 1;
248
249 /* Put this on the chain of all buffers including killed ones. */
250 b->next = all_buffers;
251 all_buffers = b;
252
253 b->mark = Fmake_marker ();
254 /*b->number = make_number (++buffer_count);*/
255 b->name = name;
256 if (XSTRING (name)->data[0] != ' ')
257 b->undo_list = Qnil;
258 else
259 b->undo_list = Qt;
260
261 reset_buffer (b);
262
263 /* Put this in the alist of all live buffers. */
264 XSET (buf, Lisp_Buffer, b);
265 Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));
266
267 b->mark = Fmake_marker ();
268 b->markers = Qnil;
269 b->name = name;
270
271 function = buffer_defaults.major_mode;
265a9e55 272 if (NILP (function))
1ab256cb
RM
273 {
274 tem = Fget (current_buffer->major_mode, Qmode_class);
275 if (EQ (tem, Qnil))
276 function = current_buffer->major_mode;
277 }
278
265a9e55 279 if (NILP (function) || EQ (function, Qfundamental_mode))
1ab256cb
RM
280 return buf;
281
282 /* To select a nonfundamental mode,
283 select the buffer temporarily and then call the mode function. */
284
285 record_unwind_protect (save_excursion_restore, save_excursion_save ());
286
287 Fset_buffer (buf);
288 call0 (function);
289
290 return unbind_to (count, buf);
291}
292
293/* Reinitialize everything about a buffer except its name and contents. */
294
295void
296reset_buffer (b)
297 register struct buffer *b;
298{
299 b->filename = Qnil;
300 b->directory = (current_buffer) ? current_buffer->directory : Qnil;
301 b->modtime = 0;
302 b->save_modified = 1;
291026b5 303 XFASTINT (b->save_length) = 0;
1ab256cb
RM
304 b->last_window_start = 1;
305 b->backed_up = Qnil;
306 b->auto_save_modified = 0;
84f6bcba 307 b->auto_save_failure_time = -1;
1ab256cb
RM
308 b->auto_save_file_name = Qnil;
309 b->read_only = Qnil;
2eec3b4e
RS
310 b->overlays_before = Qnil;
311 b->overlays_after = Qnil;
312 XFASTINT (b->overlay_center) = 1;
dfda7a7f 313 b->mark_active = Qnil;
33f7013e
JA
314
315 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
316 INITIALIZE_INTERVAL (b, NULL_INTERVAL);
317
1ab256cb
RM
318 reset_buffer_local_variables(b);
319}
320
c48f61ef 321reset_buffer_local_variables (b)
1ab256cb
RM
322 register struct buffer *b;
323{
324 register int offset;
325
326 /* Reset the major mode to Fundamental, together with all the
327 things that depend on the major mode.
328 default-major-mode is handled at a higher level.
329 We ignore it here. */
330 b->major_mode = Qfundamental_mode;
331 b->keymap = Qnil;
332 b->abbrev_table = Vfundamental_mode_abbrev_table;
333 b->mode_name = QSFundamental;
334 b->minor_modes = Qnil;
335 b->downcase_table = Vascii_downcase_table;
336 b->upcase_table = Vascii_upcase_table;
337 b->case_canon_table = Vascii_downcase_table;
338 b->case_eqv_table = Vascii_upcase_table;
339#if 0
340 b->sort_table = XSTRING (Vascii_sort_table);
341 b->folding_sort_table = XSTRING (Vascii_folding_sort_table);
342#endif /* 0 */
343
344 /* Reset all per-buffer variables to their defaults. */
345 b->local_var_alist = Qnil;
346 b->local_var_flags = 0;
347
348 /* For each slot that has a default value,
349 copy that into the slot. */
350
351 for (offset = (char *)&buffer_local_flags.name - (char *)&buffer_local_flags;
352 offset < sizeof (struct buffer);
353 offset += sizeof (Lisp_Object)) /* sizeof int == sizeof Lisp_Object */
354 if (*(int *)(offset + (char *) &buffer_local_flags) > 0
355 || *(int *)(offset + (char *) &buffer_local_flags) == -2)
356 *(Lisp_Object *)(offset + (char *)b) =
357 *(Lisp_Object *)(offset + (char *)&buffer_defaults);
358}
359
01050cb5
RM
360/* We split this away from generate-new-buffer, because rename-buffer
361 and set-visited-file-name ought to be able to use this to really
362 rename the buffer properly. */
363
364DEFUN ("generate-new-buffer-name", Fgenerate_new_buffer_name, Sgenerate_new_buffer_name,
c273e647 365 1, 2, 0,
01050cb5
RM
366 "Return a string that is the name of no existing buffer based on NAME.\n\
367If there is no live buffer named NAME, then return NAME.\n\
1ab256cb 368Otherwise modify name by appending `<NUMBER>', incrementing NUMBER\n\
c273e647 369until an unused name is found, and then return that name.\n\
03bdd54c 370Optional second argument IGNORE specifies a name that is okay to use\n\
c273e647 371\(if it is in the sequence to be tried)\n\
e8b3a22d 372even if a buffer with that name exists.")
c273e647
RS
373 (name, ignore)
374 register Lisp_Object name, ignore;
1ab256cb
RM
375{
376 register Lisp_Object gentemp, tem;
377 int count;
378 char number[10];
379
380 CHECK_STRING (name, 0);
381
382 tem = Fget_buffer (name);
265a9e55 383 if (NILP (tem))
01050cb5 384 return name;
1ab256cb
RM
385
386 count = 1;
387 while (1)
388 {
389 sprintf (number, "<%d>", ++count);
390 gentemp = concat2 (name, build_string (number));
638e4fc3 391 tem = Fstring_equal (gentemp, ignore);
c273e647
RS
392 if (!NILP (tem))
393 return gentemp;
1ab256cb 394 tem = Fget_buffer (gentemp);
265a9e55 395 if (NILP (tem))
01050cb5 396 return gentemp;
1ab256cb
RM
397 }
398}
399
400\f
401DEFUN ("buffer-name", Fbuffer_name, Sbuffer_name, 0, 1, 0,
402 "Return the name of BUFFER, as a string.\n\
01050cb5 403With no argument or nil as argument, return the name of the current buffer.")
1ab256cb
RM
404 (buffer)
405 register Lisp_Object buffer;
406{
265a9e55 407 if (NILP (buffer))
1ab256cb
RM
408 return current_buffer->name;
409 CHECK_BUFFER (buffer, 0);
410 return XBUFFER (buffer)->name;
411}
412
413DEFUN ("buffer-file-name", Fbuffer_file_name, Sbuffer_file_name, 0, 1, 0,
414 "Return name of file BUFFER is visiting, or nil if none.\n\
415No argument or nil as argument means use the current buffer.")
416 (buffer)
417 register Lisp_Object buffer;
418{
265a9e55 419 if (NILP (buffer))
1ab256cb
RM
420 return current_buffer->filename;
421 CHECK_BUFFER (buffer, 0);
422 return XBUFFER (buffer)->filename;
423}
424
425DEFUN ("buffer-local-variables", Fbuffer_local_variables,
426 Sbuffer_local_variables, 0, 1, 0,
427 "Return an alist of variables that are buffer-local in BUFFER.\n\
553defa4
RS
428Most elements look like (SYMBOL . VALUE), describing one variable.\n\
429For a symbol that is locally unbound, just the symbol appears in the value.\n\
1ab256cb
RM
430Note that storing new VALUEs in these elements doesn't change the variables.\n\
431No argument or nil as argument means use current buffer as BUFFER.")
432 (buffer)
433 register Lisp_Object buffer;
434{
435 register struct buffer *buf;
553defa4 436 register Lisp_Object result;
1ab256cb 437
265a9e55 438 if (NILP (buffer))
1ab256cb
RM
439 buf = current_buffer;
440 else
441 {
442 CHECK_BUFFER (buffer, 0);
443 buf = XBUFFER (buffer);
444 }
445
553defa4
RS
446 result = Qnil;
447
1ab256cb
RM
448 {
449 /* Reference each variable in the alist in our current buffer.
450 If inquiring about the current buffer, this gets the current values,
451 so store them into the alist so the alist is up to date.
452 If inquiring about some other buffer, this swaps out any values
453 for that buffer, making the alist up to date automatically. */
553defa4
RS
454 register Lisp_Object tail;
455 for (tail = buf->local_var_alist; CONSP (tail); tail = XCONS (tail)->cdr)
1ab256cb 456 {
553defa4
RS
457 Lisp_Object val, elt;
458
459 elt = XCONS (tail)->car;
460
1ab256cb 461 if (buf == current_buffer)
553defa4
RS
462 val = find_symbol_value (XCONS (elt)->car);
463 else
464 val = XCONS (elt)->cdr;
465
466 /* If symbol is unbound, put just the symbol in the list. */
467 if (EQ (val, Qunbound))
468 result = Fcons (XCONS (elt)->car, result);
469 /* Otherwise, put (symbol . value) in the list. */
470 else
471 result = Fcons (Fcons (XCONS (elt)->car, val), result);
1ab256cb
RM
472 }
473 }
474
1ab256cb
RM
475 /* Add on all the variables stored in special slots. */
476 {
477 register int offset, mask;
478
479 for (offset = (char *)&buffer_local_symbols.name - (char *)&buffer_local_symbols;
480 offset < sizeof (struct buffer);
481 offset += (sizeof (int))) /* sizeof int == sizeof Lisp_Object */
482 {
483 mask = *(int *)(offset + (char *) &buffer_local_flags);
484 if (mask == -1 || (buf->local_var_flags & mask))
485 if (XTYPE (*(Lisp_Object *)(offset + (char *)&buffer_local_symbols))
486 == Lisp_Symbol)
553defa4
RS
487 result = Fcons (Fcons (*(Lisp_Object *)(offset + (char *)&buffer_local_symbols),
488 *(Lisp_Object *)(offset + (char *)buf)),
489 result);
1ab256cb
RM
490 }
491 }
553defa4
RS
492
493 return result;
1ab256cb
RM
494}
495
496\f
497DEFUN ("buffer-modified-p", Fbuffer_modified_p, Sbuffer_modified_p,
498 0, 1, 0,
499 "Return t if BUFFER was modified since its file was last read or saved.\n\
500No argument or nil as argument means use current buffer as BUFFER.")
501 (buffer)
502 register Lisp_Object buffer;
503{
504 register struct buffer *buf;
265a9e55 505 if (NILP (buffer))
1ab256cb
RM
506 buf = current_buffer;
507 else
508 {
509 CHECK_BUFFER (buffer, 0);
510 buf = XBUFFER (buffer);
511 }
512
513 return buf->save_modified < BUF_MODIFF (buf) ? Qt : Qnil;
514}
515
516DEFUN ("set-buffer-modified-p", Fset_buffer_modified_p, Sset_buffer_modified_p,
517 1, 1, 0,
518 "Mark current buffer as modified or unmodified according to FLAG.\n\
519A non-nil FLAG means mark the buffer modified.")
520 (flag)
521 register Lisp_Object flag;
522{
523 register int already;
524 register Lisp_Object fn;
525
526#ifdef CLASH_DETECTION
527 /* If buffer becoming modified, lock the file.
528 If buffer becoming unmodified, unlock the file. */
529
530 fn = current_buffer->filename;
265a9e55 531 if (!NILP (fn))
1ab256cb
RM
532 {
533 already = current_buffer->save_modified < MODIFF;
265a9e55 534 if (!already && !NILP (flag))
1ab256cb 535 lock_file (fn);
265a9e55 536 else if (already && NILP (flag))
1ab256cb
RM
537 unlock_file (fn);
538 }
539#endif /* CLASH_DETECTION */
540
265a9e55 541 current_buffer->save_modified = NILP (flag) ? MODIFF : 0;
1ab256cb
RM
542 update_mode_lines++;
543 return flag;
544}
545
546DEFUN ("buffer-modified-tick", Fbuffer_modified_tick, Sbuffer_modified_tick,
547 0, 1, 0,
548 "Return BUFFER's tick counter, incremented for each change in text.\n\
549Each buffer has a tick counter which is incremented each time the text in\n\
550that buffer is changed. It wraps around occasionally.\n\
551No argument or nil as argument means use current buffer as BUFFER.")
552 (buffer)
553 register Lisp_Object buffer;
554{
555 register struct buffer *buf;
265a9e55 556 if (NILP (buffer))
1ab256cb
RM
557 buf = current_buffer;
558 else
559 {
560 CHECK_BUFFER (buffer, 0);
561 buf = XBUFFER (buffer);
562 }
563
564 return make_number (BUF_MODIFF (buf));
565}
566\f
01050cb5 567DEFUN ("rename-buffer", Frename_buffer, Srename_buffer, 1, 2,
4c7e5f09 568 "sRename buffer (to new name): \nP",
1ab256cb 569 "Change current buffer's name to NEWNAME (a string).\n\
3bd779aa 570If second arg UNIQUE is nil or omitted, it is an error if a\n\
01050cb5 571buffer named NEWNAME already exists.\n\
3bd779aa 572If UNIQUE is non-nil, come up with a new name using\n\
01050cb5 573`generate-new-buffer-name'.\n\
3bd779aa
RS
574Interactively, you can set UNIQUE with a prefix argument.\n\
575We return the name we actually gave the buffer.\n\
1ab256cb 576This does not change the name of the visited file (if any).")
3bd779aa
RS
577 (name, unique)
578 register Lisp_Object name, unique;
1ab256cb
RM
579{
580 register Lisp_Object tem, buf;
581
582 CHECK_STRING (name, 0);
583 tem = Fget_buffer (name);
c059b5ea
RM
584 /* Don't short-circuit if UNIQUE is t. That is a useful way to rename
585 the buffer automatically so you can create another with the original name.
586 It makes UNIQUE equivalent to
587 (rename-buffer (generate-new-buffer-name NAME)). */
588 if (NILP (unique) && XBUFFER (tem) == current_buffer)
01050cb5 589 return current_buffer->name;
265a9e55 590 if (!NILP (tem))
01050cb5 591 {
3bd779aa 592 if (!NILP (unique))
c273e647 593 name = Fgenerate_new_buffer_name (name, current_buffer->name);
01050cb5
RM
594 else
595 error ("Buffer name \"%s\" is in use", XSTRING (name)->data);
596 }
1ab256cb
RM
597
598 current_buffer->name = name;
76f590d7
JB
599
600 /* Catch redisplay's attention. Unless we do this, the mode lines for
601 any windows displaying current_buffer will stay unchanged. */
602 update_mode_lines++;
603
1ab256cb
RM
604 XSET (buf, Lisp_Buffer, current_buffer);
605 Fsetcar (Frassq (buf, Vbuffer_alist), name);
265a9e55 606 if (NILP (current_buffer->filename) && !NILP (current_buffer->auto_save_file_name))
1ab256cb 607 call0 (intern ("rename-auto-save-file"));
01050cb5 608 return name;
1ab256cb
RM
609}
610
a0ebb746 611DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 2, 0,
1ab256cb 612 "Return most recently selected buffer other than BUFFER.\n\
a0ebb746
JB
613Buffers not visible in windows are preferred to visible buffers,\n\
614unless optional second argument VISIBLE-OK is non-nil.\n\
1ab256cb
RM
615If no other buffer exists, the buffer `*scratch*' is returned.\n\
616If BUFFER is omitted or nil, some interesting buffer is returned.")
a0ebb746
JB
617 (buffer, visible_ok)
618 register Lisp_Object buffer, visible_ok;
1ab256cb
RM
619{
620 register Lisp_Object tail, buf, notsogood, tem;
621 notsogood = Qnil;
622
265a9e55 623 for (tail = Vbuffer_alist; !NILP (tail); tail = Fcdr (tail))
1ab256cb
RM
624 {
625 buf = Fcdr (Fcar (tail));
626 if (EQ (buf, buffer))
627 continue;
628 if (XSTRING (XBUFFER (buf)->name)->data[0] == ' ')
629 continue;
a0ebb746 630 if (NILP (visible_ok))
db732e5a 631 tem = Fget_buffer_window (buf, Qt);
a0ebb746
JB
632 else
633 tem = Qnil;
265a9e55 634 if (NILP (tem))
1ab256cb 635 return buf;
265a9e55 636 if (NILP (notsogood))
1ab256cb
RM
637 notsogood = buf;
638 }
265a9e55 639 if (!NILP (notsogood))
1ab256cb
RM
640 return notsogood;
641 return Fget_buffer_create (build_string ("*scratch*"));
642}
643\f
5b8bcf48 644DEFUN ("buffer-disable-undo", Fbuffer_disable_undo, Sbuffer_disable_undo, 0, 1,
1ab256cb 6450,
5b8bcf48
RS
646 "Make BUFFER stop keeping undo information.\n\
647No argument or nil as argument means do this for the current buffer.")
ffd56f97
JB
648 (buffer)
649 register Lisp_Object buffer;
1ab256cb 650{
ffd56f97
JB
651 Lisp_Object real_buffer;
652
653 if (NILP (buffer))
654 XSET (real_buffer, Lisp_Buffer, current_buffer);
655 else
656 {
657 real_buffer = Fget_buffer (buffer);
658 if (NILP (real_buffer))
659 nsberror (buffer);
660 }
661
662 XBUFFER (real_buffer)->undo_list = Qt;
663
1ab256cb
RM
664 return Qnil;
665}
666
667DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, Sbuffer_enable_undo,
668 0, 1, "",
669 "Start keeping undo information for buffer BUFFER.\n\
670No argument or nil as argument means do this for the current buffer.")
ffd56f97
JB
671 (buffer)
672 register Lisp_Object buffer;
1ab256cb 673{
ffd56f97 674 Lisp_Object real_buffer;
1ab256cb 675
ffd56f97
JB
676 if (NILP (buffer))
677 XSET (real_buffer, Lisp_Buffer, current_buffer);
1ab256cb
RM
678 else
679 {
ffd56f97
JB
680 real_buffer = Fget_buffer (buffer);
681 if (NILP (real_buffer))
682 nsberror (buffer);
1ab256cb
RM
683 }
684
ffd56f97
JB
685 if (EQ (XBUFFER (real_buffer)->undo_list, Qt))
686 XBUFFER (real_buffer)->undo_list = Qnil;
1ab256cb
RM
687
688 return Qnil;
689}
690
691/*
692 DEFVAR_LISP ("kill-buffer-hook", no_cell, "\
693Hook to be run (by `run-hooks', which see) when a buffer is killed.\n\
694The buffer being killed will be current while the hook is running.\n\
695See `kill-buffer'."
696 */
697DEFUN ("kill-buffer", Fkill_buffer, Skill_buffer, 1, 1, "bKill buffer: ",
698 "Kill the buffer BUFFER.\n\
699The argument may be a buffer or may be the name of a buffer.\n\
700An argument of nil means kill the current buffer.\n\n\
701Value is t if the buffer is actually killed, nil if user says no.\n\n\
702The value of `kill-buffer-hook' (which may be local to that buffer),\n\
703if not void, is a list of functions to be called, with no arguments,\n\
704before the buffer is actually killed. The buffer to be killed is current\n\
705when the hook functions are called.\n\n\
706Any processes that have this buffer as the `process-buffer' are killed\n\
707with `delete-process'.")
708 (bufname)
709 Lisp_Object bufname;
710{
711 Lisp_Object buf;
712 register struct buffer *b;
713 register Lisp_Object tem;
714 register struct Lisp_Marker *m;
715 struct gcpro gcpro1, gcpro2;
716
265a9e55 717 if (NILP (bufname))
1ab256cb
RM
718 buf = Fcurrent_buffer ();
719 else
720 buf = Fget_buffer (bufname);
265a9e55 721 if (NILP (buf))
1ab256cb
RM
722 nsberror (bufname);
723
724 b = XBUFFER (buf);
725
726 /* Query if the buffer is still modified. */
265a9e55 727 if (INTERACTIVE && !NILP (b->filename)
1ab256cb
RM
728 && BUF_MODIFF (b) > b->save_modified)
729 {
730 GCPRO2 (buf, bufname);
731 tem = do_yes_or_no_p (format1 ("Buffer %s modified; kill anyway? ",
732 XSTRING (b->name)->data));
733 UNGCPRO;
265a9e55 734 if (NILP (tem))
1ab256cb
RM
735 return Qnil;
736 }
737
dcdffbf6 738 /* Run hooks with the buffer to be killed the current buffer. */
1ab256cb
RM
739 {
740 register Lisp_Object val;
741 int count = specpdl_ptr - specpdl;
dcdffbf6 742 Lisp_Object list;
1ab256cb
RM
743
744 record_unwind_protect (save_excursion_restore, save_excursion_save ());
745 set_buffer_internal (b);
dcdffbf6
RS
746
747 /* First run the query functions; if any query is answered no,
748 don't kill the buffer. */
749 for (list = Vkill_buffer_query_functions; !NILP (list); list = Fcdr (list))
750 {
751 tem = call0 (Fcar (list));
752 if (NILP (tem))
753 return unbind_to (count, Qnil);
754 }
755
756 /* Then run the hooks. */
fd186f07
RS
757 if (!NILP (Vrun_hooks))
758 call1 (Vrun_hooks, Qkill_buffer_hook);
1ab256cb
RM
759 unbind_to (count, Qnil);
760 }
761
762 /* We have no more questions to ask. Verify that it is valid
763 to kill the buffer. This must be done after the questions
764 since anything can happen within do_yes_or_no_p. */
765
766 /* Don't kill the minibuffer now current. */
767 if (EQ (buf, XWINDOW (minibuf_window)->buffer))
768 return Qnil;
769
265a9e55 770 if (NILP (b->name))
1ab256cb
RM
771 return Qnil;
772
773 /* Make this buffer not be current.
774 In the process, notice if this is the sole visible buffer
775 and give up if so. */
776 if (b == current_buffer)
777 {
172a9c1f 778 tem = Fother_buffer (buf, Qnil);
1ab256cb
RM
779 Fset_buffer (tem);
780 if (b == current_buffer)
781 return Qnil;
782 }
783
784 /* Now there is no question: we can kill the buffer. */
785
786#ifdef CLASH_DETECTION
787 /* Unlock this buffer's file, if it is locked. */
788 unlock_buffer (b);
789#endif /* CLASH_DETECTION */
790
1ab256cb 791 kill_buffer_processes (buf);
1ab256cb
RM
792
793 tem = Vinhibit_quit;
794 Vinhibit_quit = Qt;
795 Vbuffer_alist = Fdelq (Frassq (buf, Vbuffer_alist), Vbuffer_alist);
796 Freplace_buffer_in_windows (buf);
797 Vinhibit_quit = tem;
798
799 /* Delete any auto-save file. */
800 if (XTYPE (b->auto_save_file_name) == Lisp_String)
801 {
802 Lisp_Object tem;
803 tem = Fsymbol_value (intern ("delete-auto-save-files"));
265a9e55 804 if (! NILP (tem))
1ab256cb
RM
805 unlink (XSTRING (b->auto_save_file_name)->data);
806 }
807
808 /* Unchain all markers of this buffer
809 and leave them pointing nowhere. */
810 for (tem = b->markers; !EQ (tem, Qnil); )
811 {
812 m = XMARKER (tem);
813 m->buffer = 0;
814 tem = m->chain;
815 m->chain = Qnil;
816 }
817 b->markers = Qnil;
818
33f7013e
JA
819 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
820 INITIALIZE_INTERVAL (b, NULL_INTERVAL);
821 /* Perhaps we should explicitly free the interval tree here... */
822
1ab256cb 823 b->name = Qnil;
9ac0d9e0 824 BLOCK_INPUT;
1ab256cb 825 BUFFER_FREE (BUF_BEG_ADDR (b));
9ac0d9e0 826 UNBLOCK_INPUT;
1ab256cb
RM
827 b->undo_list = Qnil;
828
829 return Qt;
830}
831\f
36a8c287
JB
832/* Move the assoc for buffer BUF to the front of buffer-alist. Since
833 we do this each time BUF is selected visibly, the more recently
834 selected buffers are always closer to the front of the list. This
835 means that other_buffer is more likely to choose a relevant buffer. */
1ab256cb
RM
836
837record_buffer (buf)
838 Lisp_Object buf;
839{
840 register Lisp_Object link, prev;
841
842 prev = Qnil;
843 for (link = Vbuffer_alist; CONSP (link); link = XCONS (link)->cdr)
844 {
845 if (EQ (XCONS (XCONS (link)->car)->cdr, buf))
846 break;
847 prev = link;
848 }
849
36a8c287
JB
850 /* Effectively do Vbuffer_alist = Fdelq (link, Vbuffer_alist);
851 we cannot use Fdelq itself here because it allows quitting. */
1ab256cb 852
265a9e55 853 if (NILP (prev))
1ab256cb
RM
854 Vbuffer_alist = XCONS (Vbuffer_alist)->cdr;
855 else
856 XCONS (prev)->cdr = XCONS (XCONS (prev)->cdr)->cdr;
857
858 XCONS(link)->cdr = Vbuffer_alist;
859 Vbuffer_alist = link;
860}
861
862DEFUN ("switch-to-buffer", Fswitch_to_buffer, Sswitch_to_buffer, 1, 2, "BSwitch to buffer: ",
863 "Select buffer BUFFER in the current window.\n\
864BUFFER may be a buffer or a buffer name.\n\
865Optional second arg NORECORD non-nil means\n\
866do not put this buffer at the front of the list of recently selected ones.\n\
867\n\
868WARNING: This is NOT the way to work on another buffer temporarily\n\
869within a Lisp program! Use `set-buffer' instead. That avoids messing with\n\
870the window-buffer correspondences.")
871 (bufname, norecord)
872 Lisp_Object bufname, norecord;
873{
874 register Lisp_Object buf;
875 Lisp_Object tem;
876
877 if (EQ (minibuf_window, selected_window))
878 error ("Cannot switch buffers in minibuffer window");
879 tem = Fwindow_dedicated_p (selected_window);
265a9e55 880 if (!NILP (tem))
1ab256cb
RM
881 error ("Cannot switch buffers in a dedicated window");
882
265a9e55 883 if (NILP (bufname))
172a9c1f 884 buf = Fother_buffer (Fcurrent_buffer (), Qnil);
1ab256cb
RM
885 else
886 buf = Fget_buffer_create (bufname);
887 Fset_buffer (buf);
265a9e55 888 if (NILP (norecord))
1ab256cb
RM
889 record_buffer (buf);
890
891 Fset_window_buffer (EQ (selected_window, minibuf_window)
5fcd022d
JB
892 ? Fnext_window (minibuf_window, Qnil, Qnil)
893 : selected_window,
1ab256cb
RM
894 buf);
895
e8b3a22d 896 return buf;
1ab256cb
RM
897}
898
899DEFUN ("pop-to-buffer", Fpop_to_buffer, Spop_to_buffer, 1, 2, 0,
900 "Select buffer BUFFER in some window, preferably a different one.\n\
901If BUFFER is nil, then some other buffer is chosen.\n\
902If `pop-up-windows' is non-nil, windows can be split to do this.\n\
903If optional second arg OTHER-WINDOW is non-nil, insist on finding another\n\
904window even if BUFFER is already visible in the selected window.")
905 (bufname, other)
906 Lisp_Object bufname, other;
907{
908 register Lisp_Object buf;
265a9e55 909 if (NILP (bufname))
172a9c1f 910 buf = Fother_buffer (Fcurrent_buffer (), Qnil);
1ab256cb
RM
911 else
912 buf = Fget_buffer_create (bufname);
913 Fset_buffer (buf);
914 record_buffer (buf);
915 Fselect_window (Fdisplay_buffer (buf, other));
e8b3a22d 916 return buf;
1ab256cb
RM
917}
918
919DEFUN ("current-buffer", Fcurrent_buffer, Scurrent_buffer, 0, 0, 0,
920 "Return the current buffer as a Lisp object.")
921 ()
922{
923 register Lisp_Object buf;
924 XSET (buf, Lisp_Buffer, current_buffer);
925 return buf;
926}
927\f
928/* Set the current buffer to b */
929
930void
931set_buffer_internal (b)
932 register struct buffer *b;
933{
934 register struct buffer *old_buf;
935 register Lisp_Object tail, valcontents;
936 enum Lisp_Type tem;
937
938 if (current_buffer == b)
939 return;
940
941 windows_or_buffers_changed = 1;
942 old_buf = current_buffer;
943 current_buffer = b;
944 last_known_column_point = -1; /* invalidate indentation cache */
945
946 /* Look down buffer's list of local Lisp variables
947 to find and update any that forward into C variables. */
948
265a9e55 949 for (tail = b->local_var_alist; !NILP (tail); tail = XCONS (tail)->cdr)
1ab256cb
RM
950 {
951 valcontents = XSYMBOL (XCONS (XCONS (tail)->car)->car)->value;
952 if ((XTYPE (valcontents) == Lisp_Buffer_Local_Value
953 || XTYPE (valcontents) == Lisp_Some_Buffer_Local_Value)
954 && (tem = XTYPE (XCONS (valcontents)->car),
955 (tem == Lisp_Boolfwd || tem == Lisp_Intfwd
956 || tem == Lisp_Objfwd)))
957 /* Just reference the variable
958 to cause it to become set for this buffer. */
959 Fsymbol_value (XCONS (XCONS (tail)->car)->car);
960 }
961
962 /* Do the same with any others that were local to the previous buffer */
963
964 if (old_buf)
265a9e55 965 for (tail = old_buf->local_var_alist; !NILP (tail); tail = XCONS (tail)->cdr)
1ab256cb
RM
966 {
967 valcontents = XSYMBOL (XCONS (XCONS (tail)->car)->car)->value;
968 if ((XTYPE (valcontents) == Lisp_Buffer_Local_Value
969 || XTYPE (valcontents) == Lisp_Some_Buffer_Local_Value)
970 && (tem = XTYPE (XCONS (valcontents)->car),
971 (tem == Lisp_Boolfwd || tem == Lisp_Intfwd
972 || tem == Lisp_Objfwd)))
973 /* Just reference the variable
974 to cause it to become set for this buffer. */
975 Fsymbol_value (XCONS (XCONS (tail)->car)->car);
976 }
977}
978
979DEFUN ("set-buffer", Fset_buffer, Sset_buffer, 1, 1, 0,
980 "Make the buffer BUFFER current for editing operations.\n\
981BUFFER may be a buffer or the name of an existing buffer.\n\
982See also `save-excursion' when you want to make a buffer current temporarily.\n\
983This function does not display the buffer, so its effect ends\n\
984when the current command terminates.\n\
985Use `switch-to-buffer' or `pop-to-buffer' to switch buffers permanently.")
986 (bufname)
987 register Lisp_Object bufname;
988{
989 register Lisp_Object buffer;
990 buffer = Fget_buffer (bufname);
265a9e55 991 if (NILP (buffer))
1ab256cb 992 nsberror (bufname);
265a9e55 993 if (NILP (XBUFFER (buffer)->name))
1ab256cb
RM
994 error ("Selecting deleted buffer");
995 set_buffer_internal (XBUFFER (buffer));
996 return buffer;
997}
998\f
999DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only,
1000 Sbarf_if_buffer_read_only, 0, 0, 0,
1001 "Signal a `buffer-read-only' error if the current buffer is read-only.")
1002 ()
1003{
a96b68f1
RS
1004 if (!NILP (current_buffer->read_only)
1005 && NILP (Vinhibit_read_only))
1ab256cb
RM
1006 Fsignal (Qbuffer_read_only, (Fcons (Fcurrent_buffer (), Qnil)));
1007 return Qnil;
1008}
1009
1010DEFUN ("bury-buffer", Fbury_buffer, Sbury_buffer, 0, 1, "",
1011 "Put BUFFER at the end of the list of all buffers.\n\
1012There it is the least likely candidate for `other-buffer' to return;\n\
528415e7 1013thus, the least likely buffer for \\[switch-to-buffer] to select by default.\n\
a5611885
JB
1014If BUFFER is nil or omitted, bury the current buffer.\n\
1015Also, if BUFFER is nil or omitted, remove the current buffer from the\n\
1016selected window if it is displayed there.")
1ab256cb
RM
1017 (buf)
1018 register Lisp_Object buf;
1019{
b271272a 1020 /* Figure out what buffer we're going to bury. */
265a9e55 1021 if (NILP (buf))
a5611885
JB
1022 {
1023 XSET (buf, Lisp_Buffer, current_buffer);
1024
1025 /* If we're burying the current buffer, unshow it. */
5fcd022d 1026 Fswitch_to_buffer (Fother_buffer (buf, Qnil), Qnil);
a5611885 1027 }
1ab256cb
RM
1028 else
1029 {
1030 Lisp_Object buf1;
1031
1032 buf1 = Fget_buffer (buf);
265a9e55 1033 if (NILP (buf1))
1ab256cb
RM
1034 nsberror (buf);
1035 buf = buf1;
b271272a
JB
1036 }
1037
a5611885 1038 /* Move buf to the end of the buffer list. */
b271272a
JB
1039 {
1040 register Lisp_Object aelt, link;
1041
1042 aelt = Frassq (buf, Vbuffer_alist);
1043 link = Fmemq (aelt, Vbuffer_alist);
1044 Vbuffer_alist = Fdelq (aelt, Vbuffer_alist);
1045 XCONS (link)->cdr = Qnil;
1046 Vbuffer_alist = nconc2 (Vbuffer_alist, link);
1047 }
1ab256cb 1048
1ab256cb
RM
1049 return Qnil;
1050}
1051\f
c922bc55 1052DEFUN ("erase-buffer", Ferase_buffer, Serase_buffer, 0, 0, "*",
1ab256cb 1053 "Delete the entire contents of the current buffer.\n\
2950a20e 1054Any narrowing restriction in effect (see `narrow-to-region') is removed,\n\
1ab256cb
RM
1055so the buffer is truly empty after this.")
1056 ()
1057{
1058 Fwiden ();
1059 del_range (BEG, Z);
1060 current_buffer->last_window_start = 1;
1061 /* Prevent warnings, or suspension of auto saving, that would happen
1062 if future size is less than past size. Use of erase-buffer
1063 implies that the future text is not really related to the past text. */
1064 XFASTINT (current_buffer->save_length) = 0;
1065 return Qnil;
1066}
1067
1068validate_region (b, e)
1069 register Lisp_Object *b, *e;
1070{
1071 register int i;
1072
1073 CHECK_NUMBER_COERCE_MARKER (*b, 0);
1074 CHECK_NUMBER_COERCE_MARKER (*e, 1);
1075
1076 if (XINT (*b) > XINT (*e))
1077 {
1078 i = XFASTINT (*b); /* This is legit even if *b is < 0 */
1079 *b = *e;
1080 XFASTINT (*e) = i; /* because this is all we do with i. */
1081 }
1082
1083 if (!(BEGV <= XINT (*b) && XINT (*b) <= XINT (*e)
1084 && XINT (*e) <= ZV))
1085 args_out_of_range (*b, *e);
1086}
1087\f
9f31d21b 1088static Lisp_Object
1ab256cb
RM
1089list_buffers_1 (files)
1090 Lisp_Object files;
1091{
1092 register Lisp_Object tail, tem, buf;
1093 Lisp_Object col1, col2, col3, minspace;
1094 register struct buffer *old = current_buffer, *b;
718cde7d 1095 Lisp_Object desired_point;
1ab256cb
RM
1096 Lisp_Object other_file_symbol;
1097
718cde7d 1098 desired_point = Qnil;
1ab256cb
RM
1099 other_file_symbol = intern ("list-buffers-directory");
1100
1101 XFASTINT (col1) = 19;
1102 XFASTINT (col2) = 25;
1103 XFASTINT (col3) = 40;
1104 XFASTINT (minspace) = 1;
1105
1106 Fset_buffer (Vstandard_output);
1ab256cb
RM
1107 Fbuffer_disable_undo (Vstandard_output);
1108 current_buffer->read_only = Qnil;
1109
1110 write_string ("\
1111 MR Buffer Size Mode File\n\
1112 -- ------ ---- ---- ----\n", -1);
1113
265a9e55 1114 for (tail = Vbuffer_alist; !NILP (tail); tail = Fcdr (tail))
1ab256cb
RM
1115 {
1116 buf = Fcdr (Fcar (tail));
1117 b = XBUFFER (buf);
1118 /* Don't mention the minibuffers. */
1119 if (XSTRING (b->name)->data[0] == ' ')
1120 continue;
1121 /* Optionally don't mention buffers that lack files. */
265a9e55 1122 if (!NILP (files) && NILP (b->filename))
1ab256cb
RM
1123 continue;
1124 /* Identify the current buffer. */
1125 if (b == old)
718cde7d 1126 XFASTINT (desired_point) = point;
1ab256cb
RM
1127 write_string (b == old ? "." : " ", -1);
1128 /* Identify modified buffers */
1129 write_string (BUF_MODIFF (b) > b->save_modified ? "*" : " ", -1);
265a9e55 1130 write_string (NILP (b->read_only) ? " " : "% ", -1);
1ab256cb
RM
1131 Fprinc (b->name, Qnil);
1132 Findent_to (col1, make_number (2));
1133 XFASTINT (tem) = BUF_Z (b) - BUF_BEG (b);
1134 Fprin1 (tem, Qnil);
1135 Findent_to (col2, minspace);
1136 Fprinc (b->mode_name, Qnil);
1137 Findent_to (col3, minspace);
1138
265a9e55 1139 if (!NILP (b->filename))
1ab256cb
RM
1140 Fprinc (b->filename, Qnil);
1141 else
1142 {
1143 /* No visited file; check local value of list-buffers-directory. */
1144 Lisp_Object tem;
1145 set_buffer_internal (b);
1146 tem = Fboundp (other_file_symbol);
265a9e55 1147 if (!NILP (tem))
1ab256cb
RM
1148 {
1149 tem = Fsymbol_value (other_file_symbol);
1150 Fset_buffer (Vstandard_output);
1151 if (XTYPE (tem) == Lisp_String)
1152 Fprinc (tem, Qnil);
1153 }
1154 else
1155 Fset_buffer (Vstandard_output);
1156 }
1157 write_string ("\n", -1);
1158 }
1159
9f31d21b
KH
1160 tail = intern ("Buffer-menu-mode");
1161 if ((tem = Ffboundp (tail), !NILP (tem)))
1162 call0 (tail);
1ab256cb 1163 set_buffer_internal (old);
718cde7d 1164 return desired_point;
1ab256cb
RM
1165}
1166
1167DEFUN ("list-buffers", Flist_buffers, Slist_buffers, 0, 1, "P",
1168 "Display a list of names of existing buffers.\n\
1169The list is displayed in a buffer named `*Buffer List*'.\n\
1170Note that buffers with names starting with spaces are omitted.\n\
1171Non-null optional arg FILES-ONLY means mention only file buffers.\n\
1172\n\
1173The M column contains a * for buffers that are modified.\n\
1174The R column contains a % for buffers that are read-only.")
1175 (files)
1176 Lisp_Object files;
1177{
e87f38ef
JB
1178 Lisp_Object desired_point;
1179
fd2dab90
RS
1180 desired_point
1181 = internal_with_output_to_temp_buffer ("*Buffer List*",
1182 list_buffers_1, files);
e87f38ef 1183
718cde7d
JB
1184 if (NUMBERP (desired_point))
1185 {
1186 int count = specpdl_ptr - specpdl;
1187 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
1188 Fset_buffer (build_string ("*Buffer List*"));
1189 SET_PT (XINT (desired_point));
1190 return unbind_to (count, Qnil);
1191 }
fd2dab90 1192 return Qnil;
1ab256cb
RM
1193}
1194
1195DEFUN ("kill-all-local-variables", Fkill_all_local_variables, Skill_all_local_variables,
1196 0, 0, 0,
1197 "Switch to Fundamental mode by killing current buffer's local variables.\n\
1198Most local variable bindings are eliminated so that the default values\n\
1199become effective once more. Also, the syntax table is set from\n\
1200`standard-syntax-table', the local keymap is set to nil,\n\
1201and the abbrev table from `fundamental-mode-abbrev-table'.\n\
1202This function also forces redisplay of the mode line.\n\
1203\n\
1204Every function to select a new major mode starts by\n\
1205calling this function.\n\n\
1206As a special exception, local variables whose names have\n\
1207a non-nil `permanent-local' property are not eliminated by this function.")
1208 ()
1209{
1210 register Lisp_Object alist, sym, tem;
1211 Lisp_Object oalist;
7410477a 1212
fd186f07
RS
1213 if (!NILP (Vrun_hooks))
1214 call1 (Vrun_hooks, intern ("change-major-mode-hook"));
1ab256cb
RM
1215 oalist = current_buffer->local_var_alist;
1216
1217 /* Make sure no local variables remain set up with this buffer
1218 for their current values. */
1219
265a9e55 1220 for (alist = oalist; !NILP (alist); alist = XCONS (alist)->cdr)
1ab256cb
RM
1221 {
1222 sym = XCONS (XCONS (alist)->car)->car;
1223
1224 /* Need not do anything if some other buffer's binding is now encached. */
1225 tem = XCONS (XCONS (XSYMBOL (sym)->value)->cdr)->car;
1226 if (XBUFFER (tem) == current_buffer)
1227 {
1228 /* Symbol is set up for this buffer's old local value.
1229 Set it up for the current buffer with the default value. */
1230
1231 tem = XCONS (XCONS (XSYMBOL (sym)->value)->cdr)->cdr;
542143d7
RS
1232 /* Store the symbol's current value into the alist entry
1233 it is currently set up for. This is so that, if the
1234 local is marked permanent, and we make it local again below,
1235 we don't lose the value. */
2735b685
RS
1236 XCONS (XCONS (tem)->car)->cdr
1237 = do_symval_forwarding (XCONS (XSYMBOL (sym)->value)->car);
542143d7 1238 /* Switch to the symbol's default-value alist entry. */
1ab256cb 1239 XCONS (tem)->car = tem;
542143d7 1240 /* Mark it as current for the current buffer. */
1ab256cb 1241 XCONS (XCONS (XSYMBOL (sym)->value)->cdr)->car = Fcurrent_buffer ();
542143d7 1242 /* Store the current value into any forwarding in the symbol. */
1ab256cb
RM
1243 store_symval_forwarding (sym, XCONS (XSYMBOL (sym)->value)->car,
1244 XCONS (tem)->cdr);
1245 }
1246 }
1247
1248 /* Actually eliminate all local bindings of this buffer. */
1249
1250 reset_buffer_local_variables (current_buffer);
1251
1252 /* Redisplay mode lines; we are changing major mode. */
1253
1254 update_mode_lines++;
1255
1256 /* Any which are supposed to be permanent,
1257 make local again, with the same values they had. */
1258
265a9e55 1259 for (alist = oalist; !NILP (alist); alist = XCONS (alist)->cdr)
1ab256cb
RM
1260 {
1261 sym = XCONS (XCONS (alist)->car)->car;
1262 tem = Fget (sym, Qpermanent_local);
265a9e55 1263 if (! NILP (tem))
01050cb5
RM
1264 {
1265 Fmake_local_variable (sym);
1266 Fset (sym, XCONS (XCONS (alist)->car)->cdr);
1267 }
1ab256cb
RM
1268 }
1269
1270 /* Force mode-line redisplay. Useful here because all major mode
1271 commands call this function. */
1272 update_mode_lines++;
1273
1274 return Qnil;
1275}
1276\f
2eec3b4e
RS
1277/* Find all the overlays in the current buffer that contain position POS.
1278 Return the number found, and store them in a vector in *VEC_PTR.
1279 Store in *LEN_PTR the size allocated for the vector.
52f8ec73
JB
1280 Store in *NEXT_PTR the next position after POS where an overlay starts,
1281 or ZV if there are no more overlays.
2eec3b4e
RS
1282
1283 *VEC_PTR and *LEN_PTR should contain a valid vector and size
61d54cd5
RS
1284 when this function is called.
1285
1286 If EXTEND is non-zero, we make the vector bigger if necessary.
1287 If EXTEND is zero, we never extend the vector,
1288 and we store only as many overlays as will fit.
1289 But we still return the total number of overlays. */
2eec3b4e
RS
1290
1291int
61d54cd5 1292overlays_at (pos, extend, vec_ptr, len_ptr, next_ptr)
2eec3b4e 1293 int pos;
61d54cd5 1294 int extend;
2eec3b4e
RS
1295 Lisp_Object **vec_ptr;
1296 int *len_ptr;
1297 int *next_ptr;
1ab256cb 1298{
2eec3b4e
RS
1299 Lisp_Object tail, overlay, start, end, result;
1300 int idx = 0;
1301 int len = *len_ptr;
1302 Lisp_Object *vec = *vec_ptr;
1303 int next = ZV;
61d54cd5
RS
1304 int inhibit_storing = 0;
1305
2eec3b4e 1306 for (tail = current_buffer->overlays_before;
4a44b14c 1307 XGCTYPE (tail) == Lisp_Cons;
2eec3b4e
RS
1308 tail = XCONS (tail)->cdr)
1309 {
52f8ec73
JB
1310 int startpos;
1311
2eec3b4e 1312 overlay = XCONS (tail)->car;
3ccf510a 1313 if (XGCTYPE (overlay) != Lisp_Overlay)
52f8ec73 1314 abort ();
1ab256cb 1315
2eec3b4e
RS
1316 start = OVERLAY_START (overlay);
1317 end = OVERLAY_END (overlay);
1318 if (OVERLAY_POSITION (end) <= pos)
1319 break;
1320 startpos = OVERLAY_POSITION (start);
1321 if (startpos <= pos)
1322 {
1323 if (idx == len)
1324 {
61d54cd5
RS
1325 /* The supplied vector is full.
1326 Either make it bigger, or don't store any more in it. */
1327 if (extend)
1328 {
1329 *len_ptr = len *= 2;
1330 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
1331 *vec_ptr = vec;
1332 }
1333 else
1334 inhibit_storing = 1;
2eec3b4e 1335 }
61d54cd5
RS
1336
1337 if (!inhibit_storing)
1338 vec[idx] = overlay;
1339 /* Keep counting overlays even if we can't return them all. */
1340 idx++;
2eec3b4e
RS
1341 }
1342 else if (startpos < next)
1343 next = startpos;
1344 }
1345
1346 for (tail = current_buffer->overlays_after;
4a44b14c 1347 XGCTYPE (tail) == Lisp_Cons;
2eec3b4e 1348 tail = XCONS (tail)->cdr)
1ab256cb 1349 {
52f8ec73
JB
1350 int startpos;
1351
2eec3b4e 1352 overlay = XCONS (tail)->car;
3ccf510a 1353 if (XGCTYPE (overlay) != Lisp_Overlay)
52f8ec73 1354 abort ();
2eec3b4e
RS
1355
1356 start = OVERLAY_START (overlay);
1357 end = OVERLAY_END (overlay);
1358 startpos = OVERLAY_POSITION (start);
52f8ec73 1359 if (pos < startpos)
2eec3b4e
RS
1360 {
1361 if (startpos < next)
1362 next = startpos;
1363 break;
1364 }
52f8ec73 1365 if (pos < OVERLAY_POSITION (end))
2eec3b4e
RS
1366 {
1367 if (idx == len)
1368 {
61d54cd5
RS
1369 if (extend)
1370 {
1371 *len_ptr = len *= 2;
1372 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
1373 *vec_ptr = vec;
1374 }
1375 else
1376 inhibit_storing = 1;
2eec3b4e 1377 }
61d54cd5
RS
1378
1379 if (!inhibit_storing)
1380 vec[idx] = overlay;
1381 idx++;
2eec3b4e 1382 }
1ab256cb
RM
1383 }
1384
2eec3b4e
RS
1385 *next_ptr = next;
1386 return idx;
1387}
1388\f
5985d248
KH
1389struct sortvec
1390{
1391 Lisp_Object overlay;
1392 int beg, end;
1393 int priority;
1394};
1395
1396static int
1397compare_overlays (s1, s2)
1398 struct sortvec *s1, *s2;
1399{
1400 if (s1->priority != s2->priority)
1401 return s1->priority - s2->priority;
1402 if (s1->beg != s2->beg)
1403 return s1->beg - s2->beg;
1404 if (s1->end != s2->end)
1405 return s2->end - s1->end;
1406 return 0;
1407}
1408
1409/* Sort an array of overlays by priority. The array is modified in place.
1410 The return value is the new size; this may be smaller than the original
1411 size if some of the overlays were invalid or were window-specific. */
1412int
1413sort_overlays (overlay_vec, noverlays, w)
1414 Lisp_Object *overlay_vec;
1415 int noverlays;
1416 struct window *w;
1417{
1418 int i, j;
1419 struct sortvec *sortvec;
1420 sortvec = (struct sortvec *) alloca (noverlays * sizeof (struct sortvec));
1421
1422 /* Put the valid and relevant overlays into sortvec. */
1423
1424 for (i = 0, j = 0; i < noverlays; i++)
1425 {
0fa767e7 1426 Lisp_Object tem;
c99fc30f 1427 Lisp_Object overlay;
5985d248 1428
c99fc30f 1429 overlay = overlay_vec[i];
5985d248
KH
1430 if (OVERLAY_VALID (overlay)
1431 && OVERLAY_POSITION (OVERLAY_START (overlay)) > 0
1432 && OVERLAY_POSITION (OVERLAY_END (overlay)) > 0)
1433 {
0fa767e7
KH
1434 /* If we're interested in a specific window, then ignore
1435 overlays that are limited to some other window. */
1436 if (w)
5985d248 1437 {
0fa767e7
KH
1438 Lisp_Object window;
1439
1440 window = Foverlay_get (overlay, Qwindow);
1441 if (XTYPE (window) == Lisp_Window && XWINDOW (window) != w)
1442 continue;
5985d248 1443 }
0fa767e7
KH
1444
1445 /* This overlay is good and counts: put it into sortvec. */
1446 sortvec[j].overlay = overlay;
1447 sortvec[j].beg = OVERLAY_POSITION (OVERLAY_START (overlay));
1448 sortvec[j].end = OVERLAY_POSITION (OVERLAY_END (overlay));
1449 tem = Foverlay_get (overlay, Qpriority);
1450 if (INTEGERP (tem))
1451 sortvec[j].priority = XINT (tem);
1452 else
1453 sortvec[j].priority = 0;
1454 j++;
5985d248
KH
1455 }
1456 }
1457 noverlays = j;
1458
1459 /* Sort the overlays into the proper order: increasing priority. */
1460
1461 if (noverlays > 1)
1462 qsort (sortvec, noverlays, sizeof (struct sortvec), compare_overlays);
1463
1464 for (i = 0; i < noverlays; i++)
1465 overlay_vec[i] = sortvec[i].overlay;
1466 return (noverlays);
1467}
1468\f
5c4f68f1 1469/* Shift overlays in BUF's overlay lists, to center the lists at POS. */
1ab256cb 1470
2eec3b4e 1471void
5c4f68f1
JB
1472recenter_overlay_lists (buf, pos)
1473 struct buffer *buf;
2eec3b4e
RS
1474 int pos;
1475{
1476 Lisp_Object overlay, tail, next, prev, beg, end;
1477
1478 /* See if anything in overlays_before should move to overlays_after. */
1479
1480 /* We don't strictly need prev in this loop; it should always be nil.
1481 But we use it for symmetry and in case that should cease to be true
1482 with some future change. */
1483 prev = Qnil;
5c4f68f1 1484 for (tail = buf->overlays_before;
2eec3b4e
RS
1485 CONSP (tail);
1486 prev = tail, tail = next)
1ab256cb 1487 {
2eec3b4e
RS
1488 next = XCONS (tail)->cdr;
1489 overlay = XCONS (tail)->car;
1490
1491 /* If the overlay is not valid, get rid of it. */
1492 if (!OVERLAY_VALID (overlay))
52f8ec73
JB
1493#if 1
1494 abort ();
1495#else
2eec3b4e
RS
1496 {
1497 /* Splice the cons cell TAIL out of overlays_before. */
1498 if (!NILP (prev))
1499 XCONS (prev)->cdr = next;
1500 else
5c4f68f1 1501 buf->overlays_before = next;
2eec3b4e
RS
1502 tail = prev;
1503 continue;
1504 }
52f8ec73 1505#endif
1ab256cb 1506
2eec3b4e
RS
1507 beg = OVERLAY_START (overlay);
1508 end = OVERLAY_END (overlay);
1ab256cb 1509
2eec3b4e 1510 if (OVERLAY_POSITION (end) > pos)
1ab256cb 1511 {
2eec3b4e
RS
1512 /* OVERLAY needs to be moved. */
1513 int where = OVERLAY_POSITION (beg);
1514 Lisp_Object other, other_prev;
1515
1516 /* Splice the cons cell TAIL out of overlays_before. */
1517 if (!NILP (prev))
1518 XCONS (prev)->cdr = next;
1519 else
5c4f68f1 1520 buf->overlays_before = next;
2eec3b4e
RS
1521
1522 /* Search thru overlays_after for where to put it. */
1523 other_prev = Qnil;
5c4f68f1 1524 for (other = buf->overlays_after;
2eec3b4e
RS
1525 CONSP (other);
1526 other_prev = other, other = XCONS (other)->cdr)
1ab256cb 1527 {
2eec3b4e
RS
1528 Lisp_Object otherbeg, otheroverlay, follower;
1529 int win;
1530
1531 otheroverlay = XCONS (other)->car;
1532 if (! OVERLAY_VALID (otheroverlay))
52f8ec73 1533 abort ();
2eec3b4e
RS
1534
1535 otherbeg = OVERLAY_START (otheroverlay);
1536 if (OVERLAY_POSITION (otherbeg) >= where)
1537 break;
1ab256cb 1538 }
2eec3b4e
RS
1539
1540 /* Add TAIL to overlays_after before OTHER. */
1541 XCONS (tail)->cdr = other;
1542 if (!NILP (other_prev))
1543 XCONS (other_prev)->cdr = tail;
1ab256cb 1544 else
5c4f68f1 1545 buf->overlays_after = tail;
2eec3b4e 1546 tail = prev;
1ab256cb 1547 }
2eec3b4e
RS
1548 else
1549 /* We've reached the things that should stay in overlays_before.
1550 All the rest of overlays_before must end even earlier,
1551 so stop now. */
1552 break;
1553 }
1554
1555 /* See if anything in overlays_after should be in overlays_before. */
1556 prev = Qnil;
5c4f68f1 1557 for (tail = buf->overlays_after;
2eec3b4e
RS
1558 CONSP (tail);
1559 prev = tail, tail = next)
1560 {
1561 next = XCONS (tail)->cdr;
1562 overlay = XCONS (tail)->car;
1563
1564 /* If the overlay is not valid, get rid of it. */
1565 if (!OVERLAY_VALID (overlay))
52f8ec73
JB
1566#if 1
1567 abort ();
1568#else
2eec3b4e
RS
1569 {
1570 /* Splice the cons cell TAIL out of overlays_after. */
1571 if (!NILP (prev))
1572 XCONS (prev)->cdr = next;
1573 else
5c4f68f1 1574 buf->overlays_after = next;
2eec3b4e
RS
1575 tail = prev;
1576 continue;
1577 }
52f8ec73 1578#endif
2eec3b4e
RS
1579
1580 beg = OVERLAY_START (overlay);
1581 end = OVERLAY_END (overlay);
1582
1583 /* Stop looking, when we know that nothing further
1584 can possibly end before POS. */
1585 if (OVERLAY_POSITION (beg) > pos)
1586 break;
1587
1588 if (OVERLAY_POSITION (end) <= pos)
1589 {
1590 /* OVERLAY needs to be moved. */
1591 int where = OVERLAY_POSITION (end);
1592 Lisp_Object other, other_prev;
1593
1594 /* Splice the cons cell TAIL out of overlays_after. */
1595 if (!NILP (prev))
1596 XCONS (prev)->cdr = next;
1597 else
5c4f68f1 1598 buf->overlays_after = next;
2eec3b4e
RS
1599
1600 /* Search thru overlays_before for where to put it. */
1601 other_prev = Qnil;
5c4f68f1 1602 for (other = buf->overlays_before;
2eec3b4e
RS
1603 CONSP (other);
1604 other_prev = other, other = XCONS (other)->cdr)
1605 {
1606 Lisp_Object otherend, otheroverlay;
1607 int win;
1608
1609 otheroverlay = XCONS (other)->car;
1610 if (! OVERLAY_VALID (otheroverlay))
52f8ec73 1611 abort ();
2eec3b4e
RS
1612
1613 otherend = OVERLAY_END (otheroverlay);
1614 if (OVERLAY_POSITION (otherend) <= where)
1615 break;
1616 }
1617
1618 /* Add TAIL to overlays_before before OTHER. */
1619 XCONS (tail)->cdr = other;
1620 if (!NILP (other_prev))
1621 XCONS (other_prev)->cdr = tail;
1622 else
5c4f68f1 1623 buf->overlays_before = tail;
2eec3b4e
RS
1624 tail = prev;
1625 }
1626 }
1627
5c4f68f1 1628 XFASTINT (buf->overlay_center) = pos;
2eec3b4e
RS
1629}
1630\f
52f8ec73
JB
1631DEFUN ("overlayp", Foverlayp, Soverlayp, 1, 1, 0,
1632 "Return t if OBJECT is an overlay.")
1633 (object)
1634 Lisp_Object object;
1635{
1636 return (OVERLAYP (object) ? Qt : Qnil);
1637}
1638
5c4f68f1
JB
1639DEFUN ("make-overlay", Fmake_overlay, Smake_overlay, 2, 3, 0,
1640 "Create a new overlay with range BEG to END in BUFFER.\n\
1641If omitted, BUFFER defaults to the current buffer.\n\
2eec3b4e 1642BEG and END may be integers or markers.")
5c4f68f1
JB
1643 (beg, end, buffer)
1644 Lisp_Object beg, end, buffer;
2eec3b4e
RS
1645{
1646 Lisp_Object overlay;
5c4f68f1 1647 struct buffer *b;
2eec3b4e 1648
5c4f68f1
JB
1649 if (NILP (buffer))
1650 XSET (buffer, Lisp_Buffer, current_buffer);
883047b9
JB
1651 else
1652 CHECK_BUFFER (buffer, 2);
1653 if (MARKERP (beg)
1654 && ! EQ (Fmarker_buffer (beg), buffer))
1655 error ("Marker points into wrong buffer");
1656 if (MARKERP (end)
1657 && ! EQ (Fmarker_buffer (end), buffer))
1658 error ("Marker points into wrong buffer");
2eec3b4e 1659
883047b9
JB
1660 CHECK_NUMBER_COERCE_MARKER (beg, 1);
1661 CHECK_NUMBER_COERCE_MARKER (end, 1);
5c4f68f1 1662
883047b9 1663 if (XINT (beg) > XINT (end))
5c4f68f1 1664 {
c99fc30f
KH
1665 Lisp_Object temp;
1666 temp = beg; beg = end; end = temp;
5c4f68f1 1667 }
883047b9
JB
1668
1669 b = XBUFFER (buffer);
1670
1671 beg = Fset_marker (Fmake_marker (), beg, buffer);
1672 end = Fset_marker (Fmake_marker (), end, buffer);
5c4f68f1
JB
1673
1674 overlay = Fcons (Fcons (beg, end), Qnil);
52f8ec73 1675 XSETTYPE (overlay, Lisp_Overlay);
2eec3b4e
RS
1676
1677 /* Put the new overlay on the wrong list. */
1678 end = OVERLAY_END (overlay);
5c4f68f1
JB
1679 if (OVERLAY_POSITION (end) < XINT (b->overlay_center))
1680 b->overlays_after = Fcons (overlay, b->overlays_after);
2eec3b4e 1681 else
5c4f68f1 1682 b->overlays_before = Fcons (overlay, b->overlays_before);
2eec3b4e
RS
1683
1684 /* This puts it in the right list, and in the right order. */
5c4f68f1 1685 recenter_overlay_lists (b, XINT (b->overlay_center));
2eec3b4e 1686
b61982dd
JB
1687 /* We don't need to redisplay the region covered by the overlay, because
1688 the overlay has no properties at the moment. */
1689
2eec3b4e
RS
1690 return overlay;
1691}
1692
5c4f68f1
JB
1693DEFUN ("move-overlay", Fmove_overlay, Smove_overlay, 3, 4, 0,
1694 "Set the endpoints of OVERLAY to BEG and END in BUFFER.\n\
3ece337a
JB
1695If BUFFER is omitted, leave OVERLAY in the same buffer it inhabits now.\n\
1696If BUFFER is omitted, and OVERLAY is in no buffer, put it in the current\n\
1697buffer.")
5c4f68f1
JB
1698 (overlay, beg, end, buffer)
1699 Lisp_Object overlay, beg, end, buffer;
2eec3b4e 1700{
0a4469c9
RS
1701 struct buffer *b, *ob;
1702 Lisp_Object obuffer;
1703 int count = specpdl_ptr - specpdl;
5c4f68f1 1704
52f8ec73 1705 CHECK_OVERLAY (overlay, 0);
5c4f68f1
JB
1706 if (NILP (buffer))
1707 buffer = Fmarker_buffer (OVERLAY_START (overlay));
3ece337a
JB
1708 if (NILP (buffer))
1709 XSET (buffer, Lisp_Buffer, current_buffer);
5c4f68f1 1710 CHECK_BUFFER (buffer, 3);
883047b9
JB
1711
1712 if (MARKERP (beg)
1713 && ! EQ (Fmarker_buffer (beg), buffer))
1714 error ("Marker points into wrong buffer");
1715 if (MARKERP (end)
1716 && ! EQ (Fmarker_buffer (end), buffer))
1717 error ("Marker points into wrong buffer");
1718
b61982dd
JB
1719 CHECK_NUMBER_COERCE_MARKER (beg, 1);
1720 CHECK_NUMBER_COERCE_MARKER (end, 1);
1721
0a4469c9
RS
1722 specbind (Qinhibit_quit, Qt);
1723
b61982dd
JB
1724 if (XINT (beg) > XINT (end))
1725 {
c99fc30f
KH
1726 Lisp_Object temp;
1727 temp = beg; beg = end; end = temp;
b61982dd
JB
1728 }
1729
0a4469c9 1730 obuffer = Fmarker_buffer (OVERLAY_START (overlay));
5c4f68f1 1731 b = XBUFFER (buffer);
0a4469c9 1732 ob = XBUFFER (obuffer);
2eec3b4e 1733
c82ed728 1734 /* If the overlay has changed buffers, do a thorough redisplay. */
0a4469c9 1735 if (!EQ (buffer, obuffer))
c82ed728
JB
1736 windows_or_buffers_changed = 1;
1737 else
1738 /* Redisplay the area the overlay has just left, or just enclosed. */
1739 {
be8b1c6b
RS
1740 Lisp_Object o_beg;
1741 Lisp_Object o_end;
c82ed728
JB
1742 int change_beg, change_end;
1743
be8b1c6b
RS
1744 o_beg = OVERLAY_START (overlay);
1745 o_end = OVERLAY_END (overlay);
c82ed728
JB
1746 o_beg = OVERLAY_POSITION (o_beg);
1747 o_end = OVERLAY_POSITION (o_end);
1748
1749 if (XINT (o_beg) == XINT (beg))
1750 redisplay_region (b, XINT (o_end), XINT (end));
1751 else if (XINT (o_end) == XINT (end))
1752 redisplay_region (b, XINT (o_beg), XINT (beg));
1753 else
1754 {
1755 if (XINT (beg) < XINT (o_beg)) o_beg = beg;
1756 if (XINT (end) > XINT (o_end)) o_end = end;
1757 redisplay_region (b, XINT (o_beg), XINT (o_end));
1758 }
1759 }
b61982dd 1760
0a4469c9
RS
1761 if (!NILP (obuffer))
1762 {
1763 ob->overlays_before = Fdelq (overlay, ob->overlays_before);
1764 ob->overlays_after = Fdelq (overlay, ob->overlays_after);
1765 }
5c4f68f1
JB
1766
1767 Fset_marker (OVERLAY_START (overlay), beg, buffer);
1768 Fset_marker (OVERLAY_END (overlay), end, buffer);
2eec3b4e
RS
1769
1770 /* Put the overlay on the wrong list. */
1771 end = OVERLAY_END (overlay);
5c4f68f1
JB
1772 if (OVERLAY_POSITION (end) < XINT (b->overlay_center))
1773 b->overlays_after = Fcons (overlay, b->overlays_after);
2eec3b4e 1774 else
5c4f68f1 1775 b->overlays_before = Fcons (overlay, b->overlays_before);
2eec3b4e
RS
1776
1777 /* This puts it in the right list, and in the right order. */
5c4f68f1 1778 recenter_overlay_lists (b, XINT (b->overlay_center));
2eec3b4e 1779
0a4469c9 1780 return unbind_to (count, overlay);
2eec3b4e
RS
1781}
1782
1783DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0,
5c4f68f1 1784 "Delete the overlay OVERLAY from its buffer.")
2eec3b4e 1785 (overlay)
5c4f68f1 1786 Lisp_Object overlay;
2eec3b4e 1787{
0a4469c9 1788 Lisp_Object buffer;
5c4f68f1 1789 struct buffer *b;
0a4469c9 1790 int count = specpdl_ptr - specpdl;
5c4f68f1 1791
52f8ec73
JB
1792 CHECK_OVERLAY (overlay, 0);
1793
0a4469c9
RS
1794 buffer = Fmarker_buffer (OVERLAY_START (overlay));
1795 if (NILP (buffer))
1796 return Qnil;
1797
1798 b = XBUFFER (buffer);
1799
1800 specbind (Qinhibit_quit, Qt);
5c4f68f1
JB
1801
1802 b->overlays_before = Fdelq (overlay, b->overlays_before);
1803 b->overlays_after = Fdelq (overlay, b->overlays_after);
1804
b61982dd 1805 redisplay_region (b,
a927f5c9
RS
1806 marker_position (OVERLAY_START (overlay)),
1807 marker_position (OVERLAY_END (overlay)));
b61982dd 1808
3ece337a
JB
1809 Fset_marker (OVERLAY_START (overlay), Qnil, Qnil);
1810 Fset_marker (OVERLAY_END (overlay), Qnil, Qnil);
1811
0a4469c9 1812 return unbind_to (count, Qnil);
2eec3b4e
RS
1813}
1814\f
8ebafa8d
JB
1815/* Overlay dissection functions. */
1816
1817DEFUN ("overlay-start", Foverlay_start, Soverlay_start, 1, 1, 0,
1818 "Return the position at which OVERLAY starts.")
1819 (overlay)
1820 Lisp_Object overlay;
1821{
1822 CHECK_OVERLAY (overlay, 0);
1823
1824 return (Fmarker_position (OVERLAY_START (overlay)));
1825}
1826
1827DEFUN ("overlay-end", Foverlay_end, Soverlay_end, 1, 1, 0,
1828 "Return the position at which OVERLAY ends.")
1829 (overlay)
1830 Lisp_Object overlay;
1831{
1832 CHECK_OVERLAY (overlay, 0);
1833
1834 return (Fmarker_position (OVERLAY_END (overlay)));
1835}
1836
1837DEFUN ("overlay-buffer", Foverlay_buffer, Soverlay_buffer, 1, 1, 0,
1838 "Return the buffer OVERLAY belongs to.")
1839 (overlay)
1840 Lisp_Object overlay;
1841{
1842 CHECK_OVERLAY (overlay, 0);
1843
1844 return Fmarker_buffer (OVERLAY_START (overlay));
1845}
1846
1847DEFUN ("overlay-properties", Foverlay_properties, Soverlay_properties, 1, 1, 0,
1848 "Return a list of the properties on OVERLAY.\n\
1849This is a copy of OVERLAY's plist; modifying its conses has no effect on\n\
1850OVERLAY.")
1851 (overlay)
1852 Lisp_Object overlay;
1853{
1854 CHECK_OVERLAY (overlay, 0);
1855
1856 return Fcopy_sequence (Fcdr_safe (XCONS (overlay)->cdr));
1857}
1858
1859\f
2eec3b4e 1860DEFUN ("overlays-at", Foverlays_at, Soverlays_at, 1, 1, 0,
eb8c3be9 1861 "Return a list of the overlays that contain position POS.")
2eec3b4e
RS
1862 (pos)
1863 Lisp_Object pos;
1864{
1865 int noverlays;
1866 int endpos;
1867 Lisp_Object *overlay_vec;
1868 int len;
1869 Lisp_Object result;
1870
1871 CHECK_NUMBER_COERCE_MARKER (pos, 0);
1872
1873 len = 10;
1874 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
1875
1876 /* Put all the overlays we want in a vector in overlay_vec.
1877 Store the length in len. */
61d54cd5 1878 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len, &endpos);
2eec3b4e
RS
1879
1880 /* Make a list of them all. */
1881 result = Flist (noverlays, overlay_vec);
1882
9ac0d9e0 1883 xfree (overlay_vec);
2eec3b4e
RS
1884 return result;
1885}
1886
1887DEFUN ("next-overlay-change", Fnext_overlay_change, Snext_overlay_change,
1888 1, 1, 0,
1889 "Return the next position after POS where an overlay starts or ends.")
1890 (pos)
1891 Lisp_Object pos;
1892{
1893 int noverlays;
1894 int endpos;
1895 Lisp_Object *overlay_vec;
1896 int len;
1897 Lisp_Object result;
1898 int i;
1899
1900 CHECK_NUMBER_COERCE_MARKER (pos, 0);
1901
1902 len = 10;
1903 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
1904
1905 /* Put all the overlays we want in a vector in overlay_vec.
1906 Store the length in len.
1907 endpos gets the position where the next overlay starts. */
61d54cd5 1908 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len, &endpos);
2eec3b4e
RS
1909
1910 /* If any of these overlays ends before endpos,
1911 use its ending point instead. */
1912 for (i = 0; i < noverlays; i++)
1913 {
1914 Lisp_Object oend;
1915 int oendpos;
1916
1917 oend = OVERLAY_END (overlay_vec[i]);
1918 oendpos = OVERLAY_POSITION (oend);
1919 if (oendpos < endpos)
1920 endpos = oendpos;
1ab256cb
RM
1921 }
1922
9ac0d9e0 1923 xfree (overlay_vec);
2eec3b4e
RS
1924 return make_number (endpos);
1925}
1926\f
1927/* These functions are for debugging overlays. */
1928
1929DEFUN ("overlay-lists", Foverlay_lists, Soverlay_lists, 0, 0, 0,
1930 "Return a pair of lists giving all the overlays of the current buffer.\n\
1931The car has all the overlays before the overlay center;\n\
1932the cdr has all the overlays before the overlay center.\n\
1933Recentering overlays moves overlays between these lists.\n\
1934The lists you get are copies, so that changing them has no effect.\n\
1935However, the overlays you get are the real objects that the buffer uses.")
1936 ()
1937{
1938 Lisp_Object before, after;
1939 before = current_buffer->overlays_before;
1940 if (CONSP (before))
1941 before = Fcopy_sequence (before);
1942 after = current_buffer->overlays_after;
1943 if (CONSP (after))
1944 after = Fcopy_sequence (after);
1945
1946 return Fcons (before, after);
1947}
1948
1949DEFUN ("overlay-recenter", Foverlay_recenter, Soverlay_recenter, 1, 1, 0,
1950 "Recenter the overlays of the current buffer around position POS.")
1951 (pos)
1952 Lisp_Object pos;
1953{
1954 CHECK_NUMBER_COERCE_MARKER (pos, 0);
1955
5c4f68f1 1956 recenter_overlay_lists (current_buffer, XINT (pos));
2eec3b4e
RS
1957 return Qnil;
1958}
1959\f
1960DEFUN ("overlay-get", Foverlay_get, Soverlay_get, 2, 2, 0,
1961 "Get the property of overlay OVERLAY with property name NAME.")
1962 (overlay, prop)
1963 Lisp_Object overlay, prop;
1964{
1965 Lisp_Object plist;
52f8ec73
JB
1966
1967 CHECK_OVERLAY (overlay, 0);
1968
1969 for (plist = Fcdr_safe (XCONS (overlay)->cdr);
2eec3b4e
RS
1970 CONSP (plist) && CONSP (XCONS (plist)->cdr);
1971 plist = XCONS (XCONS (plist)->cdr)->cdr)
1972 {
1973 if (EQ (XCONS (plist)->car, prop))
1974 return XCONS (XCONS (plist)->cdr)->car;
1975 }
52f8ec73
JB
1976
1977 return Qnil;
2eec3b4e
RS
1978}
1979
1980DEFUN ("overlay-put", Foverlay_put, Soverlay_put, 3, 3, 0,
1981 "Set one property of overlay OVERLAY: give property PROP value VALUE.")
1982 (overlay, prop, value)
1983 Lisp_Object overlay, prop, value;
1984{
1985 Lisp_Object plist, tail;
1986
52f8ec73 1987 CHECK_OVERLAY (overlay, 0);
b61982dd 1988
25d16451
RS
1989 tail = Fmarker_buffer (OVERLAY_START (overlay));
1990 if (! NILP (tail))
1991 redisplay_region (XMARKER (OVERLAY_START (overlay))->buffer,
1992 marker_position (OVERLAY_START (overlay)),
1993 marker_position (OVERLAY_END (overlay)));
b61982dd 1994
52f8ec73 1995 plist = Fcdr_safe (XCONS (overlay)->cdr);
2eec3b4e
RS
1996
1997 for (tail = plist;
1998 CONSP (tail) && CONSP (XCONS (tail)->cdr);
1999 tail = XCONS (XCONS (tail)->cdr)->cdr)
2000 {
2001 if (EQ (XCONS (tail)->car, prop))
2002 return XCONS (XCONS (tail)->cdr)->car = value;
2003 }
2004
2005 if (! CONSP (XCONS (overlay)->cdr))
2006 XCONS (overlay)->cdr = Fcons (Qnil, Qnil);
2007
2008 XCONS (XCONS (overlay)->cdr)->cdr
2009 = Fcons (prop, Fcons (value, plist));
2010
2011 return value;
1ab256cb
RM
2012}
2013\f
173f2a64
RS
2014/* Run the modification-hooks of overlays that include
2015 any part of the text in START to END.
2016 Run the insert-before-hooks of overlay starting at END,
2017 and the insert-after-hooks of overlay ending at START. */
2018
2019void
2020verify_overlay_modification (start, end)
2021 Lisp_Object start, end;
2022{
2023 Lisp_Object prop, overlay, tail;
2024 int insertion = EQ (start, end);
2025
2026 for (tail = current_buffer->overlays_before;
2027 CONSP (tail);
2028 tail = XCONS (tail)->cdr)
2029 {
2030 int startpos, endpos;
be8b1c6b 2031 Lisp_Object ostart, oend;
173f2a64
RS
2032
2033 overlay = XCONS (tail)->car;
2034
2035 ostart = OVERLAY_START (overlay);
2036 oend = OVERLAY_END (overlay);
2037 endpos = OVERLAY_POSITION (oend);
2038 if (XFASTINT (start) > endpos)
2039 break;
2040 startpos = OVERLAY_POSITION (ostart);
2041 if (XFASTINT (end) == startpos && insertion)
2042 {
2043 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
5fb5aa33
RS
2044 if (!NILP (prop))
2045 {
2046 /* Copy TAIL in case the hook recenters the overlay lists. */
2047 tail = Fcopy_sequence (tail);
2048 call_overlay_mod_hooks (prop, overlay, start, end);
2049 }
173f2a64
RS
2050 }
2051 if (XFASTINT (start) == endpos && insertion)
2052 {
2053 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
5fb5aa33
RS
2054 if (!NILP (prop))
2055 {
2056 tail = Fcopy_sequence (tail);
2057 call_overlay_mod_hooks (prop, overlay, start, end);
2058 }
173f2a64
RS
2059 }
2060 if (insertion
2061 ? (XFASTINT (start) > startpos && XFASTINT (end) < endpos)
2062 : (XFASTINT (start) >= startpos && XFASTINT (end) <= endpos))
2063 {
2064 prop = Foverlay_get (overlay, Qmodification_hooks);
5fb5aa33
RS
2065 if (!NILP (prop))
2066 {
2067 tail = Fcopy_sequence (tail);
2068 call_overlay_mod_hooks (prop, overlay, start, end);
2069 }
173f2a64
RS
2070 }
2071 }
2072
2073 for (tail = current_buffer->overlays_after;
2074 CONSP (tail);
2075 tail = XCONS (tail)->cdr)
2076 {
2077 int startpos, endpos;
be8b1c6b 2078 Lisp_Object ostart, oend;
173f2a64
RS
2079
2080 overlay = XCONS (tail)->car;
2081
2082 ostart = OVERLAY_START (overlay);
2083 oend = OVERLAY_END (overlay);
2084 startpos = OVERLAY_POSITION (ostart);
cdf0b096 2085 endpos = OVERLAY_POSITION (oend);
173f2a64
RS
2086 if (XFASTINT (end) < startpos)
2087 break;
2088 if (XFASTINT (end) == startpos && insertion)
2089 {
2090 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
5fb5aa33
RS
2091 if (!NILP (prop))
2092 {
2093 tail = Fcopy_sequence (tail);
2094 call_overlay_mod_hooks (prop, overlay, start, end);
2095 }
173f2a64
RS
2096 }
2097 if (XFASTINT (start) == endpos && insertion)
2098 {
2099 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
5fb5aa33
RS
2100 if (!NILP (prop))
2101 {
2102 tail = Fcopy_sequence (tail);
2103 call_overlay_mod_hooks (prop, overlay, start, end);
2104 }
173f2a64
RS
2105 }
2106 if (insertion
2107 ? (XFASTINT (start) > startpos && XFASTINT (end) < endpos)
2108 : (XFASTINT (start) >= startpos && XFASTINT (end) <= endpos))
2109 {
2110 prop = Foverlay_get (overlay, Qmodification_hooks);
5fb5aa33
RS
2111 if (!NILP (prop))
2112 {
2113 tail = Fcopy_sequence (tail);
2114 call_overlay_mod_hooks (prop, overlay, start, end);
2115 }
173f2a64
RS
2116 }
2117 }
2118}
2119
2120static void
2121call_overlay_mod_hooks (list, overlay, start, end)
2122 Lisp_Object list, overlay, start, end;
2123{
2124 struct gcpro gcpro1;
2125 GCPRO1 (list);
2126 while (!NILP (list))
2127 {
2128 call3 (Fcar (list), overlay, start, end);
2129 list = Fcdr (list);
2130 }
2131 UNGCPRO;
2132}
2133\f
0fa3ba92
JB
2134/* Somebody has tried to store NEWVAL into the buffer-local slot with
2135 offset XUINT (valcontents), and NEWVAL has an unacceptable type. */
2136void
2137buffer_slot_type_mismatch (valcontents, newval)
2138 Lisp_Object valcontents, newval;
2139{
2140 unsigned int offset = XUINT (valcontents);
5fcd022d 2141 unsigned char *symbol_name =
0fa3ba92
JB
2142 (XSYMBOL (*(Lisp_Object *)(offset + (char *)&buffer_local_symbols))
2143 ->name->data);
2144 char *type_name;
2145
2146 switch (XINT (*(Lisp_Object *)(offset + (char *)&buffer_local_types)))
2147 {
2148 case Lisp_Int: type_name = "integers"; break;
2149 case Lisp_String: type_name = "strings"; break;
2150 case Lisp_Marker: type_name = "markers"; break;
2151 case Lisp_Symbol: type_name = "symbols"; break;
2152 case Lisp_Cons: type_name = "lists"; break;
5fcd022d 2153 case Lisp_Vector: type_name = "vectors"; break;
0fa3ba92
JB
2154 default:
2155 abort ();
2156 }
2157
2158 error ("only %s should be stored in the buffer-local variable %s",
2159 type_name, symbol_name);
2160}
2161\f
1ab256cb
RM
2162init_buffer_once ()
2163{
2164 register Lisp_Object tem;
2165
2166 /* Make sure all markable slots in buffer_defaults
2167 are initialized reasonably, so mark_buffer won't choke. */
2168 reset_buffer (&buffer_defaults);
2169 reset_buffer (&buffer_local_symbols);
2170 XSET (Vbuffer_defaults, Lisp_Buffer, &buffer_defaults);
2171 XSET (Vbuffer_local_symbols, Lisp_Buffer, &buffer_local_symbols);
2172
2173 /* Set up the default values of various buffer slots. */
2174 /* Must do these before making the first buffer! */
2175
2176 /* real setup is done in loaddefs.el */
2177 buffer_defaults.mode_line_format = build_string ("%-");
2178 buffer_defaults.abbrev_mode = Qnil;
2179 buffer_defaults.overwrite_mode = Qnil;
2180 buffer_defaults.case_fold_search = Qt;
2181 buffer_defaults.auto_fill_function = Qnil;
2182 buffer_defaults.selective_display = Qnil;
2183#ifndef old
2184 buffer_defaults.selective_display_ellipses = Qt;
2185#endif
2186 buffer_defaults.abbrev_table = Qnil;
2187 buffer_defaults.display_table = Qnil;
1ab256cb 2188 buffer_defaults.undo_list = Qnil;
c48f61ef 2189 buffer_defaults.mark_active = Qnil;
2eec3b4e
RS
2190 buffer_defaults.overlays_before = Qnil;
2191 buffer_defaults.overlays_after = Qnil;
2192 XFASTINT (buffer_defaults.overlay_center) = 1;
1ab256cb
RM
2193
2194 XFASTINT (buffer_defaults.tab_width) = 8;
2195 buffer_defaults.truncate_lines = Qnil;
2196 buffer_defaults.ctl_arrow = Qt;
2197
54ad07d3
RS
2198#ifdef MSDOS
2199 buffer_defaults.buffer_file_type = 0; /* TEXT */
2200#endif
1ab256cb
RM
2201 XFASTINT (buffer_defaults.fill_column) = 70;
2202 XFASTINT (buffer_defaults.left_margin) = 0;
2203
2204 /* Assign the local-flags to the slots that have default values.
2205 The local flag is a bit that is used in the buffer
2206 to say that it has its own local value for the slot.
2207 The local flag bits are in the local_var_flags slot of the buffer. */
2208
2209 /* Nothing can work if this isn't true */
2210 if (sizeof (int) != sizeof (Lisp_Object)) abort ();
2211
2212 /* 0 means not a lisp var, -1 means always local, else mask */
2213 bzero (&buffer_local_flags, sizeof buffer_local_flags);
2214 XFASTINT (buffer_local_flags.filename) = -1;
2215 XFASTINT (buffer_local_flags.directory) = -1;
2216 XFASTINT (buffer_local_flags.backed_up) = -1;
2217 XFASTINT (buffer_local_flags.save_length) = -1;
2218 XFASTINT (buffer_local_flags.auto_save_file_name) = -1;
2219 XFASTINT (buffer_local_flags.read_only) = -1;
2220 XFASTINT (buffer_local_flags.major_mode) = -1;
2221 XFASTINT (buffer_local_flags.mode_name) = -1;
2222 XFASTINT (buffer_local_flags.undo_list) = -1;
c48f61ef 2223 XFASTINT (buffer_local_flags.mark_active) = -1;
1ab256cb
RM
2224
2225 XFASTINT (buffer_local_flags.mode_line_format) = 1;
2226 XFASTINT (buffer_local_flags.abbrev_mode) = 2;
2227 XFASTINT (buffer_local_flags.overwrite_mode) = 4;
2228 XFASTINT (buffer_local_flags.case_fold_search) = 8;
2229 XFASTINT (buffer_local_flags.auto_fill_function) = 0x10;
2230 XFASTINT (buffer_local_flags.selective_display) = 0x20;
2231#ifndef old
2232 XFASTINT (buffer_local_flags.selective_display_ellipses) = 0x40;
2233#endif
2234 XFASTINT (buffer_local_flags.tab_width) = 0x80;
2235 XFASTINT (buffer_local_flags.truncate_lines) = 0x100;
2236 XFASTINT (buffer_local_flags.ctl_arrow) = 0x200;
2237 XFASTINT (buffer_local_flags.fill_column) = 0x400;
2238 XFASTINT (buffer_local_flags.left_margin) = 0x800;
2239 XFASTINT (buffer_local_flags.abbrev_table) = 0x1000;
2240 XFASTINT (buffer_local_flags.display_table) = 0x2000;
1ab256cb 2241 XFASTINT (buffer_local_flags.syntax_table) = 0x8000;
54ad07d3
RS
2242#ifdef MSDOS
2243 XFASTINT (buffer_local_flags.buffer_file_type) = 0x4000;
2244#endif
1ab256cb
RM
2245
2246 Vbuffer_alist = Qnil;
2247 current_buffer = 0;
2248 all_buffers = 0;
2249
2250 QSFundamental = build_string ("Fundamental");
2251
2252 Qfundamental_mode = intern ("fundamental-mode");
2253 buffer_defaults.major_mode = Qfundamental_mode;
2254
2255 Qmode_class = intern ("mode-class");
2256
2257 Qprotected_field = intern ("protected-field");
2258
2259 Qpermanent_local = intern ("permanent-local");
2260
2261 Qkill_buffer_hook = intern ("kill-buffer-hook");
2262
2263 Vprin1_to_string_buffer = Fget_buffer_create (build_string (" prin1"));
2264 /* super-magic invisible buffer */
2265 Vbuffer_alist = Qnil;
2266
ffd56f97 2267 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
1ab256cb
RM
2268}
2269
2270init_buffer ()
2271{
2272 char buf[MAXPATHLEN+1];
2381d133
JB
2273 char *pwd;
2274 struct stat dotstat, pwdstat;
136351b7 2275 Lisp_Object temp;
1ab256cb
RM
2276
2277 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
2381d133
JB
2278
2279 /* If PWD is accurate, use it instead of calling getwd. This is faster
2280 when PWD is right, and may avoid a fatal error. */
2281 if ((pwd = getenv ("PWD")) != 0 && *pwd == '/'
2282 && stat (pwd, &pwdstat) == 0
2283 && stat (".", &dotstat) == 0
2284 && dotstat.st_ino == pwdstat.st_ino
2285 && dotstat.st_dev == pwdstat.st_dev
2286 && strlen (pwd) < MAXPATHLEN)
2287 strcpy (buf, pwd);
2288 else if (getwd (buf) == 0)
1ab256cb
RM
2289 fatal ("`getwd' failed: %s.\n", buf);
2290
2291#ifndef VMS
2292 /* Maybe this should really use some standard subroutine
2293 whose definition is filename syntax dependent. */
2294 if (buf[strlen (buf) - 1] != '/')
2295 strcat (buf, "/");
2296#endif /* not VMS */
2297 current_buffer->directory = build_string (buf);
136351b7
RS
2298
2299 temp = get_minibuffer (0);
2300 XBUFFER (temp)->directory = current_buffer->directory;
1ab256cb
RM
2301}
2302
2303/* initialize the buffer routines */
2304syms_of_buffer ()
2305{
188d4d11
RM
2306 extern Lisp_Object Qdisabled;
2307
1ab256cb
RM
2308 staticpro (&Vbuffer_defaults);
2309 staticpro (&Vbuffer_local_symbols);
2310 staticpro (&Qfundamental_mode);
2311 staticpro (&Qmode_class);
2312 staticpro (&QSFundamental);
2313 staticpro (&Vbuffer_alist);
2314 staticpro (&Qprotected_field);
2315 staticpro (&Qpermanent_local);
2316 staticpro (&Qkill_buffer_hook);
52f8ec73 2317 staticpro (&Qoverlayp);
294d215f
RS
2318 staticpro (&Qmodification_hooks);
2319 Qmodification_hooks = intern ("modification-hooks");
2320 staticpro (&Qinsert_in_front_hooks);
2321 Qinsert_in_front_hooks = intern ("insert-in-front-hooks");
2322 staticpro (&Qinsert_behind_hooks);
2323 Qinsert_behind_hooks = intern ("insert-behind-hooks");
5fe0b67e
RS
2324 staticpro (&Qget_file_buffer);
2325 Qget_file_buffer = intern ("get-file-buffer");
5985d248
KH
2326 Qpriority = intern ("priority");
2327 staticpro (&Qpriority);
2328 Qwindow = intern ("window");
2329 staticpro (&Qwindow);
52f8ec73
JB
2330
2331 Qoverlayp = intern ("overlayp");
1ab256cb
RM
2332
2333 Fput (Qprotected_field, Qerror_conditions,
2334 Fcons (Qprotected_field, Fcons (Qerror, Qnil)));
2335 Fput (Qprotected_field, Qerror_message,
2336 build_string ("Attempt to modify a protected field"));
2337
2338 /* All these use DEFVAR_LISP_NOPRO because the slots in
2339 buffer_defaults will all be marked via Vbuffer_defaults. */
2340
2341 DEFVAR_LISP_NOPRO ("default-mode-line-format",
2342 &buffer_defaults.mode_line_format,
2343 "Default value of `mode-line-format' for buffers that don't override it.\n\
2344This is the same as (default-value 'mode-line-format).");
2345
2346 DEFVAR_LISP_NOPRO ("default-abbrev-mode",
2347 &buffer_defaults.abbrev_mode,
2348 "Default value of `abbrev-mode' for buffers that do not override it.\n\
2349This is the same as (default-value 'abbrev-mode).");
2350
2351 DEFVAR_LISP_NOPRO ("default-ctl-arrow",
2352 &buffer_defaults.ctl_arrow,
2353 "Default value of `ctl-arrow' for buffers that do not override it.\n\
2354This is the same as (default-value 'ctl-arrow).");
2355
2356 DEFVAR_LISP_NOPRO ("default-truncate-lines",
2357 &buffer_defaults.truncate_lines,
2358 "Default value of `truncate-lines' for buffers that do not override it.\n\
2359This is the same as (default-value 'truncate-lines).");
2360
2361 DEFVAR_LISP_NOPRO ("default-fill-column",
2362 &buffer_defaults.fill_column,
2363 "Default value of `fill-column' for buffers that do not override it.\n\
2364This is the same as (default-value 'fill-column).");
2365
2366 DEFVAR_LISP_NOPRO ("default-left-margin",
2367 &buffer_defaults.left_margin,
2368 "Default value of `left-margin' for buffers that do not override it.\n\
2369This is the same as (default-value 'left-margin).");
2370
2371 DEFVAR_LISP_NOPRO ("default-tab-width",
2372 &buffer_defaults.tab_width,
2373 "Default value of `tab-width' for buffers that do not override it.\n\
2374This is the same as (default-value 'tab-width).");
2375
2376 DEFVAR_LISP_NOPRO ("default-case-fold-search",
2377 &buffer_defaults.case_fold_search,
2378 "Default value of `case-fold-search' for buffers that don't override it.\n\
2379This is the same as (default-value 'case-fold-search).");
2380
54ad07d3
RS
2381#ifdef MSDOS
2382 DEFVAR_LISP_NOPRO ("default-buffer-file-type",
2383 &buffer_defaults.buffer_file_type,
2384 "Default file type for buffers that do not override it.\n\
2385This is the same as (default-value 'buffer-file-type).\n\
2386The file type is nil for text, t for binary.");
2387#endif
2388
0fa3ba92
JB
2389 DEFVAR_PER_BUFFER ("mode-line-format", &current_buffer->mode_line_format,
2390 Qnil, 0);
1ab256cb
RM
2391
2392/* This doc string is too long for cpp; cpp dies if it isn't in a comment.
2393 But make-docfile finds it!
2394 DEFVAR_PER_BUFFER ("mode-line-format", &current_buffer->mode_line_format,
bec44fd6 2395 Qnil,
1ab256cb
RM
2396 "Template for displaying mode line for current buffer.\n\
2397Each buffer has its own value of this variable.\n\
2398Value may be a string, a symbol or a list or cons cell.\n\
2399For a symbol, its value is used (but it is ignored if t or nil).\n\
2400 A string appearing directly as the value of a symbol is processed verbatim\n\
2401 in that the %-constructs below are not recognized.\n\
2402For a list whose car is a symbol, the symbol's value is taken,\n\
2403 and if that is non-nil, the cadr of the list is processed recursively.\n\
2404 Otherwise, the caddr of the list (if there is one) is processed.\n\
2405For a list whose car is a string or list, each element is processed\n\
2406 recursively and the results are effectively concatenated.\n\
2407For a list whose car is an integer, the cdr of the list is processed\n\
2408 and padded (if the number is positive) or truncated (if negative)\n\
2409 to the width specified by that number.\n\
2410A string is printed verbatim in the mode line except for %-constructs:\n\
2411 (%-constructs are allowed when the string is the entire mode-line-format\n\
2412 or when it is found in a cons-cell or a list)\n\
2413 %b -- print buffer name. %f -- print visited file name.\n\
2414 %* -- print *, % or hyphen. %m -- print value of mode-name (obsolete).\n\
a97c374a 2415 %s -- print process status. %l -- print the current line number.\n\
dd24e6a6
RS
2416 %p -- print percent of buffer above top of window, or Top, Bot or All.\n\
2417 %p -- print percent of buffer above bottom of window, perhaps plus Top,\n\
2418 or print Bottom or All.\n\
1ab256cb 2419 %n -- print Narrow if appropriate.\n\
54ad07d3 2420 %t -- print T if files is text, B if binary.\n\
1ab256cb
RM
2421 %[ -- print one [ for each recursive editing level. %] similar.\n\
2422 %% -- print %. %- -- print infinitely many dashes.\n\
2423Decimal digits after the % specify field width to which to pad.");
2424*/
2425
2426 DEFVAR_LISP_NOPRO ("default-major-mode", &buffer_defaults.major_mode,
2427 "*Major mode for new buffers. Defaults to `fundamental-mode'.\n\
2428nil here means use current buffer's major mode.");
2429
2430 DEFVAR_PER_BUFFER ("major-mode", &current_buffer->major_mode,
0fa3ba92 2431 make_number (Lisp_Symbol),
1ab256cb
RM
2432 "Symbol for current buffer's major mode.");
2433
2434 DEFVAR_PER_BUFFER ("mode-name", &current_buffer->mode_name,
0fa3ba92 2435 make_number (Lisp_String),
1ab256cb
RM
2436 "Pretty name of current buffer's major mode (a string).");
2437
0fa3ba92 2438 DEFVAR_PER_BUFFER ("abbrev-mode", &current_buffer->abbrev_mode, Qnil,
1ab256cb
RM
2439 "Non-nil turns on automatic expansion of abbrevs as they are inserted.\n\
2440Automatically becomes buffer-local when set in any fashion.");
2441
2442 DEFVAR_PER_BUFFER ("case-fold-search", &current_buffer->case_fold_search,
0fa3ba92 2443 Qnil,
1ab256cb
RM
2444 "*Non-nil if searches should ignore case.\n\
2445Automatically becomes buffer-local when set in any fashion.");
2446
2447 DEFVAR_PER_BUFFER ("fill-column", &current_buffer->fill_column,
0fa3ba92 2448 make_number (Lisp_Int),
1ab256cb
RM
2449 "*Column beyond which automatic line-wrapping should happen.\n\
2450Automatically becomes buffer-local when set in any fashion.");
2451
2452 DEFVAR_PER_BUFFER ("left-margin", &current_buffer->left_margin,
0fa3ba92 2453 make_number (Lisp_Int),
1ab256cb
RM
2454 "*Column for the default indent-line-function to indent to.\n\
2455Linefeed indents to this column in Fundamental mode.\n\
2456Automatically becomes buffer-local when set in any fashion.");
2457
2458 DEFVAR_PER_BUFFER ("tab-width", &current_buffer->tab_width,
0fa3ba92 2459 make_number (Lisp_Int),
1ab256cb
RM
2460 "*Distance between tab stops (for display of tab characters), in columns.\n\
2461Automatically becomes buffer-local when set in any fashion.");
2462
0fa3ba92 2463 DEFVAR_PER_BUFFER ("ctl-arrow", &current_buffer->ctl_arrow, Qnil,
1ab256cb
RM
2464 "*Non-nil means display control chars with uparrow.\n\
2465Nil means use backslash and octal digits.\n\
2466Automatically becomes buffer-local when set in any fashion.\n\
2467This variable does not apply to characters whose display is specified\n\
2468in the current display table (if there is one).");
2469
0fa3ba92 2470 DEFVAR_PER_BUFFER ("truncate-lines", &current_buffer->truncate_lines, Qnil,
1ab256cb
RM
2471 "*Non-nil means do not display continuation lines;\n\
2472give each line of text one screen line.\n\
2473Automatically becomes buffer-local when set in any fashion.\n\
2474\n\
2475Note that this is overridden by the variable\n\
2476`truncate-partial-width-windows' if that variable is non-nil\n\
502b9b64 2477and this buffer is not full-frame width.");
1ab256cb 2478
54ad07d3
RS
2479#ifdef MSDOS
2480 DEFVAR_PER_BUFFER ("buffer-file-type", &current_buffer->buffer_file_type,
2481 Qnil,
2482 "*If visited file is text, nil; otherwise, t.");
2483#endif
2484
1ab256cb 2485 DEFVAR_PER_BUFFER ("default-directory", &current_buffer->directory,
0fa3ba92 2486 make_number (Lisp_String),
1ab256cb
RM
2487 "Name of default directory of current buffer. Should end with slash.\n\
2488Each buffer has its own value of this variable.");
2489
2490 DEFVAR_PER_BUFFER ("auto-fill-function", &current_buffer->auto_fill_function,
0fa3ba92 2491 Qnil,
1ab256cb
RM
2492 "Function called (if non-nil) to perform auto-fill.\n\
2493It is called after self-inserting a space at a column beyond `fill-column'.\n\
2494Each buffer has its own value of this variable.\n\
2495NOTE: This variable is not an ordinary hook;\n\
2496It may not be a list of functions.");
2497
2498 DEFVAR_PER_BUFFER ("buffer-file-name", &current_buffer->filename,
0fa3ba92 2499 make_number (Lisp_String),
1ab256cb
RM
2500 "Name of file visited in current buffer, or nil if not visiting a file.\n\
2501Each buffer has its own value of this variable.");
2502
2503 DEFVAR_PER_BUFFER ("buffer-auto-save-file-name",
3f5fcd47 2504 &current_buffer->auto_save_file_name,
0fa3ba92 2505 make_number (Lisp_String),
1ab256cb
RM
2506 "Name of file for auto-saving current buffer,\n\
2507or nil if buffer should not be auto-saved.\n\
2508Each buffer has its own value of this variable.");
2509
0fa3ba92 2510 DEFVAR_PER_BUFFER ("buffer-read-only", &current_buffer->read_only, Qnil,
1ab256cb
RM
2511 "Non-nil if this buffer is read-only.\n\
2512Each buffer has its own value of this variable.");
2513
0fa3ba92 2514 DEFVAR_PER_BUFFER ("buffer-backed-up", &current_buffer->backed_up, Qnil,
1ab256cb
RM
2515 "Non-nil if this buffer's file has been backed up.\n\
2516Backing up is done before the first time the file is saved.\n\
2517Each buffer has its own value of this variable.");
2518
2519 DEFVAR_PER_BUFFER ("buffer-saved-size", &current_buffer->save_length,
0fa3ba92 2520 make_number (Lisp_Int),
1ab256cb
RM
2521 "Length of current buffer when last read in, saved or auto-saved.\n\
25220 initially.\n\
2523Each buffer has its own value of this variable.");
2524
2525 DEFVAR_PER_BUFFER ("selective-display", &current_buffer->selective_display,
0fa3ba92 2526 Qnil,
1ab256cb
RM
2527 "Non-nil enables selective display:\n\
2528Integer N as value means display only lines\n\
2529 that start with less than n columns of space.\n\
2530A value of t means, after a ^M, all the rest of the line is invisible.\n\
2531 Then ^M's in the file are written into files as newlines.\n\n\
2532Automatically becomes buffer-local when set in any fashion.");
2533
2534#ifndef old
2535 DEFVAR_PER_BUFFER ("selective-display-ellipses",
2536 &current_buffer->selective_display_ellipses,
0fa3ba92 2537 Qnil,
1ab256cb
RM
2538 "t means display ... on previous line when a line is invisible.\n\
2539Automatically becomes buffer-local when set in any fashion.");
2540#endif
2541
0fa3ba92 2542 DEFVAR_PER_BUFFER ("overwrite-mode", &current_buffer->overwrite_mode, Qnil,
1ab256cb 2543 "Non-nil if self-insertion should replace existing text.\n\
6bbb0d4a
JB
2544If non-nil and not `overwrite-mode-binary', self-insertion still\n\
2545inserts at the end of a line, and inserts when point is before a tab,\n\
2e94b813 2546until the tab is filled in.\n\
6bbb0d4a 2547If `overwrite-mode-binary', self-insertion replaces newlines and tabs too.\n\
1ab256cb
RM
2548Automatically becomes buffer-local when set in any fashion.");
2549
54939090
RS
2550#if 0 /* The doc string is too long for some compilers,
2551 but make-docfile can find it in this comment. */
1ab256cb 2552 DEFVAR_PER_BUFFER ("buffer-display-table", &current_buffer->display_table,
5d305367 2553 Qnil,
1ab256cb
RM
2554 "Display table that controls display of the contents of current buffer.\n\
2555Automatically becomes buffer-local when set in any fashion.\n\
2556The display table is a vector created with `make-display-table'.\n\
2557The first 256 elements control how to display each possible text character.\n\
6158b3b0 2558Each value should be a vector of characters or nil;\n\
1ab256cb 2559nil means display the character in the default fashion.\n\
6158b3b0
JB
2560The remaining five elements control the display of\n\
2561 the end of a truncated screen line (element 256, a single character);\n\
2562 the end of a continued line (element 257, a single character);\n\
2563 the escape character used to display character codes in octal\n\
2564 (element 258, a single character);\n\
2565 the character used as an arrow for control characters (element 259,\n\
2566 a single character);\n\
2567 the decoration indicating the presence of invisible lines (element 260,\n\
2568 a vector of characters).\n\
1ab256cb
RM
2569If this variable is nil, the value of `standard-display-table' is used.\n\
2570Each window can have its own, overriding display table.");
54939090
RS
2571#endif
2572 DEFVAR_PER_BUFFER ("buffer-display-table", &current_buffer->display_table,
de15914a 2573 Qnil, 0);
1ab256cb 2574
1ab256cb
RM
2575/*DEFVAR_LISP ("debug-check-symbol", &Vcheck_symbol,
2576 "Don't ask.");
2577*/
01050cb5 2578 DEFVAR_LISP ("before-change-function", &Vbefore_change_function,
1ab256cb
RM
2579 "Function to call before each text change.\n\
2580Two arguments are passed to the function: the positions of\n\
2581the beginning and end of the range of old text to be changed.\n\
2582\(For an insertion, the beginning and end are at the same place.)\n\
2583No information is given about the length of the text after the change.\n\
2584position of the change\n\
2585\n\
2586While executing the `before-change-function', changes to buffers do not\n\
2587cause calls to any `before-change-function' or `after-change-function'.");
2588 Vbefore_change_function = Qnil;
2589
2590 DEFVAR_LISP ("after-change-function", &Vafter_change_function,
2591 "Function to call after each text change.\n\
2592Three arguments are passed to the function: the positions of\n\
2593the beginning and end of the range of changed text,\n\
2594and the length of the pre-change text replaced by that range.\n\
2595\(For an insertion, the pre-change length is zero;\n\
2596for a deletion, that length is the number of characters deleted,\n\
2597and the post-change beginning and end are at the same place.)\n\
2598\n\
2599While executing the `after-change-function', changes to buffers do not\n\
2600cause calls to any `before-change-function' or `after-change-function'.");
2601 Vafter_change_function = Qnil;
2602
dbc4e1c1
JB
2603 DEFVAR_LISP ("first-change-hook", &Vfirst_change_hook,
2604 "A list of functions to call before changing a buffer which is unmodified.\n\
2605The functions are run using the `run-hooks' function.");
2606 Vfirst_change_hook = Qnil;
2607 Qfirst_change_hook = intern ("first-change-hook");
2608 staticpro (&Qfirst_change_hook);
1ab256cb 2609
54939090
RS
2610#if 0 /* The doc string is too long for some compilers,
2611 but make-docfile can find it in this comment. */
3f5fcd47 2612 DEFVAR_PER_BUFFER ("buffer-undo-list", &current_buffer->undo_list, Qnil,
1ab256cb
RM
2613 "List of undo entries in current buffer.\n\
2614Recent changes come first; older changes follow newer.\n\
2615\n\
2616An entry (START . END) represents an insertion which begins at\n\
2617position START and ends at position END.\n\
2618\n\
2619An entry (TEXT . POSITION) represents the deletion of the string TEXT\n\
2620from (abs POSITION). If POSITION is positive, point was at the front\n\
2621of the text being deleted; if negative, point was at the end.\n\
2622\n\
2623An entry (t HIGHWORD LOWWORD) indicates that the buffer had been\n\
2624previously unmodified. HIGHWORD and LOWWORD are the high and low\n\
262516-bit words of the buffer's modification count at the time. If the\n\
2626modification count of the most recent save is different, this entry is\n\
2627obsolete.\n\
2628\n\
483c1fd3
RS
2629An entry (nil PROP VAL BEG . END) indicates that a text property\n\
2630was modified between BEG and END. PROP is the property name,\n\
2631and VAL is the old value.\n\
2632\n\
bec44fd6
JB
2633An entry of the form POSITION indicates that point was at the buffer\n\
2634location given by the integer. Undoing an entry of this form places\n\
2635point at POSITION.\n\
2636\n\
1ab256cb
RM
2637nil marks undo boundaries. The undo command treats the changes\n\
2638between two undo boundaries as a single step to be undone.\n\
2639\n\
bec44fd6 2640If the value of the variable is t, undo information is not recorded.");
54939090
RS
2641#endif
2642 DEFVAR_PER_BUFFER ("buffer-undo-list", &current_buffer->undo_list, Qnil,
de15914a 2643 0);
1ab256cb 2644
c48f61ef
RS
2645 DEFVAR_PER_BUFFER ("mark-active", &current_buffer->mark_active, Qnil,
2646 "Non-nil means the mark and region are currently active in this buffer.\n\
2647Automatically local in all buffers.");
2648
2649 DEFVAR_LISP ("transient-mark-mode", &Vtransient_mark_mode,
2650 "*Non-nil means deactivate the mark when the buffer contents change.");
2651 Vtransient_mark_mode = Qnil;
2652
0a4469c9 2653 DEFVAR_LISP ("inhibit-read-only", &Vinhibit_read_only,
a96b68f1
RS
2654 "*Non-nil means disregard read-only status of buffers or characters.\n\
2655If the value is t, disregard `buffer-read-only' and all `read-only'\n\
2656text properties. If the value is a list, disregard `buffer-read-only'\n\
2657and disregard a `read-only' text property if the property value\n\
2658is a member of the list.");
2659 Vinhibit_read_only = Qnil;
2660
dcdffbf6
RS
2661 DEFVAR_LISP ("kill-buffer-query-functions", &Vkill_buffer_query_functions,
2662 "List of functions called with no args to query before killing a buffer.");
2663 Vkill_buffer_query_functions = Qnil;
2664
1ab256cb
RM
2665 defsubr (&Sbuffer_list);
2666 defsubr (&Sget_buffer);
2667 defsubr (&Sget_file_buffer);
2668 defsubr (&Sget_buffer_create);
01050cb5 2669 defsubr (&Sgenerate_new_buffer_name);
1ab256cb
RM
2670 defsubr (&Sbuffer_name);
2671/*defsubr (&Sbuffer_number);*/
2672 defsubr (&Sbuffer_file_name);
2673 defsubr (&Sbuffer_local_variables);
2674 defsubr (&Sbuffer_modified_p);
2675 defsubr (&Sset_buffer_modified_p);
2676 defsubr (&Sbuffer_modified_tick);
2677 defsubr (&Srename_buffer);
2678 defsubr (&Sother_buffer);
2679 defsubr (&Sbuffer_disable_undo);
2680 defsubr (&Sbuffer_enable_undo);
2681 defsubr (&Skill_buffer);
2682 defsubr (&Serase_buffer);
2683 defsubr (&Sswitch_to_buffer);
2684 defsubr (&Spop_to_buffer);
2685 defsubr (&Scurrent_buffer);
2686 defsubr (&Sset_buffer);
2687 defsubr (&Sbarf_if_buffer_read_only);
2688 defsubr (&Sbury_buffer);
2689 defsubr (&Slist_buffers);
2690 defsubr (&Skill_all_local_variables);
2eec3b4e 2691
52f8ec73 2692 defsubr (&Soverlayp);
2eec3b4e
RS
2693 defsubr (&Smake_overlay);
2694 defsubr (&Sdelete_overlay);
2695 defsubr (&Smove_overlay);
8ebafa8d
JB
2696 defsubr (&Soverlay_start);
2697 defsubr (&Soverlay_end);
2698 defsubr (&Soverlay_buffer);
2699 defsubr (&Soverlay_properties);
2eec3b4e
RS
2700 defsubr (&Soverlays_at);
2701 defsubr (&Snext_overlay_change);
2702 defsubr (&Soverlay_recenter);
2703 defsubr (&Soverlay_lists);
2704 defsubr (&Soverlay_get);
2705 defsubr (&Soverlay_put);
1ab256cb
RM
2706}
2707
2708keys_of_buffer ()
2709{
2710 initial_define_key (control_x_map, 'b', "switch-to-buffer");
2711 initial_define_key (control_x_map, 'k', "kill-buffer");
2712 initial_define_key (control_x_map, Ctl ('B'), "list-buffers");
4158c17d
RM
2713
2714 /* This must not be in syms_of_buffer, because Qdisabled is not
2715 initialized when that function gets called. */
2716 Fput (intern ("erase-buffer"), Qdisabled, Qt);
1ab256cb 2717}