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