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