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