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