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