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