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