[! SYSVIPC] (main): Fix uses of FD_* macros: fd_set arg is a pointer,
[bpt/emacs.git] / src / buffer.c
1 /* Buffer manipulation primitives for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994
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, 675 Mass Ave, Cambridge, MA 02139, USA. */
20
21
22 #include <sys/types.h>
23 #include <sys/stat.h>
24 #include <sys/param.h>
25
26 #ifndef MAXPATHLEN
27 /* in 4.1, param.h fails to define this. */
28 #define MAXPATHLEN 1024
29 #endif /* not MAXPATHLEN */
30
31 #include <config.h>
32 #include "lisp.h"
33 #include "intervals.h"
34 #include "window.h"
35 #include "commands.h"
36 #include "buffer.h"
37 #include "region-cache.h"
38 #include "indent.h"
39 #include "blockinput.h"
40
41 struct buffer *current_buffer; /* the current buffer */
42
43 /* First buffer in chain of all buffers (in reverse order of creation).
44 Threaded through ->next. */
45
46 struct buffer *all_buffers;
47
48 /* This structure holds the default values of the buffer-local variables
49 defined with DEFVAR_PER_BUFFER, that have special slots in each buffer.
50 The default value occupies the same slot in this structure
51 as an individual buffer's value occupies in that buffer.
52 Setting the default value also goes through the alist of buffers
53 and stores into each buffer that does not say it has a local value. */
54
55 struct buffer buffer_defaults;
56
57 /* A Lisp_Object pointer to the above, used for staticpro */
58
59 static Lisp_Object Vbuffer_defaults;
60
61 /* This structure marks which slots in a buffer have corresponding
62 default values in buffer_defaults.
63 Each such slot has a nonzero value in this structure.
64 The value has only one nonzero bit.
65
66 When a buffer has its own local value for a slot,
67 the bit for that slot (found in the same slot in this structure)
68 is turned on in the buffer's local_var_flags slot.
69
70 If a slot in this structure is -1, then even though there may
71 be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
72 and the corresponding slot in buffer_defaults is not used.
73
74 If a slot is -2, then there is no DEFVAR_PER_BUFFER for it,
75 but there is a default value which is copied into each buffer.
76
77 If a slot in this structure is negative, then even though there may
78 be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
79 and the corresponding slot in buffer_defaults is not used.
80
81 If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is
82 zero, that is a bug */
83
84 struct buffer buffer_local_flags;
85
86 /* This structure holds the names of symbols whose values may be
87 buffer-local. It is indexed and accessed in the same way as the above. */
88
89 struct buffer buffer_local_symbols;
90 /* A Lisp_Object pointer to the above, used for staticpro */
91 static Lisp_Object Vbuffer_local_symbols;
92
93 /* This structure holds the required types for the values in the
94 buffer-local slots. If a slot contains Qnil, then the
95 corresponding buffer slot may contain a value of any type. If a
96 slot contains an integer, then prospective values' tags must be
97 equal to that integer. When a tag does not match, the function
98 buffer_slot_type_mismatch will signal an error. */
99 struct buffer buffer_local_types;
100
101 Lisp_Object Fset_buffer ();
102 void set_buffer_internal ();
103 static void call_overlay_mod_hooks ();
104
105 /* Alist of all buffer names vs the buffers. */
106 /* This used to be a variable, but is no longer,
107 to prevent lossage due to user rplac'ing this alist or its elements. */
108 Lisp_Object Vbuffer_alist;
109
110 /* Functions to call before and after each text change. */
111 Lisp_Object Vbefore_change_function;
112 Lisp_Object Vafter_change_function;
113 Lisp_Object Vbefore_change_functions;
114 Lisp_Object Vafter_change_functions;
115
116 Lisp_Object Vtransient_mark_mode;
117
118 /* t means ignore all read-only text properties.
119 A list means ignore such a property if its value is a member of the list.
120 Any non-nil value means ignore buffer-read-only. */
121 Lisp_Object Vinhibit_read_only;
122
123 /* List of functions to call that can query about killing a buffer.
124 If any of these functions returns nil, we don't kill it. */
125 Lisp_Object Vkill_buffer_query_functions;
126
127 /* List of functions to call before changing an unmodified buffer. */
128 Lisp_Object Vfirst_change_hook;
129 Lisp_Object Qfirst_change_hook;
130
131 Lisp_Object Qfundamental_mode, Qmode_class, Qpermanent_local;
132
133 Lisp_Object Qprotected_field;
134
135 Lisp_Object QSFundamental; /* A string "Fundamental" */
136
137 Lisp_Object Qkill_buffer_hook;
138
139 Lisp_Object Qget_file_buffer;
140
141 Lisp_Object Qoverlayp;
142
143 Lisp_Object Qpriority, Qwindow, Qevaporate;
144
145 Lisp_Object Qmodification_hooks;
146 Lisp_Object Qinsert_in_front_hooks;
147 Lisp_Object Qinsert_behind_hooks;
148
149 /* For debugging; temporary. See set_buffer_internal. */
150 /* Lisp_Object Qlisp_mode, Vcheck_symbol; */
151
152 nsberror (spec)
153 Lisp_Object spec;
154 {
155 if (STRINGP (spec))
156 error ("No buffer named %s", XSTRING (spec)->data);
157 error ("Invalid buffer argument");
158 }
159 \f
160 DEFUN ("buffer-list", Fbuffer_list, Sbuffer_list, 0, 0, 0,
161 "Return a list of all existing live buffers.")
162 ()
163 {
164 return Fmapcar (Qcdr, Vbuffer_alist);
165 }
166
167 DEFUN ("get-buffer", Fget_buffer, Sget_buffer, 1, 1, 0,
168 "Return the buffer named NAME (a string).\n\
169 If there is no live buffer named NAME, return nil.\n\
170 NAME may also be a buffer; if so, the value is that buffer.")
171 (name)
172 register Lisp_Object name;
173 {
174 if (BUFFERP (name))
175 return name;
176 CHECK_STRING (name, 0);
177
178 return Fcdr (Fassoc (name, Vbuffer_alist));
179 }
180
181 DEFUN ("get-file-buffer", Fget_file_buffer, Sget_file_buffer, 1, 1, 0,
182 "Return the buffer visiting file FILENAME (a string).\n\
183 The buffer's `buffer-file-name' must match exactly the expansion of FILENAME.\n\
184 If there is no such live buffer, return nil.\n\
185 See also `find-buffer-visiting'.")
186 (filename)
187 register Lisp_Object filename;
188 {
189 register Lisp_Object tail, buf, tem;
190 Lisp_Object handler;
191
192 CHECK_STRING (filename, 0);
193 filename = Fexpand_file_name (filename, Qnil);
194
195 /* If the file name has special constructs in it,
196 call the corresponding file handler. */
197 handler = Ffind_file_name_handler (filename, Qget_file_buffer);
198 if (!NILP (handler))
199 return call2 (handler, Qget_file_buffer, filename);
200
201 for (tail = Vbuffer_alist; CONSP (tail); tail = XCONS (tail)->cdr)
202 {
203 buf = Fcdr (XCONS (tail)->car);
204 if (!BUFFERP (buf)) continue;
205 if (!STRINGP (XBUFFER (buf)->filename)) continue;
206 tem = Fstring_equal (XBUFFER (buf)->filename, filename);
207 if (!NILP (tem))
208 return buf;
209 }
210 return Qnil;
211 }
212
213 /* Incremented for each buffer created, to assign the buffer number. */
214 int buffer_count;
215
216 DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 1, 0,
217 "Return the buffer named NAME, or create such a buffer and return it.\n\
218 A new buffer is created if there is no live buffer named NAME.\n\
219 If NAME starts with a space, the new buffer does not keep undo information.\n\
220 If NAME is a buffer instead of a string, then it is the value returned.\n\
221 The value is never nil.")
222 (name)
223 register Lisp_Object name;
224 {
225 register Lisp_Object buf, function, tem;
226 int count = specpdl_ptr - specpdl;
227 register struct buffer *b;
228
229 buf = Fget_buffer (name);
230 if (!NILP (buf))
231 return buf;
232
233 if (XSTRING (name)->size == 0)
234 error ("Empty string for buffer name is not allowed");
235
236 b = (struct buffer *) xmalloc (sizeof (struct buffer));
237
238 BUF_GAP_SIZE (b) = 20;
239 BLOCK_INPUT;
240 BUFFER_ALLOC (BUF_BEG_ADDR (b), BUF_GAP_SIZE (b));
241 UNBLOCK_INPUT;
242 if (! BUF_BEG_ADDR (b))
243 memory_full ();
244
245 BUF_PT (b) = 1;
246 BUF_GPT (b) = 1;
247 BUF_BEGV (b) = 1;
248 BUF_ZV (b) = 1;
249 BUF_Z (b) = 1;
250 BUF_MODIFF (b) = 1;
251
252 b->newline_cache = 0;
253 b->width_run_cache = 0;
254 b->width_table = Qnil;
255
256 /* Put this on the chain of all buffers including killed ones. */
257 b->next = all_buffers;
258 all_buffers = b;
259
260 b->mark = Fmake_marker ();
261 /*b->number = make_number (++buffer_count);*/
262 b->name = name;
263 if (XSTRING (name)->data[0] != ' ')
264 b->undo_list = Qnil;
265 else
266 b->undo_list = Qt;
267
268 reset_buffer (b);
269 reset_buffer_local_variables (b);
270
271 /* Put this in the alist of all live buffers. */
272 XSETBUFFER (buf, b);
273 Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));
274
275 b->mark = Fmake_marker ();
276 b->markers = Qnil;
277 b->name = name;
278
279 function = buffer_defaults.major_mode;
280 if (NILP (function))
281 {
282 tem = Fget (current_buffer->major_mode, Qmode_class);
283 if (EQ (tem, Qnil))
284 function = current_buffer->major_mode;
285 }
286
287 if (NILP (function) || EQ (function, Qfundamental_mode))
288 return buf;
289
290 /* To select a nonfundamental mode,
291 select the buffer temporarily and then call the mode function. */
292
293 record_unwind_protect (save_excursion_restore, save_excursion_save ());
294
295 Fset_buffer (buf);
296 call0 (function);
297
298 return unbind_to (count, buf);
299 }
300
301 /* Reinitialize everything about a buffer except its name and contents
302 and local variables. */
303
304 void
305 reset_buffer (b)
306 register struct buffer *b;
307 {
308 b->filename = Qnil;
309 b->directory = (current_buffer) ? current_buffer->directory : Qnil;
310 b->modtime = 0;
311 b->save_modified = 1;
312 XSETFASTINT (b->save_length, 0);
313 b->last_window_start = 1;
314 b->backed_up = Qnil;
315 b->auto_save_modified = 0;
316 b->auto_save_failure_time = -1;
317 b->auto_save_file_name = Qnil;
318 b->read_only = Qnil;
319 b->overlays_before = Qnil;
320 b->overlays_after = Qnil;
321 XSETFASTINT (b->overlay_center, 1);
322 b->mark_active = Qnil;
323
324 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
325 INITIALIZE_INTERVAL (b, NULL_INTERVAL);
326 }
327
328 /* Reset buffer B's local variables info.
329 Don't use this on a buffer that has already been in use;
330 it does not treat permanent locals consistently.
331 Instead, use Fkill_all_local_variables. */
332
333 reset_buffer_local_variables (b)
334 register struct buffer *b;
335 {
336 register int offset;
337
338 /* Reset the major mode to Fundamental, together with all the
339 things that depend on the major mode.
340 default-major-mode is handled at a higher level.
341 We ignore it here. */
342 b->major_mode = Qfundamental_mode;
343 b->keymap = Qnil;
344 b->abbrev_table = Vfundamental_mode_abbrev_table;
345 b->mode_name = QSFundamental;
346 b->minor_modes = Qnil;
347 b->downcase_table = Vascii_downcase_table;
348 b->upcase_table = Vascii_upcase_table;
349 b->case_canon_table = Vascii_canon_table;
350 b->case_eqv_table = Vascii_eqv_table;
351 #if 0
352 b->sort_table = XSTRING (Vascii_sort_table);
353 b->folding_sort_table = XSTRING (Vascii_folding_sort_table);
354 #endif /* 0 */
355
356 /* Reset all per-buffer variables to their defaults. */
357 b->local_var_alist = Qnil;
358 b->local_var_flags = 0;
359
360 /* For each slot that has a default value,
361 copy that into the slot. */
362
363 for (offset = (char *)&buffer_local_flags.name - (char *)&buffer_local_flags;
364 offset < sizeof (struct buffer);
365 offset += sizeof (Lisp_Object)) /* sizeof EMACS_INT == sizeof Lisp_Object */
366 {
367 int flag = XINT (*(Lisp_Object *)(offset + (char *)&buffer_local_flags));
368 if (flag > 0 || flag == -2)
369 *(Lisp_Object *)(offset + (char *)b) =
370 *(Lisp_Object *)(offset + (char *)&buffer_defaults);
371 }
372 }
373
374 /* We split this away from generate-new-buffer, because rename-buffer
375 and set-visited-file-name ought to be able to use this to really
376 rename the buffer properly. */
377
378 DEFUN ("generate-new-buffer-name", Fgenerate_new_buffer_name, Sgenerate_new_buffer_name,
379 1, 2, 0,
380 "Return a string that is the name of no existing buffer based on NAME.\n\
381 If there is no live buffer named NAME, then return NAME.\n\
382 Otherwise modify name by appending `<NUMBER>', incrementing NUMBER\n\
383 until an unused name is found, and then return that name.\n\
384 Optional second argument IGNORE specifies a name that is okay to use\n\
385 \(if it is in the sequence to be tried)\n\
386 even if a buffer with that name exists.")
387 (name, ignore)
388 register Lisp_Object name, ignore;
389 {
390 register Lisp_Object gentemp, tem;
391 int count;
392 char number[10];
393
394 CHECK_STRING (name, 0);
395
396 tem = Fget_buffer (name);
397 if (NILP (tem))
398 return name;
399
400 count = 1;
401 while (1)
402 {
403 sprintf (number, "<%d>", ++count);
404 gentemp = concat2 (name, build_string (number));
405 tem = Fstring_equal (gentemp, ignore);
406 if (!NILP (tem))
407 return gentemp;
408 tem = Fget_buffer (gentemp);
409 if (NILP (tem))
410 return gentemp;
411 }
412 }
413
414 \f
415 DEFUN ("buffer-name", Fbuffer_name, Sbuffer_name, 0, 1, 0,
416 "Return the name of BUFFER, as a string.\n\
417 With no argument or nil as argument, return the name of the current buffer.")
418 (buffer)
419 register Lisp_Object buffer;
420 {
421 if (NILP (buffer))
422 return current_buffer->name;
423 CHECK_BUFFER (buffer, 0);
424 return XBUFFER (buffer)->name;
425 }
426
427 DEFUN ("buffer-file-name", Fbuffer_file_name, Sbuffer_file_name, 0, 1, 0,
428 "Return name of file BUFFER is visiting, or nil if none.\n\
429 No argument or nil as argument means use the current buffer.")
430 (buffer)
431 register Lisp_Object buffer;
432 {
433 if (NILP (buffer))
434 return current_buffer->filename;
435 CHECK_BUFFER (buffer, 0);
436 return XBUFFER (buffer)->filename;
437 }
438
439 DEFUN ("buffer-local-variables", Fbuffer_local_variables,
440 Sbuffer_local_variables, 0, 1, 0,
441 "Return an alist of variables that are buffer-local in BUFFER.\n\
442 Most elements look like (SYMBOL . VALUE), describing one variable.\n\
443 For a symbol that is locally unbound, just the symbol appears in the value.\n\
444 Note that storing new VALUEs in these elements doesn't change the variables.\n\
445 No argument or nil as argument means use current buffer as BUFFER.")
446 (buffer)
447 register Lisp_Object buffer;
448 {
449 register struct buffer *buf;
450 register Lisp_Object result;
451
452 if (NILP (buffer))
453 buf = current_buffer;
454 else
455 {
456 CHECK_BUFFER (buffer, 0);
457 buf = XBUFFER (buffer);
458 }
459
460 result = Qnil;
461
462 {
463 /* Reference each variable in the alist in our current buffer.
464 If inquiring about the current buffer, this gets the current values,
465 so store them into the alist so the alist is up to date.
466 If inquiring about some other buffer, this swaps out any values
467 for that buffer, making the alist up to date automatically. */
468 register Lisp_Object tail;
469 for (tail = buf->local_var_alist; CONSP (tail); tail = XCONS (tail)->cdr)
470 {
471 Lisp_Object val, elt;
472
473 elt = XCONS (tail)->car;
474
475 if (buf == current_buffer)
476 val = find_symbol_value (XCONS (elt)->car);
477 else
478 val = XCONS (elt)->cdr;
479
480 /* If symbol is unbound, put just the symbol in the list. */
481 if (EQ (val, Qunbound))
482 result = Fcons (XCONS (elt)->car, result);
483 /* Otherwise, put (symbol . value) in the list. */
484 else
485 result = Fcons (Fcons (XCONS (elt)->car, val), result);
486 }
487 }
488
489 /* Add on all the variables stored in special slots. */
490 {
491 register int offset, mask;
492
493 for (offset = (char *)&buffer_local_symbols.name - (char *)&buffer_local_symbols;
494 offset < sizeof (struct buffer);
495 offset += (sizeof (EMACS_INT))) /* sizeof EMACS_INT == sizeof Lisp_Object */
496 {
497 mask = XINT (*(Lisp_Object *)(offset + (char *)&buffer_local_flags));
498 if (mask == -1 || (buf->local_var_flags & mask))
499 if (SYMBOLP (*(Lisp_Object *)(offset
500 + (char *)&buffer_local_symbols)))
501 result = Fcons (Fcons (*((Lisp_Object *)
502 (offset + (char *)&buffer_local_symbols)),
503 *(Lisp_Object *)(offset + (char *)buf)),
504 result);
505 }
506 }
507
508 return result;
509 }
510
511 \f
512 DEFUN ("buffer-modified-p", Fbuffer_modified_p, Sbuffer_modified_p,
513 0, 1, 0,
514 "Return t if BUFFER was modified since its file was last read or saved.\n\
515 No argument or nil as argument means use current buffer as BUFFER.")
516 (buffer)
517 register Lisp_Object buffer;
518 {
519 register struct buffer *buf;
520 if (NILP (buffer))
521 buf = current_buffer;
522 else
523 {
524 CHECK_BUFFER (buffer, 0);
525 buf = XBUFFER (buffer);
526 }
527
528 return buf->save_modified < BUF_MODIFF (buf) ? Qt : Qnil;
529 }
530
531 DEFUN ("set-buffer-modified-p", Fset_buffer_modified_p, Sset_buffer_modified_p,
532 1, 1, 0,
533 "Mark current buffer as modified or unmodified according to FLAG.\n\
534 A non-nil FLAG means mark the buffer modified.")
535 (flag)
536 register Lisp_Object flag;
537 {
538 register int already;
539 register Lisp_Object fn;
540
541 #ifdef CLASH_DETECTION
542 /* If buffer becoming modified, lock the file.
543 If buffer becoming unmodified, unlock the file. */
544
545 fn = current_buffer->filename;
546 if (!NILP (fn))
547 {
548 already = current_buffer->save_modified < MODIFF;
549 if (!already && !NILP (flag))
550 lock_file (fn);
551 else if (already && NILP (flag))
552 unlock_file (fn);
553 }
554 #endif /* CLASH_DETECTION */
555
556 current_buffer->save_modified = NILP (flag) ? MODIFF : 0;
557 update_mode_lines++;
558 return flag;
559 }
560
561 DEFUN ("buffer-modified-tick", Fbuffer_modified_tick, Sbuffer_modified_tick,
562 0, 1, 0,
563 "Return BUFFER's tick counter, incremented for each change in text.\n\
564 Each buffer has a tick counter which is incremented each time the text in\n\
565 that buffer is changed. It wraps around occasionally.\n\
566 No argument or nil as argument means use current buffer as BUFFER.")
567 (buffer)
568 register Lisp_Object buffer;
569 {
570 register struct buffer *buf;
571 if (NILP (buffer))
572 buf = current_buffer;
573 else
574 {
575 CHECK_BUFFER (buffer, 0);
576 buf = XBUFFER (buffer);
577 }
578
579 return make_number (BUF_MODIFF (buf));
580 }
581 \f
582 DEFUN ("rename-buffer", Frename_buffer, Srename_buffer, 1, 2,
583 "sRename buffer (to new name): \nP",
584 "Change current buffer's name to NEWNAME (a string).\n\
585 If second arg UNIQUE is nil or omitted, it is an error if a\n\
586 buffer named NEWNAME already exists.\n\
587 If UNIQUE is non-nil, come up with a new name using\n\
588 `generate-new-buffer-name'.\n\
589 Interactively, you can set UNIQUE with a prefix argument.\n\
590 We return the name we actually gave the buffer.\n\
591 This does not change the name of the visited file (if any).")
592 (name, unique)
593 register Lisp_Object name, unique;
594 {
595 register Lisp_Object tem, buf;
596
597 CHECK_STRING (name, 0);
598
599 if (XSTRING (name)->size == 0)
600 error ("Empty string is invalid as a buffer name");
601
602 tem = Fget_buffer (name);
603 /* Don't short-circuit if UNIQUE is t. That is a useful way to rename
604 the buffer automatically so you can create another with the original name.
605 It makes UNIQUE equivalent to
606 (rename-buffer (generate-new-buffer-name NAME)). */
607 if (NILP (unique) && XBUFFER (tem) == current_buffer)
608 return current_buffer->name;
609 if (!NILP (tem))
610 {
611 if (!NILP (unique))
612 name = Fgenerate_new_buffer_name (name, current_buffer->name);
613 else
614 error ("Buffer name \"%s\" is in use", XSTRING (name)->data);
615 }
616
617 current_buffer->name = name;
618
619 /* Catch redisplay's attention. Unless we do this, the mode lines for
620 any windows displaying current_buffer will stay unchanged. */
621 update_mode_lines++;
622
623 XSETBUFFER (buf, current_buffer);
624 Fsetcar (Frassq (buf, Vbuffer_alist), name);
625 if (NILP (current_buffer->filename)
626 && !NILP (current_buffer->auto_save_file_name))
627 call0 (intern ("rename-auto-save-file"));
628 /* refetch since that last call may have done GC */
629 return current_buffer->name;
630 }
631
632 DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 2, 0,
633 "Return most recently selected buffer other than BUFFER.\n\
634 Buffers not visible in windows are preferred to visible buffers,\n\
635 unless optional second argument VISIBLE-OK is non-nil.\n\
636 If no other buffer exists, the buffer `*scratch*' is returned.\n\
637 If BUFFER is omitted or nil, some interesting buffer is returned.")
638 (buffer, visible_ok)
639 register Lisp_Object buffer, visible_ok;
640 {
641 register Lisp_Object tail, buf, notsogood, tem;
642 notsogood = Qnil;
643
644 for (tail = Vbuffer_alist; !NILP (tail); tail = Fcdr (tail))
645 {
646 buf = Fcdr (Fcar (tail));
647 if (EQ (buf, buffer))
648 continue;
649 if (XSTRING (XBUFFER (buf)->name)->data[0] == ' ')
650 continue;
651 if (NILP (visible_ok))
652 tem = Fget_buffer_window (buf, Qt);
653 else
654 tem = Qnil;
655 if (NILP (tem))
656 return buf;
657 if (NILP (notsogood))
658 notsogood = buf;
659 }
660 if (!NILP (notsogood))
661 return notsogood;
662 return Fget_buffer_create (build_string ("*scratch*"));
663 }
664 \f
665 DEFUN ("buffer-disable-undo", Fbuffer_disable_undo, Sbuffer_disable_undo, 0, 1,
666 0,
667 "Make BUFFER stop keeping undo information.\n\
668 No argument or nil as argument means do this for the current buffer.")
669 (buffer)
670 register Lisp_Object buffer;
671 {
672 Lisp_Object real_buffer;
673
674 if (NILP (buffer))
675 XSETBUFFER (real_buffer, current_buffer);
676 else
677 {
678 real_buffer = Fget_buffer (buffer);
679 if (NILP (real_buffer))
680 nsberror (buffer);
681 }
682
683 XBUFFER (real_buffer)->undo_list = Qt;
684
685 return Qnil;
686 }
687
688 DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, Sbuffer_enable_undo,
689 0, 1, "",
690 "Start keeping undo information for buffer BUFFER.\n\
691 No argument or nil as argument means do this for the current buffer.")
692 (buffer)
693 register Lisp_Object buffer;
694 {
695 Lisp_Object real_buffer;
696
697 if (NILP (buffer))
698 XSETBUFFER (real_buffer, current_buffer);
699 else
700 {
701 real_buffer = Fget_buffer (buffer);
702 if (NILP (real_buffer))
703 nsberror (buffer);
704 }
705
706 if (EQ (XBUFFER (real_buffer)->undo_list, Qt))
707 XBUFFER (real_buffer)->undo_list = Qnil;
708
709 return Qnil;
710 }
711
712 /*
713 DEFVAR_LISP ("kill-buffer-hook", no_cell, "\
714 Hook to be run (by `run-hooks', which see) when a buffer is killed.\n\
715 The buffer being killed will be current while the hook is running.\n\
716 See `kill-buffer'."
717 */
718 DEFUN ("kill-buffer", Fkill_buffer, Skill_buffer, 1, 1, "bKill buffer: ",
719 "Kill the buffer BUFFER.\n\
720 The argument may be a buffer or may be the name of a buffer.\n\
721 An argument of nil means kill the current buffer.\n\n\
722 Value is t if the buffer is actually killed, nil if user says no.\n\n\
723 The value of `kill-buffer-hook' (which may be local to that buffer),\n\
724 if not void, is a list of functions to be called, with no arguments,\n\
725 before the buffer is actually killed. The buffer to be killed is current\n\
726 when the hook functions are called.\n\n\
727 Any processes that have this buffer as the `process-buffer' are killed\n\
728 with `delete-process'.")
729 (bufname)
730 Lisp_Object bufname;
731 {
732 Lisp_Object buf;
733 register struct buffer *b;
734 register Lisp_Object tem;
735 register struct Lisp_Marker *m;
736 struct gcpro gcpro1, gcpro2;
737
738 if (NILP (bufname))
739 buf = Fcurrent_buffer ();
740 else
741 buf = Fget_buffer (bufname);
742 if (NILP (buf))
743 nsberror (bufname);
744
745 b = XBUFFER (buf);
746
747 /* Query if the buffer is still modified. */
748 if (INTERACTIVE && !NILP (b->filename)
749 && BUF_MODIFF (b) > b->save_modified)
750 {
751 GCPRO2 (buf, bufname);
752 tem = do_yes_or_no_p (format1 ("Buffer %s modified; kill anyway? ",
753 XSTRING (b->name)->data));
754 UNGCPRO;
755 if (NILP (tem))
756 return Qnil;
757 }
758
759 /* Run hooks with the buffer to be killed the current buffer. */
760 {
761 register Lisp_Object val;
762 int count = specpdl_ptr - specpdl;
763 Lisp_Object list;
764
765 record_unwind_protect (save_excursion_restore, save_excursion_save ());
766 set_buffer_internal (b);
767
768 /* First run the query functions; if any query is answered no,
769 don't kill the buffer. */
770 for (list = Vkill_buffer_query_functions; !NILP (list); list = Fcdr (list))
771 {
772 tem = call0 (Fcar (list));
773 if (NILP (tem))
774 return unbind_to (count, Qnil);
775 }
776
777 /* Then run the hooks. */
778 if (!NILP (Vrun_hooks))
779 call1 (Vrun_hooks, Qkill_buffer_hook);
780 unbind_to (count, Qnil);
781 }
782
783 /* We have no more questions to ask. Verify that it is valid
784 to kill the buffer. This must be done after the questions
785 since anything can happen within do_yes_or_no_p. */
786
787 /* Don't kill the minibuffer now current. */
788 if (EQ (buf, XWINDOW (minibuf_window)->buffer))
789 return Qnil;
790
791 if (NILP (b->name))
792 return Qnil;
793
794 /* Make this buffer not be current.
795 In the process, notice if this is the sole visible buffer
796 and give up if so. */
797 if (b == current_buffer)
798 {
799 tem = Fother_buffer (buf, Qnil);
800 Fset_buffer (tem);
801 if (b == current_buffer)
802 return Qnil;
803 }
804
805 /* Now there is no question: we can kill the buffer. */
806
807 #ifdef CLASH_DETECTION
808 /* Unlock this buffer's file, if it is locked. */
809 unlock_buffer (b);
810 #endif /* CLASH_DETECTION */
811
812 kill_buffer_processes (buf);
813
814 tem = Vinhibit_quit;
815 Vinhibit_quit = Qt;
816 Vbuffer_alist = Fdelq (Frassq (buf, Vbuffer_alist), Vbuffer_alist);
817 Freplace_buffer_in_windows (buf);
818 Vinhibit_quit = tem;
819
820 /* Delete any auto-save file, if we saved it in this session. */
821 if (STRINGP (b->auto_save_file_name)
822 && b->auto_save_modified != 0)
823 {
824 Lisp_Object tem;
825 tem = Fsymbol_value (intern ("delete-auto-save-files"));
826 if (! NILP (tem))
827 unlink (XSTRING (b->auto_save_file_name)->data);
828 }
829
830 /* Unchain all markers of this buffer
831 and leave them pointing nowhere. */
832 for (tem = b->markers; !EQ (tem, Qnil); )
833 {
834 m = XMARKER (tem);
835 m->buffer = 0;
836 tem = m->chain;
837 m->chain = Qnil;
838 }
839 b->markers = Qnil;
840
841 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
842 INITIALIZE_INTERVAL (b, NULL_INTERVAL);
843 /* Perhaps we should explicitly free the interval tree here... */
844
845 b->name = Qnil;
846 BLOCK_INPUT;
847 BUFFER_FREE (BUF_BEG_ADDR (b));
848 if (b->newline_cache)
849 {
850 free_region_cache (b->newline_cache);
851 b->newline_cache = 0;
852 }
853 if (b->width_run_cache)
854 {
855 free_region_cache (b->width_run_cache);
856 b->width_run_cache = 0;
857 }
858 b->width_table = Qnil;
859 UNBLOCK_INPUT;
860 b->undo_list = Qnil;
861
862 return Qt;
863 }
864 \f
865 /* Move the assoc for buffer BUF to the front of buffer-alist. Since
866 we do this each time BUF is selected visibly, the more recently
867 selected buffers are always closer to the front of the list. This
868 means that other_buffer is more likely to choose a relevant buffer. */
869
870 record_buffer (buf)
871 Lisp_Object buf;
872 {
873 register Lisp_Object link, prev;
874
875 prev = Qnil;
876 for (link = Vbuffer_alist; CONSP (link); link = XCONS (link)->cdr)
877 {
878 if (EQ (XCONS (XCONS (link)->car)->cdr, buf))
879 break;
880 prev = link;
881 }
882
883 /* Effectively do Vbuffer_alist = Fdelq (link, Vbuffer_alist);
884 we cannot use Fdelq itself here because it allows quitting. */
885
886 if (NILP (prev))
887 Vbuffer_alist = XCONS (Vbuffer_alist)->cdr;
888 else
889 XCONS (prev)->cdr = XCONS (XCONS (prev)->cdr)->cdr;
890
891 XCONS(link)->cdr = Vbuffer_alist;
892 Vbuffer_alist = link;
893 }
894
895 DEFUN ("switch-to-buffer", Fswitch_to_buffer, Sswitch_to_buffer, 1, 2, "BSwitch to buffer: ",
896 "Select buffer BUFFER in the current window.\n\
897 BUFFER may be a buffer or a buffer name.\n\
898 Optional second arg NORECORD non-nil means\n\
899 do not put this buffer at the front of the list of recently selected ones.\n\
900 \n\
901 WARNING: This is NOT the way to work on another buffer temporarily\n\
902 within a Lisp program! Use `set-buffer' instead. That avoids messing with\n\
903 the window-buffer correspondences.")
904 (bufname, norecord)
905 Lisp_Object bufname, norecord;
906 {
907 register Lisp_Object buf;
908 Lisp_Object tem;
909
910 if (EQ (minibuf_window, selected_window))
911 error ("Cannot switch buffers in minibuffer window");
912 tem = Fwindow_dedicated_p (selected_window);
913 if (!NILP (tem))
914 error ("Cannot switch buffers in a dedicated window");
915
916 if (NILP (bufname))
917 buf = Fother_buffer (Fcurrent_buffer (), Qnil);
918 else
919 buf = Fget_buffer_create (bufname);
920 Fset_buffer (buf);
921 if (NILP (norecord))
922 record_buffer (buf);
923
924 Fset_window_buffer (EQ (selected_window, minibuf_window)
925 ? Fnext_window (minibuf_window, Qnil, Qnil)
926 : selected_window,
927 buf);
928
929 return buf;
930 }
931
932 DEFUN ("pop-to-buffer", Fpop_to_buffer, Spop_to_buffer, 1, 2, 0,
933 "Select buffer BUFFER in some window, preferably a different one.\n\
934 If BUFFER is nil, then some other buffer is chosen.\n\
935 If `pop-up-windows' is non-nil, windows can be split to do this.\n\
936 If optional second arg OTHER-WINDOW is non-nil, insist on finding another\n\
937 window even if BUFFER is already visible in the selected window.")
938 (bufname, other)
939 Lisp_Object bufname, other;
940 {
941 register Lisp_Object buf;
942 if (NILP (bufname))
943 buf = Fother_buffer (Fcurrent_buffer (), Qnil);
944 else
945 buf = Fget_buffer_create (bufname);
946 Fset_buffer (buf);
947 record_buffer (buf);
948 Fselect_window (Fdisplay_buffer (buf, other));
949 return buf;
950 }
951
952 DEFUN ("current-buffer", Fcurrent_buffer, Scurrent_buffer, 0, 0, 0,
953 "Return the current buffer as a Lisp object.")
954 ()
955 {
956 register Lisp_Object buf;
957 XSETBUFFER (buf, current_buffer);
958 return buf;
959 }
960 \f
961 /* Set the current buffer to b */
962
963 void
964 set_buffer_internal (b)
965 register struct buffer *b;
966 {
967 register struct buffer *old_buf;
968 register Lisp_Object tail, valcontents;
969 Lisp_Object tem;
970
971 if (current_buffer == b)
972 return;
973
974 windows_or_buffers_changed = 1;
975 old_buf = current_buffer;
976 current_buffer = b;
977 last_known_column_point = -1; /* invalidate indentation cache */
978
979 /* Look down buffer's list of local Lisp variables
980 to find and update any that forward into C variables. */
981
982 for (tail = b->local_var_alist; !NILP (tail); tail = XCONS (tail)->cdr)
983 {
984 valcontents = XSYMBOL (XCONS (XCONS (tail)->car)->car)->value;
985 if ((BUFFER_LOCAL_VALUEP (valcontents)
986 || SOME_BUFFER_LOCAL_VALUEP (valcontents))
987 && (tem = XCONS (valcontents)->car,
988 (BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem))))
989 /* Just reference the variable
990 to cause it to become set for this buffer. */
991 Fsymbol_value (XCONS (XCONS (tail)->car)->car);
992 }
993
994 /* Do the same with any others that were local to the previous buffer */
995
996 if (old_buf)
997 for (tail = old_buf->local_var_alist; !NILP (tail); tail = XCONS (tail)->cdr)
998 {
999 valcontents = XSYMBOL (XCONS (XCONS (tail)->car)->car)->value;
1000 if ((BUFFER_LOCAL_VALUEP (valcontents)
1001 || SOME_BUFFER_LOCAL_VALUEP (valcontents))
1002 && (tem = XCONS (valcontents)->car,
1003 (BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem))))
1004 /* Just reference the variable
1005 to cause it to become set for this buffer. */
1006 Fsymbol_value (XCONS (XCONS (tail)->car)->car);
1007 }
1008 }
1009
1010 DEFUN ("set-buffer", Fset_buffer, Sset_buffer, 1, 1, 0,
1011 "Make the buffer BUFFER current for editing operations.\n\
1012 BUFFER may be a buffer or the name of an existing buffer.\n\
1013 See also `save-excursion' when you want to make a buffer current temporarily.\n\
1014 This function does not display the buffer, so its effect ends\n\
1015 when the current command terminates.\n\
1016 Use `switch-to-buffer' or `pop-to-buffer' to switch buffers permanently.")
1017 (bufname)
1018 register Lisp_Object bufname;
1019 {
1020 register Lisp_Object buffer;
1021 buffer = Fget_buffer (bufname);
1022 if (NILP (buffer))
1023 nsberror (bufname);
1024 if (NILP (XBUFFER (buffer)->name))
1025 error ("Selecting deleted buffer");
1026 set_buffer_internal (XBUFFER (buffer));
1027 return buffer;
1028 }
1029 \f
1030 DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only,
1031 Sbarf_if_buffer_read_only, 0, 0, 0,
1032 "Signal a `buffer-read-only' error if the current buffer is read-only.")
1033 ()
1034 {
1035 if (!NILP (current_buffer->read_only)
1036 && NILP (Vinhibit_read_only))
1037 Fsignal (Qbuffer_read_only, (Fcons (Fcurrent_buffer (), Qnil)));
1038 return Qnil;
1039 }
1040
1041 DEFUN ("bury-buffer", Fbury_buffer, Sbury_buffer, 0, 1, "",
1042 "Put BUFFER at the end of the list of all buffers.\n\
1043 There it is the least likely candidate for `other-buffer' to return;\n\
1044 thus, the least likely buffer for \\[switch-to-buffer] to select by default.\n\
1045 If BUFFER is nil or omitted, bury the current buffer.\n\
1046 Also, if BUFFER is nil or omitted, remove the current buffer from the\n\
1047 selected window if it is displayed there.")
1048 (buf)
1049 register Lisp_Object buf;
1050 {
1051 /* Figure out what buffer we're going to bury. */
1052 if (NILP (buf))
1053 {
1054 XSETBUFFER (buf, current_buffer);
1055
1056 /* If we're burying the current buffer, unshow it. */
1057 Fswitch_to_buffer (Fother_buffer (buf, Qnil), Qnil);
1058 }
1059 else
1060 {
1061 Lisp_Object buf1;
1062
1063 buf1 = Fget_buffer (buf);
1064 if (NILP (buf1))
1065 nsberror (buf);
1066 buf = buf1;
1067 }
1068
1069 /* Move buf to the end of the buffer list. */
1070 {
1071 register Lisp_Object aelt, link;
1072
1073 aelt = Frassq (buf, Vbuffer_alist);
1074 link = Fmemq (aelt, Vbuffer_alist);
1075 Vbuffer_alist = Fdelq (aelt, Vbuffer_alist);
1076 XCONS (link)->cdr = Qnil;
1077 Vbuffer_alist = nconc2 (Vbuffer_alist, link);
1078 }
1079
1080 return Qnil;
1081 }
1082 \f
1083 DEFUN ("erase-buffer", Ferase_buffer, Serase_buffer, 0, 0, "*",
1084 "Delete the entire contents of the current buffer.\n\
1085 Any narrowing restriction in effect (see `narrow-to-region') is removed,\n\
1086 so the buffer is truly empty after this.")
1087 ()
1088 {
1089 Fwiden ();
1090 del_range (BEG, Z);
1091 current_buffer->last_window_start = 1;
1092 /* Prevent warnings, or suspension of auto saving, that would happen
1093 if future size is less than past size. Use of erase-buffer
1094 implies that the future text is not really related to the past text. */
1095 XSETFASTINT (current_buffer->save_length, 0);
1096 return Qnil;
1097 }
1098
1099 validate_region (b, e)
1100 register Lisp_Object *b, *e;
1101 {
1102 CHECK_NUMBER_COERCE_MARKER (*b, 0);
1103 CHECK_NUMBER_COERCE_MARKER (*e, 1);
1104
1105 if (XINT (*b) > XINT (*e))
1106 {
1107 Lisp_Object tem;
1108 tem = *b; *b = *e; *e = tem;
1109 }
1110
1111 if (!(BEGV <= XINT (*b) && XINT (*b) <= XINT (*e)
1112 && XINT (*e) <= ZV))
1113 args_out_of_range (*b, *e);
1114 }
1115 \f
1116 static Lisp_Object
1117 list_buffers_1 (files)
1118 Lisp_Object files;
1119 {
1120 register Lisp_Object tail, tem, buf;
1121 Lisp_Object col1, col2, col3, minspace;
1122 register struct buffer *old = current_buffer, *b;
1123 Lisp_Object desired_point;
1124 Lisp_Object other_file_symbol;
1125
1126 desired_point = Qnil;
1127 other_file_symbol = intern ("list-buffers-directory");
1128
1129 XSETFASTINT (col1, 19);
1130 XSETFASTINT (col2, 26);
1131 XSETFASTINT (col3, 40);
1132 XSETFASTINT (minspace, 1);
1133
1134 Fset_buffer (Vstandard_output);
1135 Fbuffer_disable_undo (Vstandard_output);
1136 current_buffer->read_only = Qnil;
1137
1138 write_string ("\
1139 MR Buffer Size Mode File\n\
1140 -- ------ ---- ---- ----\n", -1);
1141
1142 for (tail = Vbuffer_alist; !NILP (tail); tail = Fcdr (tail))
1143 {
1144 buf = Fcdr (Fcar (tail));
1145 b = XBUFFER (buf);
1146 /* Don't mention the minibuffers. */
1147 if (XSTRING (b->name)->data[0] == ' ')
1148 continue;
1149 /* Optionally don't mention buffers that lack files. */
1150 if (!NILP (files) && NILP (b->filename))
1151 continue;
1152 /* Identify the current buffer. */
1153 if (b == old)
1154 XSETFASTINT (desired_point, point);
1155 write_string (b == old ? "." : " ", -1);
1156 /* Identify modified buffers */
1157 write_string (BUF_MODIFF (b) > b->save_modified ? "*" : " ", -1);
1158 write_string (NILP (b->read_only) ? " " : "% ", -1);
1159 Fprinc (b->name, Qnil);
1160 Findent_to (col1, make_number (2));
1161 XSETFASTINT (tem, BUF_Z (b) - BUF_BEG (b));
1162 Fprin1 (tem, Qnil);
1163 Findent_to (col2, minspace);
1164 Fprinc (b->mode_name, Qnil);
1165 Findent_to (col3, minspace);
1166
1167 if (!NILP (b->filename))
1168 Fprinc (b->filename, Qnil);
1169 else
1170 {
1171 /* No visited file; check local value of list-buffers-directory. */
1172 Lisp_Object tem;
1173 set_buffer_internal (b);
1174 tem = Fboundp (other_file_symbol);
1175 if (!NILP (tem))
1176 {
1177 tem = Fsymbol_value (other_file_symbol);
1178 Fset_buffer (Vstandard_output);
1179 if (STRINGP (tem))
1180 Fprinc (tem, Qnil);
1181 }
1182 else
1183 Fset_buffer (Vstandard_output);
1184 }
1185 write_string ("\n", -1);
1186 }
1187
1188 tail = intern ("Buffer-menu-mode");
1189 if ((tem = Ffboundp (tail), !NILP (tem)))
1190 call0 (tail);
1191 set_buffer_internal (old);
1192 return desired_point;
1193 }
1194
1195 DEFUN ("list-buffers", Flist_buffers, Slist_buffers, 0, 1, "P",
1196 "Display a list of names of existing buffers.\n\
1197 The list is displayed in a buffer named `*Buffer List*'.\n\
1198 Note that buffers with names starting with spaces are omitted.\n\
1199 Non-null optional arg FILES-ONLY means mention only file buffers.\n\
1200 \n\
1201 The M column contains a * for buffers that are modified.\n\
1202 The R column contains a % for buffers that are read-only.")
1203 (files)
1204 Lisp_Object files;
1205 {
1206 Lisp_Object desired_point;
1207
1208 desired_point
1209 = internal_with_output_to_temp_buffer ("*Buffer List*",
1210 list_buffers_1, files);
1211
1212 if (NUMBERP (desired_point))
1213 {
1214 int count = specpdl_ptr - specpdl;
1215 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
1216 Fset_buffer (build_string ("*Buffer List*"));
1217 SET_PT (XINT (desired_point));
1218 return unbind_to (count, Qnil);
1219 }
1220 return Qnil;
1221 }
1222
1223 DEFUN ("kill-all-local-variables", Fkill_all_local_variables, Skill_all_local_variables,
1224 0, 0, 0,
1225 "Switch to Fundamental mode by killing current buffer's local variables.\n\
1226 Most local variable bindings are eliminated so that the default values\n\
1227 become effective once more. Also, the syntax table is set from\n\
1228 `standard-syntax-table', the local keymap is set to nil,\n\
1229 and the abbrev table from `fundamental-mode-abbrev-table'.\n\
1230 This function also forces redisplay of the mode line.\n\
1231 \n\
1232 Every function to select a new major mode starts by\n\
1233 calling this function.\n\n\
1234 As a special exception, local variables whose names have\n\
1235 a non-nil `permanent-local' property are not eliminated by this function.\n\
1236 \n\
1237 The first thing this function does is run\n\
1238 the normal hook `change-major-mode-hook'.")
1239 ()
1240 {
1241 register Lisp_Object alist, sym, tem;
1242 Lisp_Object oalist;
1243
1244 if (!NILP (Vrun_hooks))
1245 call1 (Vrun_hooks, intern ("change-major-mode-hook"));
1246 oalist = current_buffer->local_var_alist;
1247
1248 /* Make sure no local variables remain set up with this buffer
1249 for their current values. */
1250
1251 for (alist = oalist; !NILP (alist); alist = XCONS (alist)->cdr)
1252 {
1253 sym = XCONS (XCONS (alist)->car)->car;
1254
1255 /* Need not do anything if some other buffer's binding is now encached. */
1256 tem = XCONS (XCONS (XSYMBOL (sym)->value)->cdr)->car;
1257 if (XBUFFER (tem) == current_buffer)
1258 {
1259 /* Symbol is set up for this buffer's old local value.
1260 Set it up for the current buffer with the default value. */
1261
1262 tem = XCONS (XCONS (XSYMBOL (sym)->value)->cdr)->cdr;
1263 /* Store the symbol's current value into the alist entry
1264 it is currently set up for. This is so that, if the
1265 local is marked permanent, and we make it local again below,
1266 we don't lose the value. */
1267 XCONS (XCONS (tem)->car)->cdr
1268 = do_symval_forwarding (XCONS (XSYMBOL (sym)->value)->car);
1269 /* Switch to the symbol's default-value alist entry. */
1270 XCONS (tem)->car = tem;
1271 /* Mark it as current for the current buffer. */
1272 XCONS (XCONS (XSYMBOL (sym)->value)->cdr)->car = Fcurrent_buffer ();
1273 /* Store the current value into any forwarding in the symbol. */
1274 store_symval_forwarding (sym, XCONS (XSYMBOL (sym)->value)->car,
1275 XCONS (tem)->cdr);
1276 }
1277 }
1278
1279 /* Actually eliminate all local bindings of this buffer. */
1280
1281 reset_buffer_local_variables (current_buffer);
1282
1283 /* Redisplay mode lines; we are changing major mode. */
1284
1285 update_mode_lines++;
1286
1287 /* Any which are supposed to be permanent,
1288 make local again, with the same values they had. */
1289
1290 for (alist = oalist; !NILP (alist); alist = XCONS (alist)->cdr)
1291 {
1292 sym = XCONS (XCONS (alist)->car)->car;
1293 tem = Fget (sym, Qpermanent_local);
1294 if (! NILP (tem))
1295 {
1296 Fmake_local_variable (sym);
1297 Fset (sym, XCONS (XCONS (alist)->car)->cdr);
1298 }
1299 }
1300
1301 /* Force mode-line redisplay. Useful here because all major mode
1302 commands call this function. */
1303 update_mode_lines++;
1304
1305 return Qnil;
1306 }
1307 \f
1308 /* Find all the overlays in the current buffer that contain position POS.
1309 Return the number found, and store them in a vector in *VEC_PTR.
1310 Store in *LEN_PTR the size allocated for the vector.
1311 Store in *NEXT_PTR the next position after POS where an overlay starts,
1312 or ZV if there are no more overlays.
1313 Store in *PREV_PTR the previous position after POS where an overlay ends,
1314 or BEGV if there are no previous overlays.
1315 NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
1316
1317 *VEC_PTR and *LEN_PTR should contain a valid vector and size
1318 when this function is called.
1319
1320 If EXTEND is non-zero, we make the vector bigger if necessary.
1321 If EXTEND is zero, we never extend the vector,
1322 and we store only as many overlays as will fit.
1323 But we still return the total number of overlays. */
1324
1325 int
1326 overlays_at (pos, extend, vec_ptr, len_ptr, next_ptr, prev_ptr)
1327 int pos;
1328 int extend;
1329 Lisp_Object **vec_ptr;
1330 int *len_ptr;
1331 int *next_ptr;
1332 int *prev_ptr;
1333 {
1334 Lisp_Object tail, overlay, start, end, result;
1335 int idx = 0;
1336 int len = *len_ptr;
1337 Lisp_Object *vec = *vec_ptr;
1338 int next = ZV;
1339 int prev = BEGV;
1340 int inhibit_storing = 0;
1341
1342 for (tail = current_buffer->overlays_before;
1343 XGCTYPE (tail) == Lisp_Cons;
1344 tail = XCONS (tail)->cdr)
1345 {
1346 int startpos, endpos;
1347
1348 overlay = XCONS (tail)->car;
1349 if (XGCTYPE (overlay) != Lisp_Overlay)
1350 abort ();
1351
1352 start = OVERLAY_START (overlay);
1353 end = OVERLAY_END (overlay);
1354 endpos = OVERLAY_POSITION (end);
1355 if (endpos < pos)
1356 {
1357 if (prev < endpos)
1358 prev = endpos;
1359 break;
1360 }
1361 if (endpos == pos)
1362 continue;
1363 startpos = OVERLAY_POSITION (start);
1364 if (startpos <= pos)
1365 {
1366 if (idx == len)
1367 {
1368 /* The supplied vector is full.
1369 Either make it bigger, or don't store any more in it. */
1370 if (extend)
1371 {
1372 *len_ptr = len *= 2;
1373 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
1374 *vec_ptr = vec;
1375 }
1376 else
1377 inhibit_storing = 1;
1378 }
1379
1380 if (!inhibit_storing)
1381 vec[idx] = overlay;
1382 /* Keep counting overlays even if we can't return them all. */
1383 idx++;
1384 }
1385 else if (startpos < next)
1386 next = startpos;
1387 }
1388
1389 for (tail = current_buffer->overlays_after;
1390 XGCTYPE (tail) == Lisp_Cons;
1391 tail = XCONS (tail)->cdr)
1392 {
1393 int startpos, endpos;
1394
1395 overlay = XCONS (tail)->car;
1396 if (XGCTYPE (overlay) != Lisp_Overlay)
1397 abort ();
1398
1399 start = OVERLAY_START (overlay);
1400 end = OVERLAY_END (overlay);
1401 startpos = OVERLAY_POSITION (start);
1402 if (pos < startpos)
1403 {
1404 if (startpos < next)
1405 next = startpos;
1406 break;
1407 }
1408 endpos = OVERLAY_POSITION (end);
1409 if (pos < endpos)
1410 {
1411 if (idx == len)
1412 {
1413 if (extend)
1414 {
1415 *len_ptr = len *= 2;
1416 vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
1417 *vec_ptr = vec;
1418 }
1419 else
1420 inhibit_storing = 1;
1421 }
1422
1423 if (!inhibit_storing)
1424 vec[idx] = overlay;
1425 idx++;
1426 }
1427 else if (endpos < pos && endpos > prev)
1428 prev = endpos;
1429 }
1430
1431 if (next_ptr)
1432 *next_ptr = next;
1433 if (prev_ptr)
1434 *prev_ptr = prev;
1435 return idx;
1436 }
1437 \f
1438 struct sortvec
1439 {
1440 Lisp_Object overlay;
1441 int beg, end;
1442 int priority;
1443 };
1444
1445 static int
1446 compare_overlays (s1, s2)
1447 struct sortvec *s1, *s2;
1448 {
1449 if (s1->priority != s2->priority)
1450 return s1->priority - s2->priority;
1451 if (s1->beg != s2->beg)
1452 return s1->beg - s2->beg;
1453 if (s1->end != s2->end)
1454 return s2->end - s1->end;
1455 return 0;
1456 }
1457
1458 /* Sort an array of overlays by priority. The array is modified in place.
1459 The return value is the new size; this may be smaller than the original
1460 size if some of the overlays were invalid or were window-specific. */
1461 int
1462 sort_overlays (overlay_vec, noverlays, w)
1463 Lisp_Object *overlay_vec;
1464 int noverlays;
1465 struct window *w;
1466 {
1467 int i, j;
1468 struct sortvec *sortvec;
1469 sortvec = (struct sortvec *) alloca (noverlays * sizeof (struct sortvec));
1470
1471 /* Put the valid and relevant overlays into sortvec. */
1472
1473 for (i = 0, j = 0; i < noverlays; i++)
1474 {
1475 Lisp_Object tem;
1476 Lisp_Object overlay;
1477
1478 overlay = overlay_vec[i];
1479 if (OVERLAY_VALID (overlay)
1480 && OVERLAY_POSITION (OVERLAY_START (overlay)) > 0
1481 && OVERLAY_POSITION (OVERLAY_END (overlay)) > 0)
1482 {
1483 /* If we're interested in a specific window, then ignore
1484 overlays that are limited to some other window. */
1485 if (w)
1486 {
1487 Lisp_Object window;
1488
1489 window = Foverlay_get (overlay, Qwindow);
1490 if (WINDOWP (window) && XWINDOW (window) != w)
1491 continue;
1492 }
1493
1494 /* This overlay is good and counts: put it into sortvec. */
1495 sortvec[j].overlay = overlay;
1496 sortvec[j].beg = OVERLAY_POSITION (OVERLAY_START (overlay));
1497 sortvec[j].end = OVERLAY_POSITION (OVERLAY_END (overlay));
1498 tem = Foverlay_get (overlay, Qpriority);
1499 if (INTEGERP (tem))
1500 sortvec[j].priority = XINT (tem);
1501 else
1502 sortvec[j].priority = 0;
1503 j++;
1504 }
1505 }
1506 noverlays = j;
1507
1508 /* Sort the overlays into the proper order: increasing priority. */
1509
1510 if (noverlays > 1)
1511 qsort (sortvec, noverlays, sizeof (struct sortvec), compare_overlays);
1512
1513 for (i = 0; i < noverlays; i++)
1514 overlay_vec[i] = sortvec[i].overlay;
1515 return (noverlays);
1516 }
1517 \f
1518 /* Shift overlays in BUF's overlay lists, to center the lists at POS. */
1519
1520 void
1521 recenter_overlay_lists (buf, pos)
1522 struct buffer *buf;
1523 int pos;
1524 {
1525 Lisp_Object overlay, tail, next, prev, beg, end;
1526
1527 /* See if anything in overlays_before should move to overlays_after. */
1528
1529 /* We don't strictly need prev in this loop; it should always be nil.
1530 But we use it for symmetry and in case that should cease to be true
1531 with some future change. */
1532 prev = Qnil;
1533 for (tail = buf->overlays_before;
1534 CONSP (tail);
1535 prev = tail, tail = next)
1536 {
1537 next = XCONS (tail)->cdr;
1538 overlay = XCONS (tail)->car;
1539
1540 /* If the overlay is not valid, get rid of it. */
1541 if (!OVERLAY_VALID (overlay))
1542 #if 1
1543 abort ();
1544 #else
1545 {
1546 /* Splice the cons cell TAIL out of overlays_before. */
1547 if (!NILP (prev))
1548 XCONS (prev)->cdr = next;
1549 else
1550 buf->overlays_before = next;
1551 tail = prev;
1552 continue;
1553 }
1554 #endif
1555
1556 beg = OVERLAY_START (overlay);
1557 end = OVERLAY_END (overlay);
1558
1559 if (OVERLAY_POSITION (end) > pos)
1560 {
1561 /* OVERLAY needs to be moved. */
1562 int where = OVERLAY_POSITION (beg);
1563 Lisp_Object other, other_prev;
1564
1565 /* Splice the cons cell TAIL out of overlays_before. */
1566 if (!NILP (prev))
1567 XCONS (prev)->cdr = next;
1568 else
1569 buf->overlays_before = next;
1570
1571 /* Search thru overlays_after for where to put it. */
1572 other_prev = Qnil;
1573 for (other = buf->overlays_after;
1574 CONSP (other);
1575 other_prev = other, other = XCONS (other)->cdr)
1576 {
1577 Lisp_Object otherbeg, otheroverlay, follower;
1578 int win;
1579
1580 otheroverlay = XCONS (other)->car;
1581 if (! OVERLAY_VALID (otheroverlay))
1582 abort ();
1583
1584 otherbeg = OVERLAY_START (otheroverlay);
1585 if (OVERLAY_POSITION (otherbeg) >= where)
1586 break;
1587 }
1588
1589 /* Add TAIL to overlays_after before OTHER. */
1590 XCONS (tail)->cdr = other;
1591 if (!NILP (other_prev))
1592 XCONS (other_prev)->cdr = tail;
1593 else
1594 buf->overlays_after = tail;
1595 tail = prev;
1596 }
1597 else
1598 /* We've reached the things that should stay in overlays_before.
1599 All the rest of overlays_before must end even earlier,
1600 so stop now. */
1601 break;
1602 }
1603
1604 /* See if anything in overlays_after should be in overlays_before. */
1605 prev = Qnil;
1606 for (tail = buf->overlays_after;
1607 CONSP (tail);
1608 prev = tail, tail = next)
1609 {
1610 next = XCONS (tail)->cdr;
1611 overlay = XCONS (tail)->car;
1612
1613 /* If the overlay is not valid, get rid of it. */
1614 if (!OVERLAY_VALID (overlay))
1615 #if 1
1616 abort ();
1617 #else
1618 {
1619 /* Splice the cons cell TAIL out of overlays_after. */
1620 if (!NILP (prev))
1621 XCONS (prev)->cdr = next;
1622 else
1623 buf->overlays_after = next;
1624 tail = prev;
1625 continue;
1626 }
1627 #endif
1628
1629 beg = OVERLAY_START (overlay);
1630 end = OVERLAY_END (overlay);
1631
1632 /* Stop looking, when we know that nothing further
1633 can possibly end before POS. */
1634 if (OVERLAY_POSITION (beg) > pos)
1635 break;
1636
1637 if (OVERLAY_POSITION (end) <= pos)
1638 {
1639 /* OVERLAY needs to be moved. */
1640 int where = OVERLAY_POSITION (end);
1641 Lisp_Object other, other_prev;
1642
1643 /* Splice the cons cell TAIL out of overlays_after. */
1644 if (!NILP (prev))
1645 XCONS (prev)->cdr = next;
1646 else
1647 buf->overlays_after = next;
1648
1649 /* Search thru overlays_before for where to put it. */
1650 other_prev = Qnil;
1651 for (other = buf->overlays_before;
1652 CONSP (other);
1653 other_prev = other, other = XCONS (other)->cdr)
1654 {
1655 Lisp_Object otherend, otheroverlay;
1656 int win;
1657
1658 otheroverlay = XCONS (other)->car;
1659 if (! OVERLAY_VALID (otheroverlay))
1660 abort ();
1661
1662 otherend = OVERLAY_END (otheroverlay);
1663 if (OVERLAY_POSITION (otherend) <= where)
1664 break;
1665 }
1666
1667 /* Add TAIL to overlays_before before OTHER. */
1668 XCONS (tail)->cdr = other;
1669 if (!NILP (other_prev))
1670 XCONS (other_prev)->cdr = tail;
1671 else
1672 buf->overlays_before = tail;
1673 tail = prev;
1674 }
1675 }
1676
1677 XSETFASTINT (buf->overlay_center, pos);
1678 }
1679
1680 /* Fix up overlays that were garbled as a result of permuting markers
1681 in the range START through END. Any overlay with at least one
1682 endpoint in this range will need to be unlinked from the overlay
1683 list and reinserted in its proper place.
1684 Such an overlay might even have negative size at this point.
1685 If so, we'll reverse the endpoints. Can you think of anything
1686 better to do in this situation? */
1687 void
1688 fix_overlays_in_range (start, end)
1689 register int start, end;
1690 {
1691 Lisp_Object tem, overlay;
1692 Lisp_Object before_list, after_list;
1693 Lisp_Object *ptail, *pbefore = &before_list, *pafter = &after_list;
1694 int startpos, endpos;
1695
1696 /* This algorithm shifts links around instead of consing and GCing.
1697 The loop invariant is that before_list (resp. after_list) is a
1698 well-formed list except that its last element, the one that
1699 *pbefore (resp. *pafter) points to, is still uninitialized.
1700 So it's not a bug that before_list isn't initialized, although
1701 it may look strange. */
1702 for (ptail = &current_buffer->overlays_before; CONSP (*ptail);)
1703 {
1704 overlay = XCONS (*ptail)->car;
1705 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
1706 if (endpos < start)
1707 break;
1708 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
1709 if (endpos < end
1710 || (startpos >= start && startpos < end))
1711 {
1712 /* If the overlay is backwards, fix that now. */
1713 if (startpos > endpos)
1714 {
1715 int tem;
1716 Fset_marker (OVERLAY_START (overlay), endpos, Qnil);
1717 Fset_marker (OVERLAY_END (overlay), startpos, Qnil);
1718 tem = startpos; startpos = endpos; endpos = tem;
1719 }
1720 /* Add it to the end of the wrong list. Later on,
1721 recenter_overlay_lists will move it to the right place. */
1722 if (endpos < XINT (current_buffer->overlay_center))
1723 {
1724 *pafter = *ptail;
1725 pafter = &XCONS (*ptail)->cdr;
1726 }
1727 else
1728 {
1729 *pbefore = *ptail;
1730 pbefore = &XCONS (*ptail)->cdr;
1731 }
1732 *ptail = XCONS (*ptail)->cdr;
1733 }
1734 else
1735 ptail = &XCONS (*ptail)->cdr;
1736 }
1737 for (ptail = &current_buffer->overlays_after; CONSP (*ptail);)
1738 {
1739 overlay = XCONS (*ptail)->car;
1740 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
1741 if (startpos >= end)
1742 break;
1743 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
1744 if (startpos >= start
1745 || (endpos >= start && endpos < end))
1746 {
1747 if (startpos > endpos)
1748 {
1749 int tem;
1750 Fset_marker (OVERLAY_START (overlay), endpos, Qnil);
1751 Fset_marker (OVERLAY_END (overlay), startpos, Qnil);
1752 tem = startpos; startpos = endpos; endpos = tem;
1753 }
1754 if (endpos < XINT (current_buffer->overlay_center))
1755 {
1756 *pafter = *ptail;
1757 pafter = &XCONS (*ptail)->cdr;
1758 }
1759 else
1760 {
1761 *pbefore = *ptail;
1762 pbefore = &XCONS (*ptail)->cdr;
1763 }
1764 *ptail = XCONS (*ptail)->cdr;
1765 }
1766 else
1767 ptail = &XCONS (*ptail)->cdr;
1768 }
1769
1770 /* Splice the constructed (wrong) lists into the buffer's lists,
1771 and let the recenter function make it sane again. */
1772 *pbefore = current_buffer->overlays_before;
1773 current_buffer->overlays_before = before_list;
1774 recenter_overlay_lists (current_buffer,
1775 XINT (current_buffer->overlay_center));
1776
1777 *pafter = current_buffer->overlays_after;
1778 current_buffer->overlays_after = after_list;
1779 recenter_overlay_lists (current_buffer,
1780 XINT (current_buffer->overlay_center));
1781 }
1782 \f
1783 DEFUN ("overlayp", Foverlayp, Soverlayp, 1, 1, 0,
1784 "Return t if OBJECT is an overlay.")
1785 (object)
1786 Lisp_Object object;
1787 {
1788 return (OVERLAYP (object) ? Qt : Qnil);
1789 }
1790
1791 DEFUN ("make-overlay", Fmake_overlay, Smake_overlay, 2, 3, 0,
1792 "Create a new overlay with range BEG to END in BUFFER.\n\
1793 If omitted, BUFFER defaults to the current buffer.\n\
1794 BEG and END may be integers or markers.")
1795 (beg, end, buffer)
1796 Lisp_Object beg, end, buffer;
1797 {
1798 Lisp_Object overlay;
1799 struct buffer *b;
1800
1801 if (NILP (buffer))
1802 XSETBUFFER (buffer, current_buffer);
1803 else
1804 CHECK_BUFFER (buffer, 2);
1805 if (MARKERP (beg)
1806 && ! EQ (Fmarker_buffer (beg), buffer))
1807 error ("Marker points into wrong buffer");
1808 if (MARKERP (end)
1809 && ! EQ (Fmarker_buffer (end), buffer))
1810 error ("Marker points into wrong buffer");
1811
1812 CHECK_NUMBER_COERCE_MARKER (beg, 1);
1813 CHECK_NUMBER_COERCE_MARKER (end, 1);
1814
1815 if (XINT (beg) > XINT (end))
1816 {
1817 Lisp_Object temp;
1818 temp = beg; beg = end; end = temp;
1819 }
1820
1821 b = XBUFFER (buffer);
1822
1823 beg = Fset_marker (Fmake_marker (), beg, buffer);
1824 end = Fset_marker (Fmake_marker (), end, buffer);
1825
1826 overlay = Fcons (Fcons (beg, end), Qnil);
1827 XSETTYPE (overlay, Lisp_Overlay);
1828
1829 /* Put the new overlay on the wrong list. */
1830 end = OVERLAY_END (overlay);
1831 if (OVERLAY_POSITION (end) < XINT (b->overlay_center))
1832 b->overlays_after = Fcons (overlay, b->overlays_after);
1833 else
1834 b->overlays_before = Fcons (overlay, b->overlays_before);
1835
1836 /* This puts it in the right list, and in the right order. */
1837 recenter_overlay_lists (b, XINT (b->overlay_center));
1838
1839 /* We don't need to redisplay the region covered by the overlay, because
1840 the overlay has no properties at the moment. */
1841
1842 return overlay;
1843 }
1844
1845 DEFUN ("move-overlay", Fmove_overlay, Smove_overlay, 3, 4, 0,
1846 "Set the endpoints of OVERLAY to BEG and END in BUFFER.\n\
1847 If BUFFER is omitted, leave OVERLAY in the same buffer it inhabits now.\n\
1848 If BUFFER is omitted, and OVERLAY is in no buffer, put it in the current\n\
1849 buffer.")
1850 (overlay, beg, end, buffer)
1851 Lisp_Object overlay, beg, end, buffer;
1852 {
1853 struct buffer *b, *ob;
1854 Lisp_Object obuffer;
1855 int count = specpdl_ptr - specpdl;
1856
1857 CHECK_OVERLAY (overlay, 0);
1858 if (NILP (buffer))
1859 buffer = Fmarker_buffer (OVERLAY_START (overlay));
1860 if (NILP (buffer))
1861 XSETBUFFER (buffer, current_buffer);
1862 CHECK_BUFFER (buffer, 3);
1863
1864 if (MARKERP (beg)
1865 && ! EQ (Fmarker_buffer (beg), buffer))
1866 error ("Marker points into wrong buffer");
1867 if (MARKERP (end)
1868 && ! EQ (Fmarker_buffer (end), buffer))
1869 error ("Marker points into wrong buffer");
1870
1871 CHECK_NUMBER_COERCE_MARKER (beg, 1);
1872 CHECK_NUMBER_COERCE_MARKER (end, 1);
1873
1874 if (XINT (beg) == XINT (end) && ! NILP (Foverlay_get (overlay, Qevaporate)))
1875 return Fdelete_overlay (overlay);
1876
1877 if (XINT (beg) > XINT (end))
1878 {
1879 Lisp_Object temp;
1880 temp = beg; beg = end; end = temp;
1881 }
1882
1883 specbind (Qinhibit_quit, Qt);
1884
1885 obuffer = Fmarker_buffer (OVERLAY_START (overlay));
1886 b = XBUFFER (buffer);
1887 ob = XBUFFER (obuffer);
1888
1889 /* If the overlay has changed buffers, do a thorough redisplay. */
1890 if (!EQ (buffer, obuffer))
1891 {
1892 /* Redisplay where the overlay was. */
1893 if (!NILP (obuffer))
1894 {
1895 Lisp_Object o_beg;
1896 Lisp_Object o_end;
1897
1898 o_beg = OVERLAY_START (overlay);
1899 o_end = OVERLAY_END (overlay);
1900 o_beg = OVERLAY_POSITION (o_beg);
1901 o_end = OVERLAY_POSITION (o_end);
1902
1903 redisplay_region (ob, XINT (o_beg), XINT (o_end));
1904 }
1905
1906 /* Redisplay where the overlay is going to be. */
1907 redisplay_region (b, XINT (beg), XINT (end));
1908
1909 /* Don't limit redisplay to the selected window. */
1910 windows_or_buffers_changed = 1;
1911 }
1912 else
1913 /* Redisplay the area the overlay has just left, or just enclosed. */
1914 {
1915 Lisp_Object o_beg;
1916 Lisp_Object o_end;
1917 int change_beg, change_end;
1918
1919 o_beg = OVERLAY_START (overlay);
1920 o_end = OVERLAY_END (overlay);
1921 o_beg = OVERLAY_POSITION (o_beg);
1922 o_end = OVERLAY_POSITION (o_end);
1923
1924 if (XINT (o_beg) == XINT (beg))
1925 redisplay_region (b, XINT (o_end), XINT (end));
1926 else if (XINT (o_end) == XINT (end))
1927 redisplay_region (b, XINT (o_beg), XINT (beg));
1928 else
1929 {
1930 if (XINT (beg) < XINT (o_beg)) o_beg = beg;
1931 if (XINT (end) > XINT (o_end)) o_end = end;
1932 redisplay_region (b, XINT (o_beg), XINT (o_end));
1933 }
1934 }
1935
1936 if (!NILP (obuffer))
1937 {
1938 ob->overlays_before = Fdelq (overlay, ob->overlays_before);
1939 ob->overlays_after = Fdelq (overlay, ob->overlays_after);
1940 }
1941
1942 Fset_marker (OVERLAY_START (overlay), beg, buffer);
1943 Fset_marker (OVERLAY_END (overlay), end, buffer);
1944
1945 /* Put the overlay on the wrong list. */
1946 end = OVERLAY_END (overlay);
1947 if (OVERLAY_POSITION (end) < XINT (b->overlay_center))
1948 b->overlays_after = Fcons (overlay, b->overlays_after);
1949 else
1950 b->overlays_before = Fcons (overlay, b->overlays_before);
1951
1952 /* This puts it in the right list, and in the right order. */
1953 recenter_overlay_lists (b, XINT (b->overlay_center));
1954
1955 return unbind_to (count, overlay);
1956 }
1957
1958 DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0,
1959 "Delete the overlay OVERLAY from its buffer.")
1960 (overlay)
1961 Lisp_Object overlay;
1962 {
1963 Lisp_Object buffer;
1964 struct buffer *b;
1965 int count = specpdl_ptr - specpdl;
1966
1967 CHECK_OVERLAY (overlay, 0);
1968
1969 buffer = Fmarker_buffer (OVERLAY_START (overlay));
1970 if (NILP (buffer))
1971 return Qnil;
1972
1973 b = XBUFFER (buffer);
1974
1975 specbind (Qinhibit_quit, Qt);
1976
1977 b->overlays_before = Fdelq (overlay, b->overlays_before);
1978 b->overlays_after = Fdelq (overlay, b->overlays_after);
1979
1980 redisplay_region (b,
1981 marker_position (OVERLAY_START (overlay)),
1982 marker_position (OVERLAY_END (overlay)));
1983
1984 Fset_marker (OVERLAY_START (overlay), Qnil, Qnil);
1985 Fset_marker (OVERLAY_END (overlay), Qnil, Qnil);
1986
1987 return unbind_to (count, Qnil);
1988 }
1989 \f
1990 /* Overlay dissection functions. */
1991
1992 DEFUN ("overlay-start", Foverlay_start, Soverlay_start, 1, 1, 0,
1993 "Return the position at which OVERLAY starts.")
1994 (overlay)
1995 Lisp_Object overlay;
1996 {
1997 CHECK_OVERLAY (overlay, 0);
1998
1999 return (Fmarker_position (OVERLAY_START (overlay)));
2000 }
2001
2002 DEFUN ("overlay-end", Foverlay_end, Soverlay_end, 1, 1, 0,
2003 "Return the position at which OVERLAY ends.")
2004 (overlay)
2005 Lisp_Object overlay;
2006 {
2007 CHECK_OVERLAY (overlay, 0);
2008
2009 return (Fmarker_position (OVERLAY_END (overlay)));
2010 }
2011
2012 DEFUN ("overlay-buffer", Foverlay_buffer, Soverlay_buffer, 1, 1, 0,
2013 "Return the buffer OVERLAY belongs to.")
2014 (overlay)
2015 Lisp_Object overlay;
2016 {
2017 CHECK_OVERLAY (overlay, 0);
2018
2019 return Fmarker_buffer (OVERLAY_START (overlay));
2020 }
2021
2022 DEFUN ("overlay-properties", Foverlay_properties, Soverlay_properties, 1, 1, 0,
2023 "Return a list of the properties on OVERLAY.\n\
2024 This is a copy of OVERLAY's plist; modifying its conses has no effect on\n\
2025 OVERLAY.")
2026 (overlay)
2027 Lisp_Object overlay;
2028 {
2029 CHECK_OVERLAY (overlay, 0);
2030
2031 return Fcopy_sequence (Fcdr_safe (XCONS (overlay)->cdr));
2032 }
2033
2034 \f
2035 DEFUN ("overlays-at", Foverlays_at, Soverlays_at, 1, 1, 0,
2036 "Return a list of the overlays that contain position POS.")
2037 (pos)
2038 Lisp_Object pos;
2039 {
2040 int noverlays;
2041 Lisp_Object *overlay_vec;
2042 int len;
2043 Lisp_Object result;
2044
2045 CHECK_NUMBER_COERCE_MARKER (pos, 0);
2046
2047 len = 10;
2048 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
2049
2050 /* Put all the overlays we want in a vector in overlay_vec.
2051 Store the length in len. */
2052 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len, NULL, NULL);
2053
2054 /* Make a list of them all. */
2055 result = Flist (noverlays, overlay_vec);
2056
2057 xfree (overlay_vec);
2058 return result;
2059 }
2060
2061 DEFUN ("next-overlay-change", Fnext_overlay_change, Snext_overlay_change,
2062 1, 1, 0,
2063 "Return the next position after POS where an overlay starts or ends.\n\
2064 If there are no more overlay boundaries after POS, return (point-max).")
2065 (pos)
2066 Lisp_Object pos;
2067 {
2068 int noverlays;
2069 int endpos;
2070 Lisp_Object *overlay_vec;
2071 int len;
2072 int i;
2073
2074 CHECK_NUMBER_COERCE_MARKER (pos, 0);
2075
2076 len = 10;
2077 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
2078
2079 /* Put all the overlays we want in a vector in overlay_vec.
2080 Store the length in len.
2081 endpos gets the position where the next overlay starts. */
2082 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len, &endpos, NULL);
2083
2084 /* If any of these overlays ends before endpos,
2085 use its ending point instead. */
2086 for (i = 0; i < noverlays; i++)
2087 {
2088 Lisp_Object oend;
2089 int oendpos;
2090
2091 oend = OVERLAY_END (overlay_vec[i]);
2092 oendpos = OVERLAY_POSITION (oend);
2093 if (oendpos < endpos)
2094 endpos = oendpos;
2095 }
2096
2097 xfree (overlay_vec);
2098 return make_number (endpos);
2099 }
2100
2101 DEFUN ("previous-overlay-change", Fprevious_overlay_change,
2102 Sprevious_overlay_change, 1, 1, 0,
2103 "Return the previous position before POS where an overlay starts or ends.\n\
2104 If there are no more overlay boundaries after POS, return (point-min).")
2105 (pos)
2106 Lisp_Object pos;
2107 {
2108 int noverlays;
2109 int prevpos;
2110 Lisp_Object *overlay_vec;
2111 int len;
2112 int i;
2113
2114 CHECK_NUMBER_COERCE_MARKER (pos, 0);
2115
2116 len = 10;
2117 overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
2118
2119 /* Put all the overlays we want in a vector in overlay_vec.
2120 Store the length in len.
2121 prevpos gets the position of an overlay end. */
2122 noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len, NULL, &prevpos);
2123
2124 /* If any of these overlays starts before endpos,
2125 maybe use its starting point instead. */
2126 for (i = 0; i < noverlays; i++)
2127 {
2128 Lisp_Object ostart;
2129 int ostartpos;
2130
2131 ostart = OVERLAY_START (overlay_vec[i]);
2132 ostartpos = OVERLAY_POSITION (ostart);
2133 if (ostartpos > prevpos && ostartpos < XINT (pos))
2134 prevpos = ostartpos;
2135 }
2136
2137 xfree (overlay_vec);
2138 return make_number (prevpos);
2139 }
2140 \f
2141 /* These functions are for debugging overlays. */
2142
2143 DEFUN ("overlay-lists", Foverlay_lists, Soverlay_lists, 0, 0, 0,
2144 "Return a pair of lists giving all the overlays of the current buffer.\n\
2145 The car has all the overlays before the overlay center;\n\
2146 the cdr has all the overlays after the overlay center.\n\
2147 Recentering overlays moves overlays between these lists.\n\
2148 The lists you get are copies, so that changing them has no effect.\n\
2149 However, the overlays you get are the real objects that the buffer uses.")
2150 ()
2151 {
2152 Lisp_Object before, after;
2153 before = current_buffer->overlays_before;
2154 if (CONSP (before))
2155 before = Fcopy_sequence (before);
2156 after = current_buffer->overlays_after;
2157 if (CONSP (after))
2158 after = Fcopy_sequence (after);
2159
2160 return Fcons (before, after);
2161 }
2162
2163 DEFUN ("overlay-recenter", Foverlay_recenter, Soverlay_recenter, 1, 1, 0,
2164 "Recenter the overlays of the current buffer around position POS.")
2165 (pos)
2166 Lisp_Object pos;
2167 {
2168 CHECK_NUMBER_COERCE_MARKER (pos, 0);
2169
2170 recenter_overlay_lists (current_buffer, XINT (pos));
2171 return Qnil;
2172 }
2173 \f
2174 DEFUN ("overlay-get", Foverlay_get, Soverlay_get, 2, 2, 0,
2175 "Get the property of overlay OVERLAY with property name NAME.")
2176 (overlay, prop)
2177 Lisp_Object overlay, prop;
2178 {
2179 Lisp_Object plist, fallback;
2180
2181 CHECK_OVERLAY (overlay, 0);
2182
2183 fallback = Qnil;
2184
2185 for (plist = Fcdr_safe (XCONS (overlay)->cdr);
2186 CONSP (plist) && CONSP (XCONS (plist)->cdr);
2187 plist = XCONS (XCONS (plist)->cdr)->cdr)
2188 {
2189 if (EQ (XCONS (plist)->car, prop))
2190 return XCONS (XCONS (plist)->cdr)->car;
2191 else if (EQ (XCONS (plist)->car, Qcategory))
2192 {
2193 Lisp_Object tem;
2194 tem = Fcar (Fcdr (plist));
2195 if (SYMBOLP (tem))
2196 fallback = Fget (tem, prop);
2197 }
2198 }
2199
2200 return fallback;
2201 }
2202
2203 DEFUN ("overlay-put", Foverlay_put, Soverlay_put, 3, 3, 0,
2204 "Set one property of overlay OVERLAY: give property PROP value VALUE.")
2205 (overlay, prop, value)
2206 Lisp_Object overlay, prop, value;
2207 {
2208 Lisp_Object plist, tail, buffer;
2209 int changed;
2210
2211 CHECK_OVERLAY (overlay, 0);
2212
2213 buffer = Fmarker_buffer (OVERLAY_START (overlay));
2214
2215 plist = Fcdr_safe (XCONS (overlay)->cdr);
2216
2217 for (tail = plist;
2218 CONSP (tail) && CONSP (XCONS (tail)->cdr);
2219 tail = XCONS (XCONS (tail)->cdr)->cdr)
2220 if (EQ (XCONS (tail)->car, prop))
2221 {
2222 changed = !EQ (XCONS (XCONS (tail)->cdr)->car, value);
2223 XCONS (XCONS (tail)->cdr)->car = value;
2224 goto found;
2225 }
2226 /* It wasn't in the list, so add it to the front. */
2227 changed = !NILP (value);
2228 if (! CONSP (XCONS (overlay)->cdr))
2229 XCONS (overlay)->cdr = Fcons (Qnil, Qnil);
2230 XCONS (XCONS (overlay)->cdr)->cdr = Fcons (prop, Fcons (value, plist));
2231 found:
2232 if (! NILP (buffer))
2233 {
2234 if (changed)
2235 redisplay_region (XBUFFER (buffer),
2236 marker_position (OVERLAY_START (overlay)),
2237 marker_position (OVERLAY_END (overlay)));
2238 if (EQ (prop, Qevaporate) && ! NILP (value)
2239 && (OVERLAY_POSITION (OVERLAY_START (overlay))
2240 == OVERLAY_POSITION (OVERLAY_END (overlay))))
2241 Fdelete_overlay (overlay);
2242 }
2243 return value;
2244 }
2245 \f
2246 /* Run the modification-hooks of overlays that include
2247 any part of the text in START to END.
2248 Run the insert-before-hooks of overlay starting at END,
2249 and the insert-after-hooks of overlay ending at START. */
2250
2251 void
2252 verify_overlay_modification (start, end)
2253 Lisp_Object start, end;
2254 {
2255 Lisp_Object prop, overlay, tail;
2256 int insertion = EQ (start, end);
2257 int tail_copied;
2258 struct gcpro gcpro1, gcpro2;
2259
2260 overlay = Qnil;
2261 tail = Qnil;
2262 GCPRO2 (overlay, tail);
2263
2264 tail_copied = 0;
2265 for (tail = current_buffer->overlays_before;
2266 CONSP (tail);
2267 tail = XCONS (tail)->cdr)
2268 {
2269 int startpos, endpos;
2270 Lisp_Object ostart, oend;
2271
2272 overlay = XCONS (tail)->car;
2273
2274 ostart = OVERLAY_START (overlay);
2275 oend = OVERLAY_END (overlay);
2276 endpos = OVERLAY_POSITION (oend);
2277 if (XFASTINT (start) > endpos)
2278 break;
2279 startpos = OVERLAY_POSITION (ostart);
2280 if (XFASTINT (end) == startpos && insertion)
2281 {
2282 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
2283 if (!NILP (prop))
2284 {
2285 /* Copy TAIL in case the hook recenters the overlay lists. */
2286 if (!tail_copied)
2287 tail = Fcopy_sequence (tail);
2288 tail_copied = 1;
2289 call_overlay_mod_hooks (prop, overlay, start, end);
2290 }
2291 }
2292 if (XFASTINT (start) == endpos && insertion)
2293 {
2294 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
2295 if (!NILP (prop))
2296 {
2297 if (!tail_copied)
2298 tail = Fcopy_sequence (tail);
2299 tail_copied = 1;
2300 call_overlay_mod_hooks (prop, overlay, start, end);
2301 }
2302 }
2303 /* Test for intersecting intervals. This does the right thing
2304 for both insertion and deletion. */
2305 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
2306 {
2307 prop = Foverlay_get (overlay, Qmodification_hooks);
2308 if (!NILP (prop))
2309 {
2310 if (!tail_copied)
2311 tail = Fcopy_sequence (tail);
2312 tail_copied = 1;
2313 call_overlay_mod_hooks (prop, overlay, start, end);
2314 }
2315 }
2316 }
2317
2318 tail_copied = 0;
2319 for (tail = current_buffer->overlays_after;
2320 CONSP (tail);
2321 tail = XCONS (tail)->cdr)
2322 {
2323 int startpos, endpos;
2324 Lisp_Object ostart, oend;
2325
2326 overlay = XCONS (tail)->car;
2327
2328 ostart = OVERLAY_START (overlay);
2329 oend = OVERLAY_END (overlay);
2330 startpos = OVERLAY_POSITION (ostart);
2331 endpos = OVERLAY_POSITION (oend);
2332 if (XFASTINT (end) < startpos)
2333 break;
2334 if (XFASTINT (end) == startpos && insertion)
2335 {
2336 prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
2337 if (!NILP (prop))
2338 {
2339 if (!tail_copied)
2340 tail = Fcopy_sequence (tail);
2341 tail_copied = 1;
2342 call_overlay_mod_hooks (prop, overlay, start, end);
2343 }
2344 }
2345 if (XFASTINT (start) == endpos && insertion)
2346 {
2347 prop = Foverlay_get (overlay, Qinsert_behind_hooks);
2348 if (!NILP (prop))
2349 {
2350 if (!tail_copied)
2351 tail = Fcopy_sequence (tail);
2352 tail_copied = 1;
2353 call_overlay_mod_hooks (prop, overlay, start, end);
2354 }
2355 }
2356 /* Test for intersecting intervals. This does the right thing
2357 for both insertion and deletion. */
2358 if (XFASTINT (end) > startpos && XFASTINT (start) < endpos)
2359 {
2360 prop = Foverlay_get (overlay, Qmodification_hooks);
2361 if (!NILP (prop))
2362 {
2363 if (!tail_copied)
2364 tail = Fcopy_sequence (tail);
2365 tail_copied = 1;
2366 call_overlay_mod_hooks (prop, overlay, start, end);
2367 }
2368 }
2369 }
2370
2371 UNGCPRO;
2372 }
2373
2374 static void
2375 call_overlay_mod_hooks (list, overlay, start, end)
2376 Lisp_Object list, overlay, start, end;
2377 {
2378 struct gcpro gcpro1;
2379 GCPRO1 (list);
2380 while (!NILP (list))
2381 {
2382 call3 (Fcar (list), overlay, start, end);
2383 list = Fcdr (list);
2384 }
2385 UNGCPRO;
2386 }
2387
2388 /* Delete any zero-sized overlays at position POS, if the `evaporate'
2389 property is set. */
2390 void
2391 evaporate_overlays (pos)
2392 int pos;
2393 {
2394 Lisp_Object tail, overlay, hit_list;
2395
2396 hit_list = Qnil;
2397 if (pos <= XFASTINT (current_buffer->overlay_center))
2398 for (tail = current_buffer->overlays_before; CONSP (tail);
2399 tail = XCONS (tail)->cdr)
2400 {
2401 int endpos;
2402 overlay = XCONS (tail)->car;
2403 endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
2404 if (endpos < pos)
2405 break;
2406 if (endpos == pos && OVERLAY_POSITION (OVERLAY_START (overlay)) == pos
2407 && Foverlay_get (overlay, Qevaporate))
2408 hit_list = Fcons (overlay, hit_list);
2409 }
2410 else
2411 for (tail = current_buffer->overlays_after; CONSP (tail);
2412 tail = XCONS (tail)->cdr)
2413 {
2414 int startpos;
2415 overlay = XCONS (tail)->car;
2416 startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
2417 if (startpos > pos)
2418 break;
2419 if (startpos == pos && OVERLAY_POSITION (OVERLAY_END (overlay)) == pos
2420 && Foverlay_get (overlay, Qevaporate))
2421 hit_list = Fcons (overlay, hit_list);
2422 }
2423 for (; CONSP (hit_list); hit_list = XCONS (hit_list)->cdr)
2424 Fdelete_overlay (XCONS (hit_list)->car);
2425 }
2426 \f
2427 /* Somebody has tried to store NEWVAL into the buffer-local slot with
2428 offset XUINT (valcontents), and NEWVAL has an unacceptable type. */
2429 void
2430 buffer_slot_type_mismatch (valcontents, newval)
2431 Lisp_Object valcontents, newval;
2432 {
2433 unsigned int offset = XUINT (valcontents);
2434 unsigned char *symbol_name =
2435 (XSYMBOL (*(Lisp_Object *)(offset + (char *)&buffer_local_symbols))
2436 ->name->data);
2437 char *type_name;
2438
2439 switch (XINT (*(Lisp_Object *)(offset + (char *)&buffer_local_types)))
2440 {
2441 case Lisp_Int: type_name = "integers"; break;
2442 case Lisp_String: type_name = "strings"; break;
2443 case Lisp_Marker: type_name = "markers"; break;
2444 case Lisp_Symbol: type_name = "symbols"; break;
2445 case Lisp_Cons: type_name = "lists"; break;
2446 case Lisp_Vector: type_name = "vectors"; break;
2447 default:
2448 abort ();
2449 }
2450
2451 error ("only %s should be stored in the buffer-local variable %s",
2452 type_name, symbol_name);
2453 }
2454 \f
2455 init_buffer_once ()
2456 {
2457 register Lisp_Object tem;
2458
2459 /* Make sure all markable slots in buffer_defaults
2460 are initialized reasonably, so mark_buffer won't choke. */
2461 reset_buffer (&buffer_defaults);
2462 reset_buffer_local_variables (&buffer_defaults);
2463 reset_buffer (&buffer_local_symbols);
2464 reset_buffer_local_variables (&buffer_local_symbols);
2465 XSETBUFFER (Vbuffer_defaults, &buffer_defaults);
2466 XSETBUFFER (Vbuffer_local_symbols, &buffer_local_symbols);
2467
2468 /* Set up the default values of various buffer slots. */
2469 /* Must do these before making the first buffer! */
2470
2471 /* real setup is done in loaddefs.el */
2472 buffer_defaults.mode_line_format = build_string ("%-");
2473 buffer_defaults.abbrev_mode = Qnil;
2474 buffer_defaults.overwrite_mode = Qnil;
2475 buffer_defaults.case_fold_search = Qt;
2476 buffer_defaults.auto_fill_function = Qnil;
2477 buffer_defaults.selective_display = Qnil;
2478 #ifndef old
2479 buffer_defaults.selective_display_ellipses = Qt;
2480 #endif
2481 buffer_defaults.abbrev_table = Qnil;
2482 buffer_defaults.display_table = Qnil;
2483 buffer_defaults.undo_list = Qnil;
2484 buffer_defaults.mark_active = Qnil;
2485 buffer_defaults.overlays_before = Qnil;
2486 buffer_defaults.overlays_after = Qnil;
2487 XSETFASTINT (buffer_defaults.overlay_center, 1);
2488
2489 XSETFASTINT (buffer_defaults.tab_width, 8);
2490 buffer_defaults.truncate_lines = Qnil;
2491 buffer_defaults.ctl_arrow = Qt;
2492
2493 #ifdef MSDOS
2494 buffer_defaults.buffer_file_type = Qnil; /* TEXT */
2495 #endif
2496 XSETFASTINT (buffer_defaults.fill_column, 70);
2497 XSETFASTINT (buffer_defaults.left_margin, 0);
2498 buffer_defaults.cache_long_line_scans = Qnil;
2499
2500 /* Assign the local-flags to the slots that have default values.
2501 The local flag is a bit that is used in the buffer
2502 to say that it has its own local value for the slot.
2503 The local flag bits are in the local_var_flags slot of the buffer. */
2504
2505 /* Nothing can work if this isn't true */
2506 if (sizeof (EMACS_INT) != sizeof (Lisp_Object)) abort ();
2507
2508 /* 0 means not a lisp var, -1 means always local, else mask */
2509 bzero (&buffer_local_flags, sizeof buffer_local_flags);
2510 XSETINT (buffer_local_flags.filename, -1);
2511 XSETINT (buffer_local_flags.directory, -1);
2512 XSETINT (buffer_local_flags.backed_up, -1);
2513 XSETINT (buffer_local_flags.save_length, -1);
2514 XSETINT (buffer_local_flags.auto_save_file_name, -1);
2515 XSETINT (buffer_local_flags.read_only, -1);
2516 XSETINT (buffer_local_flags.major_mode, -1);
2517 XSETINT (buffer_local_flags.mode_name, -1);
2518 XSETINT (buffer_local_flags.undo_list, -1);
2519 XSETINT (buffer_local_flags.mark_active, -1);
2520
2521 XSETFASTINT (buffer_local_flags.mode_line_format, 1);
2522 XSETFASTINT (buffer_local_flags.abbrev_mode, 2);
2523 XSETFASTINT (buffer_local_flags.overwrite_mode, 4);
2524 XSETFASTINT (buffer_local_flags.case_fold_search, 8);
2525 XSETFASTINT (buffer_local_flags.auto_fill_function, 0x10);
2526 XSETFASTINT (buffer_local_flags.selective_display, 0x20);
2527 #ifndef old
2528 XSETFASTINT (buffer_local_flags.selective_display_ellipses, 0x40);
2529 #endif
2530 XSETFASTINT (buffer_local_flags.tab_width, 0x80);
2531 XSETFASTINT (buffer_local_flags.truncate_lines, 0x100);
2532 XSETFASTINT (buffer_local_flags.ctl_arrow, 0x200);
2533 XSETFASTINT (buffer_local_flags.fill_column, 0x400);
2534 XSETFASTINT (buffer_local_flags.left_margin, 0x800);
2535 XSETFASTINT (buffer_local_flags.abbrev_table, 0x1000);
2536 XSETFASTINT (buffer_local_flags.display_table, 0x2000);
2537 XSETFASTINT (buffer_local_flags.syntax_table, 0x8000);
2538 XSETFASTINT (buffer_local_flags.cache_long_line_scans, 0x10000);
2539 #ifdef MSDOS
2540 XSETFASTINT (buffer_local_flags.buffer_file_type, 0x4000);
2541 #endif
2542
2543 Vbuffer_alist = Qnil;
2544 current_buffer = 0;
2545 all_buffers = 0;
2546
2547 QSFundamental = build_string ("Fundamental");
2548
2549 Qfundamental_mode = intern ("fundamental-mode");
2550 buffer_defaults.major_mode = Qfundamental_mode;
2551
2552 Qmode_class = intern ("mode-class");
2553
2554 Qprotected_field = intern ("protected-field");
2555
2556 Qpermanent_local = intern ("permanent-local");
2557
2558 Qkill_buffer_hook = intern ("kill-buffer-hook");
2559
2560 Vprin1_to_string_buffer = Fget_buffer_create (build_string (" prin1"));
2561 /* super-magic invisible buffer */
2562 Vbuffer_alist = Qnil;
2563
2564 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
2565 }
2566
2567 init_buffer ()
2568 {
2569 char buf[MAXPATHLEN+1];
2570 char *pwd;
2571 struct stat dotstat, pwdstat;
2572 Lisp_Object temp;
2573
2574 Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
2575
2576 /* If PWD is accurate, use it instead of calling getwd. This is faster
2577 when PWD is right, and may avoid a fatal error. */
2578 if ((pwd = getenv ("PWD")) != 0 && *pwd == '/'
2579 && stat (pwd, &pwdstat) == 0
2580 && stat (".", &dotstat) == 0
2581 && dotstat.st_ino == pwdstat.st_ino
2582 && dotstat.st_dev == pwdstat.st_dev
2583 && strlen (pwd) < MAXPATHLEN)
2584 strcpy (buf, pwd);
2585 else if (getwd (buf) == 0)
2586 fatal ("`getwd' failed: %s.\n", buf);
2587
2588 #ifndef VMS
2589 /* Maybe this should really use some standard subroutine
2590 whose definition is filename syntax dependent. */
2591 if (buf[strlen (buf) - 1] != '/')
2592 strcat (buf, "/");
2593 #endif /* not VMS */
2594 current_buffer->directory = build_string (buf);
2595
2596 temp = get_minibuffer (0);
2597 XBUFFER (temp)->directory = current_buffer->directory;
2598 }
2599
2600 /* initialize the buffer routines */
2601 syms_of_buffer ()
2602 {
2603 extern Lisp_Object Qdisabled;
2604
2605 staticpro (&Vbuffer_defaults);
2606 staticpro (&Vbuffer_local_symbols);
2607 staticpro (&Qfundamental_mode);
2608 staticpro (&Qmode_class);
2609 staticpro (&QSFundamental);
2610 staticpro (&Vbuffer_alist);
2611 staticpro (&Qprotected_field);
2612 staticpro (&Qpermanent_local);
2613 staticpro (&Qkill_buffer_hook);
2614 staticpro (&Qoverlayp);
2615 Qevaporate = intern ("evaporate");
2616 staticpro (&Qevaporate);
2617 staticpro (&Qmodification_hooks);
2618 Qmodification_hooks = intern ("modification-hooks");
2619 staticpro (&Qinsert_in_front_hooks);
2620 Qinsert_in_front_hooks = intern ("insert-in-front-hooks");
2621 staticpro (&Qinsert_behind_hooks);
2622 Qinsert_behind_hooks = intern ("insert-behind-hooks");
2623 staticpro (&Qget_file_buffer);
2624 Qget_file_buffer = intern ("get-file-buffer");
2625 Qpriority = intern ("priority");
2626 staticpro (&Qpriority);
2627 Qwindow = intern ("window");
2628 staticpro (&Qwindow);
2629
2630 Qoverlayp = intern ("overlayp");
2631
2632 Fput (Qprotected_field, Qerror_conditions,
2633 Fcons (Qprotected_field, Fcons (Qerror, Qnil)));
2634 Fput (Qprotected_field, Qerror_message,
2635 build_string ("Attempt to modify a protected field"));
2636
2637 /* All these use DEFVAR_LISP_NOPRO because the slots in
2638 buffer_defaults will all be marked via Vbuffer_defaults. */
2639
2640 DEFVAR_LISP_NOPRO ("default-mode-line-format",
2641 &buffer_defaults.mode_line_format,
2642 "Default value of `mode-line-format' for buffers that don't override it.\n\
2643 This is the same as (default-value 'mode-line-format).");
2644
2645 DEFVAR_LISP_NOPRO ("default-abbrev-mode",
2646 &buffer_defaults.abbrev_mode,
2647 "Default value of `abbrev-mode' for buffers that do not override it.\n\
2648 This is the same as (default-value 'abbrev-mode).");
2649
2650 DEFVAR_LISP_NOPRO ("default-ctl-arrow",
2651 &buffer_defaults.ctl_arrow,
2652 "Default value of `ctl-arrow' for buffers that do not override it.\n\
2653 This is the same as (default-value 'ctl-arrow).");
2654
2655 DEFVAR_LISP_NOPRO ("default-truncate-lines",
2656 &buffer_defaults.truncate_lines,
2657 "Default value of `truncate-lines' for buffers that do not override it.\n\
2658 This is the same as (default-value 'truncate-lines).");
2659
2660 DEFVAR_LISP_NOPRO ("default-fill-column",
2661 &buffer_defaults.fill_column,
2662 "Default value of `fill-column' for buffers that do not override it.\n\
2663 This is the same as (default-value 'fill-column).");
2664
2665 DEFVAR_LISP_NOPRO ("default-left-margin",
2666 &buffer_defaults.left_margin,
2667 "Default value of `left-margin' for buffers that do not override it.\n\
2668 This is the same as (default-value 'left-margin).");
2669
2670 DEFVAR_LISP_NOPRO ("default-tab-width",
2671 &buffer_defaults.tab_width,
2672 "Default value of `tab-width' for buffers that do not override it.\n\
2673 This is the same as (default-value 'tab-width).");
2674
2675 DEFVAR_LISP_NOPRO ("default-case-fold-search",
2676 &buffer_defaults.case_fold_search,
2677 "Default value of `case-fold-search' for buffers that don't override it.\n\
2678 This is the same as (default-value 'case-fold-search).");
2679
2680 #ifdef MSDOS
2681 DEFVAR_LISP_NOPRO ("default-buffer-file-type",
2682 &buffer_defaults.buffer_file_type,
2683 "Default file type for buffers that do not override it.\n\
2684 This is the same as (default-value 'buffer-file-type).\n\
2685 The file type is nil for text, t for binary.");
2686 #endif
2687
2688 DEFVAR_PER_BUFFER ("mode-line-format", &current_buffer->mode_line_format,
2689 Qnil, 0);
2690
2691 /* This doc string is too long for cpp; cpp dies if it isn't in a comment.
2692 But make-docfile finds it!
2693 DEFVAR_PER_BUFFER ("mode-line-format", &current_buffer->mode_line_format,
2694 Qnil,
2695 "Template for displaying mode line for current buffer.\n\
2696 Each buffer has its own value of this variable.\n\
2697 Value may be a string, a symbol or a list or cons cell.\n\
2698 For a symbol, its value is used (but it is ignored if t or nil).\n\
2699 A string appearing directly as the value of a symbol is processed verbatim\n\
2700 in that the %-constructs below are not recognized.\n\
2701 For a list whose car is a symbol, the symbol's value is taken,\n\
2702 and if that is non-nil, the cadr of the list is processed recursively.\n\
2703 Otherwise, the caddr of the list (if there is one) is processed.\n\
2704 For a list whose car is a string or list, each element is processed\n\
2705 recursively and the results are effectively concatenated.\n\
2706 For a list whose car is an integer, the cdr of the list is processed\n\
2707 and padded (if the number is positive) or truncated (if negative)\n\
2708 to the width specified by that number.\n\
2709 A string is printed verbatim in the mode line except for %-constructs:\n\
2710 (%-constructs are allowed when the string is the entire mode-line-format\n\
2711 or when it is found in a cons-cell or a list)\n\
2712 %b -- print buffer name. %f -- print visited file name.\n\
2713 %* -- print %, * or hyphen. %+ -- print *, % or hyphen.\n\
2714 % means buffer is read-only and * means it is modified.\n\
2715 For a modified read-only buffer, %* gives % and %+ gives *.\n\
2716 %s -- print process status. %l -- print the current line number.\n\
2717 %p -- print percent of buffer above top of window, or Top, Bot or All.\n\
2718 %P -- print percent of buffer above bottom of window, perhaps plus Top,\n\
2719 or print Bottom or All.\n\
2720 %n -- print Narrow if appropriate.\n\
2721 %t -- print T if files is text, B if binary.\n\
2722 %[ -- print one [ for each recursive editing level. %] similar.\n\
2723 %% -- print %. %- -- print infinitely many dashes.\n\
2724 Decimal digits after the % specify field width to which to pad.");
2725 */
2726
2727 DEFVAR_LISP_NOPRO ("default-major-mode", &buffer_defaults.major_mode,
2728 "*Major mode for new buffers. Defaults to `fundamental-mode'.\n\
2729 nil here means use current buffer's major mode.");
2730
2731 DEFVAR_PER_BUFFER ("major-mode", &current_buffer->major_mode,
2732 make_number (Lisp_Symbol),
2733 "Symbol for current buffer's major mode.");
2734
2735 DEFVAR_PER_BUFFER ("mode-name", &current_buffer->mode_name,
2736 make_number (Lisp_String),
2737 "Pretty name of current buffer's major mode (a string).");
2738
2739 DEFVAR_PER_BUFFER ("abbrev-mode", &current_buffer->abbrev_mode, Qnil,
2740 "Non-nil turns on automatic expansion of abbrevs as they are inserted.\n\
2741 Automatically becomes buffer-local when set in any fashion.");
2742
2743 DEFVAR_PER_BUFFER ("case-fold-search", &current_buffer->case_fold_search,
2744 Qnil,
2745 "*Non-nil if searches should ignore case.\n\
2746 Automatically becomes buffer-local when set in any fashion.");
2747
2748 DEFVAR_PER_BUFFER ("fill-column", &current_buffer->fill_column,
2749 make_number (Lisp_Int),
2750 "*Column beyond which automatic line-wrapping should happen.\n\
2751 Automatically becomes buffer-local when set in any fashion.");
2752
2753 DEFVAR_PER_BUFFER ("left-margin", &current_buffer->left_margin,
2754 make_number (Lisp_Int),
2755 "*Column for the default indent-line-function to indent to.\n\
2756 Linefeed indents to this column in Fundamental mode.\n\
2757 Automatically becomes buffer-local when set in any fashion.");
2758
2759 DEFVAR_PER_BUFFER ("tab-width", &current_buffer->tab_width,
2760 make_number (Lisp_Int),
2761 "*Distance between tab stops (for display of tab characters), in columns.\n\
2762 Automatically becomes buffer-local when set in any fashion.");
2763
2764 DEFVAR_PER_BUFFER ("ctl-arrow", &current_buffer->ctl_arrow, Qnil,
2765 "*Non-nil means display control chars with uparrow.\n\
2766 Nil means use backslash and octal digits.\n\
2767 Automatically becomes buffer-local when set in any fashion.\n\
2768 This variable does not apply to characters whose display is specified\n\
2769 in the current display table (if there is one).");
2770
2771 DEFVAR_PER_BUFFER ("truncate-lines", &current_buffer->truncate_lines, Qnil,
2772 "*Non-nil means do not display continuation lines;\n\
2773 give each line of text one screen line.\n\
2774 Automatically becomes buffer-local when set in any fashion.\n\
2775 \n\
2776 Note that this is overridden by the variable\n\
2777 `truncate-partial-width-windows' if that variable is non-nil\n\
2778 and this buffer is not full-frame width.");
2779
2780 #ifdef MSDOS
2781 DEFVAR_PER_BUFFER ("buffer-file-type", &current_buffer->buffer_file_type,
2782 Qnil,
2783 "*If visited file is text, nil; otherwise, t.");
2784 #endif
2785
2786 DEFVAR_PER_BUFFER ("default-directory", &current_buffer->directory,
2787 make_number (Lisp_String),
2788 "Name of default directory of current buffer. Should end with slash.\n\
2789 Each buffer has its own value of this variable.");
2790
2791 DEFVAR_PER_BUFFER ("auto-fill-function", &current_buffer->auto_fill_function,
2792 Qnil,
2793 "Function called (if non-nil) to perform auto-fill.\n\
2794 It is called after self-inserting a space at a column beyond `fill-column'.\n\
2795 Each buffer has its own value of this variable.\n\
2796 NOTE: This variable is not an ordinary hook;\n\
2797 It may not be a list of functions.");
2798
2799 DEFVAR_PER_BUFFER ("buffer-file-name", &current_buffer->filename,
2800 make_number (Lisp_String),
2801 "Name of file visited in current buffer, or nil if not visiting a file.\n\
2802 Each buffer has its own value of this variable.");
2803
2804 DEFVAR_PER_BUFFER ("buffer-auto-save-file-name",
2805 &current_buffer->auto_save_file_name,
2806 make_number (Lisp_String),
2807 "Name of file for auto-saving current buffer,\n\
2808 or nil if buffer should not be auto-saved.\n\
2809 Each buffer has its own value of this variable.");
2810
2811 DEFVAR_PER_BUFFER ("buffer-read-only", &current_buffer->read_only, Qnil,
2812 "Non-nil if this buffer is read-only.\n\
2813 Each buffer has its own value of this variable.");
2814
2815 DEFVAR_PER_BUFFER ("buffer-backed-up", &current_buffer->backed_up, Qnil,
2816 "Non-nil if this buffer's file has been backed up.\n\
2817 Backing up is done before the first time the file is saved.\n\
2818 Each buffer has its own value of this variable.");
2819
2820 DEFVAR_PER_BUFFER ("buffer-saved-size", &current_buffer->save_length,
2821 make_number (Lisp_Int),
2822 "Length of current buffer when last read in, saved or auto-saved.\n\
2823 0 initially.\n\
2824 Each buffer has its own value of this variable.");
2825
2826 DEFVAR_PER_BUFFER ("selective-display", &current_buffer->selective_display,
2827 Qnil,
2828 "Non-nil enables selective display:\n\
2829 Integer N as value means display only lines\n\
2830 that start with less than n columns of space.\n\
2831 A value of t means, after a ^M, all the rest of the line is invisible.\n\
2832 Then ^M's in the file are written into files as newlines.\n\n\
2833 Automatically becomes buffer-local when set in any fashion.");
2834
2835 #ifndef old
2836 DEFVAR_PER_BUFFER ("selective-display-ellipses",
2837 &current_buffer->selective_display_ellipses,
2838 Qnil,
2839 "t means display ... on previous line when a line is invisible.\n\
2840 Automatically becomes buffer-local when set in any fashion.");
2841 #endif
2842
2843 DEFVAR_PER_BUFFER ("overwrite-mode", &current_buffer->overwrite_mode, Qnil,
2844 "Non-nil if self-insertion should replace existing text.\n\
2845 If non-nil and not `overwrite-mode-binary', self-insertion still\n\
2846 inserts at the end of a line, and inserts when point is before a tab,\n\
2847 until the tab is filled in.\n\
2848 If `overwrite-mode-binary', self-insertion replaces newlines and tabs too.\n\
2849 Automatically becomes buffer-local when set in any fashion.");
2850
2851 #if 0 /* The doc string is too long for some compilers,
2852 but make-docfile can find it in this comment. */
2853 DEFVAR_PER_BUFFER ("buffer-display-table", &current_buffer->display_table,
2854 Qnil,
2855 "Display table that controls display of the contents of current buffer.\n\
2856 Automatically becomes buffer-local when set in any fashion.\n\
2857 The display table is a vector created with `make-display-table'.\n\
2858 The first 256 elements control how to display each possible text character.\n\
2859 Each value should be a vector of characters or nil;\n\
2860 nil means display the character in the default fashion.\n\
2861 The remaining six elements control the display of\n\
2862 the end of a truncated screen line (element 256, a single character);\n\
2863 the end of a continued line (element 257, a single character);\n\
2864 the escape character used to display character codes in octal\n\
2865 (element 258, a single character);\n\
2866 the character used as an arrow for control characters (element 259,\n\
2867 a single character);\n\
2868 the decoration indicating the presence of invisible lines (element 260,\n\
2869 a vector of characters);\n\
2870 the character used to draw the border between side-by-side windows\n\
2871 (element 261, a single character).\n\
2872 If this variable is nil, the value of `standard-display-table' is used.\n\
2873 Each window can have its own, overriding display table.");
2874 #endif
2875 DEFVAR_PER_BUFFER ("buffer-display-table", &current_buffer->display_table,
2876 Qnil, 0);
2877
2878 /*DEFVAR_LISP ("debug-check-symbol", &Vcheck_symbol,
2879 "Don't ask.");
2880 */
2881 DEFVAR_LISP ("before-change-function", &Vbefore_change_function,
2882 "Function to call before each text change.\n\
2883 Two arguments are passed to the function: the positions of\n\
2884 the beginning and end of the range of old text to be changed.\n\
2885 \(For an insertion, the beginning and end are at the same place.)\n\
2886 No information is given about the length of the text after the change.\n\
2887 \n\
2888 Buffer changes made while executing the `before-change-function'\n\
2889 don't call any before-change or after-change functions.\n\
2890 That's because these variables are temporarily set to nil.\n\
2891 As a result, a hook function cannot straightforwardly alter the value of\n\
2892 these variables. See the Emacs Lisp manual for a way of\n\
2893 accomplishing an equivalent result by using other variables.");
2894 Vbefore_change_function = Qnil;
2895
2896 DEFVAR_LISP ("after-change-function", &Vafter_change_function,
2897 "Function to call after each text change.\n\
2898 Three arguments are passed to the function: the positions of\n\
2899 the beginning and end of the range of changed text,\n\
2900 and the length of the pre-change text replaced by that range.\n\
2901 \(For an insertion, the pre-change length is zero;\n\
2902 for a deletion, that length is the number of characters deleted,\n\
2903 and the post-change beginning and end are at the same place.)\n\
2904 \n\
2905 Buffer changes made while executing the `after-change-function'\n\
2906 don't call any before-change or after-change functions.\n\
2907 That's because these variables are temporarily set to nil.\n\
2908 As a result, a hook function cannot straightforwardly alter the value of\n\
2909 these variables. See the Emacs Lisp manual for a way of\n\
2910 accomplishing an equivalent result by using other variables.");
2911 Vafter_change_function = Qnil;
2912
2913 DEFVAR_LISP ("before-change-functions", &Vbefore_change_functions,
2914 "List of functions to call before each text change.\n\
2915 Two arguments are passed to each function: the positions of\n\
2916 the beginning and end of the range of old text to be changed.\n\
2917 \(For an insertion, the beginning and end are at the same place.)\n\
2918 No information is given about the length of the text after the change.\n\
2919 \n\
2920 Buffer changes made while executing the `before-change-functions'\n\
2921 don't call any before-change or after-change functions.\n\
2922 That's because these variables are temporarily set to nil.\n\
2923 As a result, a hook function cannot straightforwardly alter the value of\n\
2924 these variables. See the Emacs Lisp manual for a way of\n\
2925 accomplishing an equivalent result by using other variables.");
2926 Vbefore_change_functions = Qnil;
2927
2928 DEFVAR_LISP ("after-change-functions", &Vafter_change_functions,
2929 "List of function to call after each text change.\n\
2930 Three arguments are passed to each function: the positions of\n\
2931 the beginning and end of the range of changed text,\n\
2932 and the length of the pre-change text replaced by that range.\n\
2933 \(For an insertion, the pre-change length is zero;\n\
2934 for a deletion, that length is the number of characters deleted,\n\
2935 and the post-change beginning and end are at the same place.)\n\
2936 \n\
2937 Buffer changes made while executing the `after-change-functions'\n\
2938 don't call any before-change or after-change functions.\n\
2939 That's because these variables are temporarily set to nil.\n\
2940 As a result, a hook function cannot straightforwardly alter the value of\n\
2941 these variables. See the Emacs Lisp manual for a way of\n\
2942 accomplishing an equivalent result by using other variables.");
2943
2944 Vafter_change_functions = Qnil;
2945
2946 DEFVAR_LISP ("first-change-hook", &Vfirst_change_hook,
2947 "A list of functions to call before changing a buffer which is unmodified.\n\
2948 The functions are run using the `run-hooks' function.");
2949 Vfirst_change_hook = Qnil;
2950 Qfirst_change_hook = intern ("first-change-hook");
2951 staticpro (&Qfirst_change_hook);
2952
2953 #if 0 /* The doc string is too long for some compilers,
2954 but make-docfile can find it in this comment. */
2955 DEFVAR_PER_BUFFER ("buffer-undo-list", &current_buffer->undo_list, Qnil,
2956 "List of undo entries in current buffer.\n\
2957 Recent changes come first; older changes follow newer.\n\
2958 \n\
2959 An entry (START . END) represents an insertion which begins at\n\
2960 position START and ends at position END.\n\
2961 \n\
2962 An entry (TEXT . POSITION) represents the deletion of the string TEXT\n\
2963 from (abs POSITION). If POSITION is positive, point was at the front\n\
2964 of the text being deleted; if negative, point was at the end.\n\
2965 \n\
2966 An entry (t HIGHWORD LOWWORD) indicates that the buffer had been\n\
2967 previously unmodified. HIGHWORD and LOWWORD are the high and low\n\
2968 16-bit words of the buffer's modification count at the time. If the\n\
2969 modification count of the most recent save is different, this entry is\n\
2970 obsolete.\n\
2971 \n\
2972 An entry (nil PROP VAL BEG . END) indicates that a text property\n\
2973 was modified between BEG and END. PROP is the property name,\n\
2974 and VAL is the old value.\n\
2975 \n\
2976 An entry of the form POSITION indicates that point was at the buffer\n\
2977 location given by the integer. Undoing an entry of this form places\n\
2978 point at POSITION.\n\
2979 \n\
2980 nil marks undo boundaries. The undo command treats the changes\n\
2981 between two undo boundaries as a single step to be undone.\n\
2982 \n\
2983 If the value of the variable is t, undo information is not recorded.");
2984 #endif
2985 DEFVAR_PER_BUFFER ("buffer-undo-list", &current_buffer->undo_list, Qnil,
2986 0);
2987
2988 DEFVAR_PER_BUFFER ("mark-active", &current_buffer->mark_active, Qnil,
2989 "Non-nil means the mark and region are currently active in this buffer.\n\
2990 Automatically local in all buffers.");
2991
2992 DEFVAR_PER_BUFFER ("cache-long-line-scans", &current_buffer->cache_long_line_scans, Qnil,
2993 "Non-nil means that Emacs should use caches to handle long lines faster.\n\
2994 \n\
2995 Emacs moves from one line to the next by scanning the buffer for\n\
2996 newlines, and it implements columnar operations like move-to-column by\n\
2997 scanning the buffer, adding character widths as it goes. If the\n\
2998 buffer's lines are very long (say, more than 500 characters), these\n\
2999 scans can slow Emacs down a great deal.\n\
3000 \n\
3001 If this variable is non-nil, Emacs caches the results of its scans,\n\
3002 and avoids rescanning regions of the buffer until they are modified.\n\
3003 \n\
3004 If this variable is non-nil, short scans will become slightly slower,\n\
3005 and the caches will use memory roughly proportional to the number of\n\
3006 newlines and characters whose visual representation can occupy more than\n\
3007 one column.");
3008
3009 DEFVAR_LISP ("transient-mark-mode", &Vtransient_mark_mode,
3010 "*Non-nil means deactivate the mark when the buffer contents change.");
3011 Vtransient_mark_mode = Qnil;
3012
3013 DEFVAR_LISP ("inhibit-read-only", &Vinhibit_read_only,
3014 "*Non-nil means disregard read-only status of buffers or characters.\n\
3015 If the value is t, disregard `buffer-read-only' and all `read-only'\n\
3016 text properties. If the value is a list, disregard `buffer-read-only'\n\
3017 and disregard a `read-only' text property if the property value\n\
3018 is a member of the list.");
3019 Vinhibit_read_only = Qnil;
3020
3021 DEFVAR_LISP ("kill-buffer-query-functions", &Vkill_buffer_query_functions,
3022 "List of functions called with no args to query before killing a buffer.");
3023 Vkill_buffer_query_functions = Qnil;
3024
3025 defsubr (&Sbuffer_list);
3026 defsubr (&Sget_buffer);
3027 defsubr (&Sget_file_buffer);
3028 defsubr (&Sget_buffer_create);
3029 defsubr (&Sgenerate_new_buffer_name);
3030 defsubr (&Sbuffer_name);
3031 /*defsubr (&Sbuffer_number);*/
3032 defsubr (&Sbuffer_file_name);
3033 defsubr (&Sbuffer_local_variables);
3034 defsubr (&Sbuffer_modified_p);
3035 defsubr (&Sset_buffer_modified_p);
3036 defsubr (&Sbuffer_modified_tick);
3037 defsubr (&Srename_buffer);
3038 defsubr (&Sother_buffer);
3039 defsubr (&Sbuffer_disable_undo);
3040 defsubr (&Sbuffer_enable_undo);
3041 defsubr (&Skill_buffer);
3042 defsubr (&Serase_buffer);
3043 defsubr (&Sswitch_to_buffer);
3044 defsubr (&Spop_to_buffer);
3045 defsubr (&Scurrent_buffer);
3046 defsubr (&Sset_buffer);
3047 defsubr (&Sbarf_if_buffer_read_only);
3048 defsubr (&Sbury_buffer);
3049 defsubr (&Slist_buffers);
3050 defsubr (&Skill_all_local_variables);
3051
3052 defsubr (&Soverlayp);
3053 defsubr (&Smake_overlay);
3054 defsubr (&Sdelete_overlay);
3055 defsubr (&Smove_overlay);
3056 defsubr (&Soverlay_start);
3057 defsubr (&Soverlay_end);
3058 defsubr (&Soverlay_buffer);
3059 defsubr (&Soverlay_properties);
3060 defsubr (&Soverlays_at);
3061 defsubr (&Snext_overlay_change);
3062 defsubr (&Sprevious_overlay_change);
3063 defsubr (&Soverlay_recenter);
3064 defsubr (&Soverlay_lists);
3065 defsubr (&Soverlay_get);
3066 defsubr (&Soverlay_put);
3067 }
3068
3069 keys_of_buffer ()
3070 {
3071 initial_define_key (control_x_map, 'b', "switch-to-buffer");
3072 initial_define_key (control_x_map, 'k', "kill-buffer");
3073 initial_define_key (control_x_map, Ctl ('B'), "list-buffers");
3074
3075 /* This must not be in syms_of_buffer, because Qdisabled is not
3076 initialized when that function gets called. */
3077 Fput (intern ("erase-buffer"), Qdisabled, Qt);
3078 }