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