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