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