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