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