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