comparison src/buffer.c @ 0:376386a54a3c r19-14

Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children ac2d302a0011
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 /* Buffer manipulation primitives for XEmacs.
2 Copyright (C) 1985-1989, 1992-1995 Free Software Foundation, Inc.
3 Copyright (C) 1995 Sun Microsystems, Inc.
4 Copyright (C) 1995, 1996 Ben Wing.
5
6 This file is part of XEmacs.
7
8 XEmacs is free software; you can redistribute it and/or modify it
9 under the terms of the GNU General Public License as published by the
10 Free Software Foundation; either version 2, or (at your option) any
11 later version.
12
13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
16 for more details.
17
18 You should have received a copy of the GNU General Public License
19 along with XEmacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21 Boston, MA 02111-1307, USA. */
22
23 /* Synched up with: Mule 2.0, FSF 19.30. */
24
25 /* Authorship:
26
27 FSF: long ago.
28 JWZ: some changes for Lemacs, long ago. (e.g. separate buffer
29 list per frame.)
30 Mly: a few changes for buffer-local vars, 19.8 or 19.9.
31 Ben Wing: some changes and cleanups for Mule, 19.12.
32 */
33
34 /* This file contains functions that work with buffer objects.
35 Functions that manipulate a buffer's text, however, are not
36 in this file:
37
38 1) The low-level functions that actually know about the
39 implementation of a buffer's text are located in insdel.c.
40 2) The higher-level (mostly Lisp) functions that manipulate a
41 buffer's text are in editfns.c.
42 3) The highest-level Lisp commands are in cmds.c.
43
44 However:
45
46 -- Functions that know about syntax tables (forward-word,
47 scan-sexps, etc.) are in syntax.c, as are functions
48 that manipulate syntax tables.
49 -- Functions that know about case tables (upcase, downcase,
50 etc.) are in casefiddle.c. Functions that manipulate
51 case tables (case-table-p, set-case-table, etc.) are
52 in casetab.c.
53 -- Functions that do searching and replacing are in
54 search.c. The low-level functions that implement
55 regular expressions are in regex.c.
56
57 Also:
58
59 -- Some file and process functions (in fileio.c and process.c)
60 copy text from or insert text into a buffer; they call
61 low-level functions in insdel.c to do this.
62 -- insdel.c calls low-level functions in undo.c and extents.c
63 to record buffer modifications for undoing and to handle
64 extent adjustment and extent-data creation and insertion.
65
66 */
67
68 #include <config.h>
69 #include "lisp.h"
70
71 #include "buffer.h"
72 #include "commands.h"
73 #include "elhash.h"
74 #include "extents.h"
75 #include "faces.h"
76 #include "frame.h"
77 #include "insdel.h"
78 #include "process.h" /* for kill_buffer_processes */
79 #ifdef REGION_CACHE_NEEDS_WORK
80 #include "region-cache.h"
81 #endif
82 #include "symeval.h"
83 #include "syntax.h"
84 #include "sysdep.h" /* for getwd */
85 #include "window.h"
86
87 #include "sysfile.h"
88
89 struct buffer *current_buffer; /* the current buffer */
90
91 /* This structure holds the default values of the buffer-local variables
92 defined with DEFVAR_BUFFER_LOCAL, that have special slots in each buffer.
93 The default value occupies the same slot in this structure
94 as an individual buffer's value occupies in that buffer.
95 Setting the default value also goes through the alist of buffers
96 and stores into each buffer that does not say it has a local value. */
97 Lisp_Object Vbuffer_defaults;
98
99 /* This structure marks which slots in a buffer have corresponding
100 default values in buffer_defaults.
101 Each such slot has a nonzero value in this structure.
102 The value has only one nonzero bit.
103
104 When a buffer has its own local value for a slot,
105 the bit for that slot (found in the same slot in this structure)
106 is turned on in the buffer's local_var_flags slot.
107
108 If a slot in this structure is 0, then there is a DEFVAR_BUFFER_LOCAL
109 for the slot, but there is no default value for it; the corresponding
110 slot in buffer_defaults is not used except to initialize newly-created
111 buffers.
112
113 If a slot is -1, then there is a DEFVAR_BUFFER_LOCAL for it
114 as well as a default value which is used to initialize newly-created
115 buffers and as a reset-value when local-vars are killed.
116
117 If a slot is -2, there is no DEFVAR_BUFFER_LOCAL for it.
118 (The slot is always local, but there's no lisp variable for it.)
119 The default value is only used to initialize newly-creation buffers.
120
121 If a slot is -3, then there is no DEFVAR_BUFFER_LOCAL for it but
122 there is a default which is used to initialize newly-creation
123 buffers and as a reset-value when local-vars are killed.
124
125
126 */
127 struct buffer buffer_local_flags;
128
129 /* This structure holds the names of symbols whose values may be
130 buffer-local. It is indexed and accessed in the same way as the above. */
131 static Lisp_Object Vbuffer_local_symbols;
132
133 /* Alist of all buffer names vs the buffers. */
134 /* This used to be a variable, but is no longer,
135 to prevent lossage due to user rplac'ing this alist or its elements.
136 Note that there is a per-frame copy of this as well; the frame slot
137 and the global variable contain the same data, but possibly in different
138 orders, so that the buffer ordering can be per-frame.
139 */
140 Lisp_Object Vbuffer_alist;
141
142 /* Functions to call before and after each text change. */
143 Lisp_Object Qbefore_change_functions;
144 Lisp_Object Qafter_change_functions;
145 Lisp_Object Vbefore_change_functions;
146 Lisp_Object Vafter_change_functions;
147
148 /* #### Obsolete, for compatibility */
149 Lisp_Object Qbefore_change_function;
150 Lisp_Object Qafter_change_function;
151 Lisp_Object Vbefore_change_function;
152 Lisp_Object Vafter_change_function;
153
154 #if 0 /* FSFmacs */
155 Lisp_Object Vtransient_mark_mode;
156 #endif
157
158 /* t means ignore all read-only text properties.
159 A list means ignore such a property if its value is a member of the list.
160 Any non-nil value means ignore buffer-read-only. */
161 Lisp_Object Vinhibit_read_only;
162
163 /* List of functions to call that can query about killing a buffer.
164 If any of these functions returns nil, we don't kill it. */
165 Lisp_Object Vkill_buffer_query_functions;
166
167 /* Non-nil means delete a buffer's auto-save file when the buffer is saved. */
168 Lisp_Object Vdelete_auto_save_files;
169
170 Lisp_Object Qbuffer_live_p;
171 Lisp_Object Qbuffer_or_string_p;
172
173 /* List of functions to call before changing an unmodified buffer. */
174 Lisp_Object Vfirst_change_hook;
175 Lisp_Object Qfirst_change_hook;
176
177 Lisp_Object Qfundamental_mode;
178 Lisp_Object Qmode_class;
179 Lisp_Object Qpermanent_local;
180
181 Lisp_Object Qprotected_field;
182
183 Lisp_Object QSFundamental; /* A string "Fundamental" */
184 Lisp_Object QSscratch; /* "*scratch*" */
185 Lisp_Object Qdefault_directory;
186
187 Lisp_Object Qkill_buffer_hook;
188 Lisp_Object Qbuffer_file_name, Qbuffer_undo_list;
189
190 Lisp_Object Qrename_auto_save_file;
191
192 Lisp_Object Qget_file_buffer;
193 Lisp_Object Qchange_major_mode_hook, Vchange_major_mode_hook;
194
195 Lisp_Object Qfind_file_compare_truenames;
196
197 Lisp_Object Qswitch_to_buffer;
198
199 /* Two thresholds controlling how much undo information to keep. */
200 int undo_threshold;
201 int undo_high_threshold;
202
203 int find_file_compare_truenames;
204 int find_file_use_truenames;
205
206
207 static void reset_buffer_local_variables (struct buffer *, int first_time);
208 static void nuke_all_buffer_slots (struct buffer *b, Lisp_Object zap);
209 static Lisp_Object mark_buffer (Lisp_Object, void (*) (Lisp_Object));
210 static void print_buffer (Lisp_Object, Lisp_Object, int);
211 /* We do not need a finalize method to handle a buffer's children list
212 because all buffers have `kill-buffer' applied to them before
213 they disappear, and the children removal happens then. */
214 DEFINE_LRECORD_IMPLEMENTATION ("buffer", buffer,
215 mark_buffer, print_buffer, 0, 0, 0,
216 struct buffer);
217
218 #ifdef ENERGIZE
219 extern void mark_energize_buffer_data (struct buffer *b,
220 void (*markobj) (Lisp_Object));
221 #endif
222
223 Lisp_Object
224 make_buffer (struct buffer *buf)
225 {
226 Lisp_Object obj;
227 XSETBUFFER (obj, buf);
228 return obj;
229 }
230
231 static Lisp_Object
232 mark_buffer (Lisp_Object obj, void (*markobj) (Lisp_Object))
233 {
234 struct buffer *buf = XBUFFER (obj);
235
236 /* Truncate undo information. */
237 buf->undo_list = truncate_undo_list (buf->undo_list,
238 undo_threshold,
239 undo_high_threshold);
240
241 #define MARKED_SLOT(x) ((markobj) (buf->x));
242 #include "bufslots.h"
243 #undef MARKED_SLOT
244
245 #ifdef ENERGIZE
246 mark_energize_buffer_data (XBUFFER (obj), markobj);
247 #endif
248
249 ((markobj) (buf->extent_info));
250
251 /* Don't mark normally through the children slot.
252 (Actually, in this case, it doesn't matter.)
253 */
254 mark_conses_in_list (buf->indirect_children);
255
256 if (buf->base_buffer)
257 {
258 Lisp_Object base_buf_obj = Qnil;
259
260 XSETBUFFER (base_buf_obj, buf->base_buffer);
261 return base_buf_obj;
262 }
263 else
264 return Qnil;
265 }
266
267 static void
268 print_buffer (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
269 {
270 struct buffer *b = XBUFFER (obj);
271
272 if (print_readably)
273 {
274 if (!BUFFER_LIVE_P (b))
275 error ("printing unreadable object #<killed buffer>");
276 else
277 error ("printing unreadable object #<buffer %s>",
278 string_data (XSTRING (b->name)));
279 }
280 else if (!BUFFER_LIVE_P (b))
281 write_c_string ("#<killed buffer>", printcharfun);
282 else if (escapeflag)
283 {
284 write_c_string ("#<buffer ", printcharfun);
285 print_internal (b->name, printcharfun, 1);
286 write_c_string (">", printcharfun);
287 }
288 else
289 {
290 print_internal (b->name, printcharfun, 0);
291 }
292 }
293
294
295 DEFUN ("bufferp", Fbufferp, Sbufferp, 1, 1, 0 /*
296 T if OBJECT is an editor buffer.
297 */ )
298 (object)
299 Lisp_Object object;
300 {
301 if (BUFFERP (object))
302 return Qt;
303 return Qnil;
304 }
305
306 DEFUN ("buffer-live-p", Fbuffer_live_p, Sbuffer_live_p, 1, 1, 0 /*
307 T if OBJECT is an editor buffer that has not been deleted.
308 */ )
309 (object)
310 Lisp_Object object;
311 {
312 if (BUFFERP (object) && BUFFER_LIVE_P (XBUFFER (object)))
313 return Qt;
314 return Qnil;
315 }
316
317 static void
318 nsberror (Lisp_Object spec)
319 {
320 if (STRINGP (spec))
321 error ("No buffer named %s", string_data (XSTRING (spec)));
322 signal_simple_error ("Invalid buffer argument", spec);
323 }
324
325 DEFUN ("buffer-list", Fbuffer_list, Sbuffer_list, 0, 1, 0 /*
326 Return a list of all existing live buffers.
327 The order is specific to the selected frame; if the optional FRAME
328 argument is provided, the ordering for that frame is returned instead.
329 If the FRAME argument is t, then the global (non-frame) ordering is
330 returned instead.
331 */ )
332 (frame)
333 Lisp_Object frame;
334 {
335 Lisp_Object list;
336 if (EQ (frame, Qt))
337 list = Vbuffer_alist;
338 else
339 list = decode_frame (frame)->buffer_alist;
340 return Fmapcar (Qcdr, list);
341 }
342
343 Lisp_Object
344 get_buffer (Lisp_Object name, int error_if_deleted_or_does_not_exist)
345 {
346 Lisp_Object buf;
347
348 if (BUFFERP (name))
349 {
350 if (!BUFFER_LIVE_P (XBUFFER (name)))
351 {
352 if (error_if_deleted_or_does_not_exist)
353 nsberror (name);
354 return (Qnil);
355 }
356 return name;
357 }
358 else
359 {
360 struct gcpro gcpro1;
361
362 CHECK_STRING (name);
363 name = LISP_GETTEXT (name); /* I18N3 */
364 GCPRO1 (name);
365 buf = Fcdr (Fassoc (name, Vbuffer_alist));
366 UNGCPRO;
367 if (NILP (buf) && error_if_deleted_or_does_not_exist)
368 nsberror (name);
369 return (buf);
370 }
371 }
372
373 struct buffer *
374 decode_buffer (Lisp_Object buffer, int allow_string)
375 {
376 if (NILP (buffer))
377 {
378 return current_buffer;
379 }
380 else if (STRINGP (buffer))
381 {
382 if (allow_string)
383 return XBUFFER (get_buffer (buffer, 1));
384 else
385 CHECK_BUFFER (buffer); /* This will cause a wrong-type error. */
386 }
387
388 CHECK_LIVE_BUFFER (buffer);
389 return XBUFFER (buffer);
390 }
391
392 DEFUN ("decode-buffer", Fdecode_buffer, Sdecode_buffer, 1, 1, 0 /*
393 Validate BUFFER or if BUFFER is nil, return the current buffer.
394 If BUFFER is a valid buffer or a string representing a valid buffer,
395 the corresponding buffer object will be returned. Otherwise an error
396 will be signaled.
397 */ )
398 (buffer)
399 Lisp_Object buffer;
400 {
401 struct buffer *b = decode_buffer (buffer, 1);
402 XSETBUFFER (buffer, b);
403 return buffer;
404 }
405
406 #if 0 /* FSFmacs */
407 /* bleagh!!! */
408 /* Like Fassoc, but use Fstring_equal to compare
409 (which ignores text properties),
410 and don't ever QUIT. */
411
412 static Lisp_Object
413 assoc_ignore_text_properties (register Lisp_Object key, Lisp_Object list)
414 {
415 register Lisp_Object tail;
416 for (tail = list; !NILP (tail); tail = Fcdr (tail))
417 {
418 register Lisp_Object elt, tem;
419 elt = Fcar (tail);
420 tem = Fstring_equal (Fcar (elt), key);
421 if (!NILP (tem))
422 return elt;
423 }
424 return Qnil;
425 }
426
427 #endif
428
429 DEFUN ("get-buffer", Fget_buffer, Sget_buffer, 1, 1, 0 /*
430 Return the buffer named NAME (a string).
431 If there is no live buffer named NAME, return nil.
432 NAME may also be a buffer; if so, the value is that buffer.
433 */ )
434 (name)
435 Lisp_Object name;
436 {
437 #ifdef I18N3
438 /* #### Doc string should indicate that the buffer name will get
439 translated. */
440 #endif
441
442 /* #### This might return a dead buffer. This is gross. This is
443 called FSF compatibility. */
444 if (BUFFERP (name))
445 return name;
446 return (get_buffer (name, 0));
447 /* FSFmacs 19.29 calls assoc_ignore_text_properties() here.
448 Bleagh!! */
449 }
450
451
452 DEFUN ("get-file-buffer", Fget_file_buffer, Sget_file_buffer, 1, 1, 0 /*
453 Return the buffer visiting file FILENAME (a string).
454 The buffer's `buffer-file-name' must match exactly the expansion of FILENAME.
455 If there is no such live buffer, return nil.
456
457 Normally, the comparison is done by canonicalizing FILENAME (using
458 `expand-file-name') and comparing that to the value of `buffer-file-name'
459 for each existing buffer. However, If `find-file-compare-truenames' is
460 non-nil, FILENAME will be converted to its truename and the search will be
461 done on each buffer's value of `buffer-file-truename' instead of
462 `buffer-file-name'. Otherwise, if `find-file-use-truenames' is non-nil,
463 FILENAME will be converted to its truename and used for searching, but
464 the search will still be done on `buffer-file-name'.
465 */ )
466 (filename)
467 Lisp_Object filename;
468 {
469 /* This function can GC */
470 REGISTER Lisp_Object tail, buf, tem;
471 struct gcpro gcpro1;
472
473 #ifdef I18N3
474 /* DO NOT translate the filename. */
475 #endif
476 GCPRO1 (filename);
477 CHECK_STRING (filename);
478 filename = Fexpand_file_name (filename, Qnil);
479 {
480 /* If the file name has special constructs in it,
481 call the corresponding file handler. */
482 Lisp_Object handler = Ffind_file_name_handler (filename, Qget_file_buffer);
483 if (!NILP (handler))
484 {
485 UNGCPRO;
486 return call2 (handler, Qget_file_buffer, filename);
487 }
488 }
489 UNGCPRO;
490
491 if (find_file_compare_truenames || find_file_use_truenames)
492 {
493 struct gcpro ngcpro1, ngcpro2, ngcpro3;
494 Lisp_Object fn = Qnil;
495 Lisp_Object dn = Qnil;
496
497 NGCPRO3 (fn, dn, filename);
498 fn = Ffile_truename (filename, Qnil);
499 if (NILP (fn))
500 {
501 dn = Ffile_name_directory (filename);
502 fn = Ffile_truename (dn, Qnil);
503 if (! NILP (fn)) dn = fn;
504 fn = Fexpand_file_name (Ffile_name_nondirectory (filename),
505 dn);
506 }
507 filename = fn;
508 NUNGCPRO;
509 }
510
511 for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
512 {
513 buf = Fcdr (XCAR (tail));
514 if (!BUFFERP (buf)) continue;
515 if (!STRINGP (XBUFFER (buf)->filename)) continue;
516 tem = Fstring_equal (filename,
517 (find_file_compare_truenames
518 ? XBUFFER (buf)->file_truename
519 : XBUFFER (buf)->filename));
520 if (!NILP (tem))
521 return buf;
522 }
523 return Qnil;
524 }
525
526
527 static void
528 push_buffer_alist (Lisp_Object name, Lisp_Object buf)
529 {
530 Lisp_Object cons = Fcons (name, buf);
531 Lisp_Object frmcons, devcons, concons;
532
533 Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (cons, Qnil));
534 FRAME_LOOP_NO_BREAK (frmcons, devcons, concons)
535 {
536 struct frame *f;
537 f = XFRAME (XCAR (frmcons));
538 f->buffer_alist = nconc2 (f->buffer_alist, Fcons (cons, Qnil));
539 }
540 }
541
542 static void
543 delete_from_buffer_alist (Lisp_Object buf)
544 {
545 Lisp_Object cons = Frassq (buf, Vbuffer_alist);
546 Lisp_Object frmcons, devcons, concons;
547 if (NILP (cons))
548 return; /* abort() ? */
549 Vbuffer_alist = delq_no_quit (cons, Vbuffer_alist);
550
551 FRAME_LOOP_NO_BREAK (frmcons, devcons, concons)
552 {
553 struct frame *f;
554 f = XFRAME (XCAR (frmcons));
555 f->buffer_alist = delq_no_quit (cons, f->buffer_alist);
556 }
557 }
558
559 Lisp_Object
560 get_truename_buffer (REGISTER Lisp_Object filename)
561 {
562 /* FSFmacs has its own code here and doesn't call get-file-buffer.
563 That's because their equivalent of find-file-compare-truenames
564 (find-file-existing-other-name) isn't looked at in get-file-buffer.
565 This way is more correct. */
566 int count = specpdl_depth ();
567
568 specbind (Qfind_file_compare_truenames, Qt);
569 return unbind_to (count, Fget_file_buffer (filename));
570 }
571
572 static struct buffer *
573 allocate_buffer (void)
574 {
575 struct buffer *b = alloc_lcrecord (sizeof (struct buffer), lrecord_buffer);
576
577 copy_lcrecord (b, XBUFFER (Vbuffer_defaults));
578
579 return b;
580 }
581
582 static Lisp_Object
583 finish_init_buffer (struct buffer *b, Lisp_Object name)
584 {
585 Lisp_Object buf;
586
587 XSETBUFFER (buf, b);
588
589 name = Fcopy_sequence (name);
590 /* #### This really does not need to be called. We already
591 initialized the buffer-local variables in allocate_buffer().
592 local_var_alist is set to Qnil at the same point, in
593 nuke_all_buffer_slots(). */
594 reset_buffer_local_variables (b, 1);
595 b->directory = ((current_buffer) ? current_buffer->directory : Qnil);
596
597 b->last_window_start = 1;
598
599 b->name = name;
600 if (string_byte (XSTRING (name), 0) != ' ')
601 b->undo_list = Qnil;
602 else
603 b->undo_list = Qt;
604
605 /* initialize the extent list */
606 init_buffer_extents (b);
607
608 /* Put this in the alist of all live buffers. */
609 push_buffer_alist (name, buf);
610
611 init_buffer_markers (b);
612
613 b->generated_modeline_string = Fmake_string (make_int (84), make_int (' '));
614 b->modeline_extent_table = make_lisp_hashtable (20, HASHTABLE_KEY_WEAK,
615 HASHTABLE_EQ);
616
617 return buf;
618 }
619
620 DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 1, 0 /*
621 Return the buffer named NAME, or create such a buffer and return it.
622 A new buffer is created if there is no live buffer named NAME.
623 If NAME starts with a space, the new buffer does not keep undo information.
624 If NAME is a buffer instead of a string, then it is the value returned.
625 The value is never nil.
626 */ )
627 (name)
628 Lisp_Object name;
629 {
630 /* This function can GC */
631 Lisp_Object buf;
632 REGISTER struct buffer *b;
633
634 #ifdef I18N3
635 /* #### Doc string should indicate that the buffer name will get
636 translated. */
637 #endif
638
639 name = LISP_GETTEXT (name);
640 buf = Fget_buffer (name);
641 if (!NILP (buf))
642 return buf;
643
644 if (string_length (XSTRING (name)) == 0)
645 error ("Empty string for buffer name is not allowed");
646
647 b = allocate_buffer ();
648
649 b->text = &b->own_text;
650 b->base_buffer = 0;
651 b->indirect_children = Qnil;
652 init_buffer_text (b, 0);
653
654 return finish_init_buffer (b, name);
655 }
656
657 DEFUN ("make-indirect-buffer",
658 Fmake_indirect_buffer, Smake_indirect_buffer, 2, 2,
659 "bMake indirect buffer (to buffer): \nBName of indirect buffer: " /*
660 Create and return an indirect buffer for buffer BASE, named NAME.
661 BASE should be an existing buffer (or buffer name).
662 NAME should be a string which is not the name of an existing buffer.
663 If BASE is an indirect buffer itself, the base buffer for that buffer
664 is made the base buffer for the newly created buffer. (Thus, there will
665 never be indirect buffers whose base buffers are themselves indirect.)
666 */ )
667 (base_buffer, name)
668 Lisp_Object base_buffer, name;
669 {
670 error ("make-indirect-buffer not yet implemented, oops");
671 return Qnil;
672
673 #if 0 /* #### implement this! Need various changes in insdel.c */
674 Lisp_Object buf;
675 REGISTER struct buffer *b;
676
677 name = LISP_GETTEXT (name);
678 buf = Fget_buffer (name);
679 if (!NILP (buf))
680 error ("Buffer name `%s' is in use", string_data (XSTRING (name)));
681
682 base_buffer = Fget_buffer (base_buffer);
683 if (NILP (base_buffer))
684 error ("No such buffer: `%s'",
685 string_data (XSTRING (XBUFFER (base_buffer)->name)));
686
687 if (string_length (XSTRING (name)) == 0)
688 error ("Empty string for buffer name is not allowed");
689
690 b = allocate_buffer ();
691
692 if (XBUFFER (base_buffer)->base_buffer)
693 b->base_buffer = XBUFFER (base_buffer)->base_buffer;
694 else
695 b->base_buffer = XBUFFER (base_buffer);
696
697 /* Use the base buffer's text object. */
698 b->text = b->base_buffer->text;
699 b->indirect_children = Qnil;
700 XSETBUFFER (buf, b);
701 b->base_buffer->indirect_children =
702 Fcons (buf, b->base_buffer->indirect_children);
703 init_buffer_text (b, 1);
704
705 return finish_init_buffer (b, name);
706 #endif /* 0 */
707 }
708
709
710 static void
711 reset_buffer_local_variables (struct buffer *b, int first_time)
712 {
713 struct buffer *def = XBUFFER (Vbuffer_defaults);
714
715 b->local_var_flags = 0;
716 /* For each slot that has a default value,
717 copy that into the slot. */
718 #define MARKED_SLOT(slot) \
719 { int mask = XINT (buffer_local_flags.slot); \
720 if ((mask > 0 || mask == -1 || mask == -3) \
721 && (first_time \
722 || NILP (Fget (XBUFFER (Vbuffer_local_symbols)->slot, \
723 Qpermanent_local, Qnil)))) \
724 b->slot = def->slot; \
725 }
726 #include "bufslots.h"
727 #undef MARKED_SLOT
728 }
729
730
731 /* We split this away from generate-new-buffer, because rename-buffer
732 and set-visited-file-name ought to be able to use this to really
733 rename the buffer properly. */
734
735 DEFUN ("generate-new-buffer-name", Fgenerate_new_buffer_name,
736 Sgenerate_new_buffer_name,
737 1, 2, 0 /*
738 Return a string that is the name of no existing buffer based on NAME.
739 If there is no live buffer named NAME, then return NAME.
740 Otherwise modify name by appending `<NUMBER>', incrementing NUMBER
741 until an unused name is found, and then return that name.
742 Optional second argument IGNORE specifies a name that is okay to use
743 \(if it is in the sequence to be tried)
744 even if a buffer with that name exists.
745 */ )
746 (name, ignore)
747 Lisp_Object name, ignore;
748 {
749 REGISTER Lisp_Object gentemp, tem;
750 int count;
751 char number[10];
752
753 CHECK_STRING (name);
754
755 name = LISP_GETTEXT (name);
756 #ifdef I18N3
757 /* #### Doc string should indicate that the buffer name will get
758 translated. */
759 #endif
760
761 tem = Fget_buffer (name);
762 if (NILP (tem))
763 return (name);
764
765 count = 1;
766 while (1)
767 {
768 sprintf (number, "<%d>", ++count);
769 gentemp = concat2 (name, build_string (number));
770 if (!NILP (ignore))
771 {
772 tem = Fstring_equal (gentemp, ignore);
773 if (!NILP (tem))
774 return gentemp;
775 }
776 tem = Fget_buffer (gentemp);
777 if (NILP (tem))
778 return (gentemp);
779 }
780 }
781
782
783 DEFUN ("buffer-name", Fbuffer_name, Sbuffer_name, 0, 1, 0 /*
784 Return the name of BUFFER, as a string.
785 With no argument or nil as argument, return the name of the current buffer.
786 */ )
787 (buffer)
788 Lisp_Object buffer;
789 {
790 /* For compatibility, we allow a dead buffer here.
791 Earlier versions of Emacs didn't provide buffer-live-p. */
792 if (NILP (buffer))
793 return current_buffer->name;
794 CHECK_BUFFER (buffer);
795 return XBUFFER (buffer)->name;
796 }
797
798 DEFUN ("buffer-file-name", Fbuffer_file_name, Sbuffer_file_name, 0, 1, 0 /*
799 Return name of file BUFFER is visiting, or nil if none.
800 No argument or nil as argument means use the current buffer.
801 */ )
802 (buffer)
803 Lisp_Object buffer;
804 {
805 /* For compatibility, we allow a dead buffer here. Yuck! */
806 if (NILP (buffer))
807 return current_buffer->filename;
808 CHECK_BUFFER (buffer);
809 return XBUFFER (buffer)->filename;
810 }
811
812 DEFUN ("buffer-base-buffer", Fbuffer_base_buffer, Sbuffer_base_buffer,
813 0, 1, 0 /*
814 Return the base buffer of indirect buffer BUFFER.
815 If BUFFER is not indirect, return nil.
816 */ )
817 (buffer)
818 Lisp_Object buffer;
819 {
820 struct buffer *buf = decode_buffer (buffer, 0);
821 struct buffer *base = buf->base_buffer;
822 Lisp_Object base_buffer = Qnil;
823
824 if (! base)
825 return Qnil;
826 XSETBUFFER (base_buffer, base);
827 return base_buffer;
828 }
829
830 DEFUN ("buffer-indirect-children", Fbuffer_indirect_children,
831 Sbuffer_indirect_children,
832 0, 1, 0 /*
833 Return a list of all indirect buffers whose base buffer is BUFFER.
834 If BUFFER is indirect, the return value will always be nil; see
835 `make-indirect-buffer'.
836 */ )
837 (buffer)
838 Lisp_Object buffer;
839 {
840 struct buffer *buf = decode_buffer (buffer, 0);
841
842 return Fcopy_sequence (buf->indirect_children);
843 }
844
845 /* Map MAPFUN over all buffers that share the same text as BUF
846 (this includes BUF). Pass two arguments to MAPFUN: a buffer,
847 and CLOSURE. If any invocation of MAPFUN returns non-zero,
848 halt immediately and return that value. Otherwise, continue
849 the mapping to the end and return 0. */
850
851 int
852 map_over_sharing_buffers (struct buffer *buf,
853 int (*mapfun) (struct buffer *buf, void *closure),
854 void *closure)
855 {
856 int result;
857 Lisp_Object tail;
858
859 if (buf->base_buffer)
860 {
861 buf = buf->base_buffer;
862 assert (!buf->base_buffer);
863 }
864
865 result = (mapfun) (buf, closure);
866 if (result)
867 return result;
868
869 LIST_LOOP (tail, buf->indirect_children)
870 {
871 Lisp_Object buffer = XCAR (tail);
872 result = (mapfun) (XBUFFER (buffer), closure);
873 if (result)
874 return result;
875 }
876
877 return 0;
878 }
879
880 DEFUN ("buffer-local-variables", Fbuffer_local_variables,
881 Sbuffer_local_variables, 0, 1, 0 /*
882 Return an alist of variables that are buffer-local in BUFFER.
883 Most elements look like (SYMBOL . VALUE), describing one variable.
884 For a symbol that is locally unbound, just the symbol appears in the value.
885 Note that storing new VALUEs in these elements doesn't change the variables.
886 No argument or nil as argument means use current buffer as BUFFER.
887 */ )
888 (buffer)
889 Lisp_Object buffer;
890 {
891 struct buffer *buf = decode_buffer (buffer, 0);
892 Lisp_Object result = Qnil;
893
894 {
895 Lisp_Object tail;
896 for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail))
897 {
898 Lisp_Object elt = XCAR (tail);
899 /* Reference each variable in the alist in buf.
900 If inquiring about the current buffer, this gets the current values,
901 so store them into the alist so the alist is up to date.
902 If inquiring about some other buffer, this swaps out any values
903 for that buffer, making the alist up to date automatically. */
904 Lisp_Object val = find_symbol_value (XCAR (elt));
905 /* Use the current buffer value only if buf is the current buffer. */
906 if (buf != current_buffer)
907 val = XCDR (elt);
908
909 /* If symbol is unbound, put just the symbol in the list. */
910 if (UNBOUNDP (val))
911 result = Fcons (XCAR (elt), result);
912 /* Otherwise, put (symbol . value) in the list. */
913 else
914 result = Fcons (Fcons (XCAR (elt), val), result);
915 }
916 }
917
918 /* Add on all the variables stored in special slots. */
919 {
920 struct buffer *syms = XBUFFER (Vbuffer_local_symbols);
921 #define MARKED_SLOT(slot) \
922 { int mask = XINT (buffer_local_flags.slot); \
923 if (mask == 0 || mask == -1 \
924 || ((mask > 0) && (buf->local_var_flags & mask))) \
925 result = Fcons (Fcons (syms->slot, buf->slot), result); \
926 }
927 #include "bufslots.h"
928 #undef MARKED_SLOT
929 }
930 return (result);
931 }
932
933 DEFUN ("buffer-dedicated-frame", Fbuffer_dedicated_frame,
934 Sbuffer_dedicated_frame,
935 0, 1, 0 /*
936 Return the frame dedicated to this BUFFER, or nil if there is none.
937 No argument or nil as argument means use current buffer as BUFFER.
938 */ )
939 (buffer)
940 Lisp_Object buffer;
941 {
942 struct buffer *buf = decode_buffer (buffer, 0);
943
944 /* XEmacs addition: if the frame is dead, silently make it go away. */
945 if (!NILP (buf->dedicated_frame) &&
946 !FRAME_LIVE_P (XFRAME (buf->dedicated_frame)))
947 buf->dedicated_frame = Qnil;
948
949 return buf->dedicated_frame;
950 }
951
952 DEFUN ("set-buffer-dedicated-frame", Fset_buffer_dedicated_frame,
953 Sset_buffer_dedicated_frame,
954 2, 2, 0 /*
955 For this BUFFER, set the FRAME dedicated to it.
956 FRAME must be a frame or nil.
957 */ )
958 (buffer, frame)
959 Lisp_Object buffer, frame;
960 {
961 struct buffer *buf = decode_buffer (buffer, 0);
962
963 if (!NILP (frame))
964 CHECK_LIVE_FRAME (frame); /* XEmacs change */
965
966 return buf->dedicated_frame = frame;
967 }
968
969
970
971 DEFUN ("buffer-modified-p", Fbuffer_modified_p, Sbuffer_modified_p,
972 0, 1, 0 /*
973 Return t if BUFFER was modified since its file was last read or saved.
974 No argument or nil as argument means use current buffer as BUFFER.
975 */ )
976 (buffer)
977 Lisp_Object buffer;
978 {
979 struct buffer *buf = decode_buffer (buffer, 0);
980
981 return BUF_SAVE_MODIFF (buf) < BUF_MODIFF (buf) ? Qt : Qnil;
982 }
983
984 DEFUN ("set-buffer-modified-p", Fset_buffer_modified_p, Sset_buffer_modified_p,
985 1, 2, 0 /*
986 Mark BUFFER as modified or unmodified according to FLAG.
987 A non-nil FLAG means mark the buffer modified. No argument or nil
988 as BUFFER means use current buffer.
989 */ )
990 (flag, buffer)
991 Lisp_Object flag, buffer;
992 {
993 /* This function can GC */
994 Lisp_Object fn;
995 struct buffer *buf = decode_buffer (buffer, 0);
996
997 #ifdef ENERGIZE
998 Lisp_Object starting_flag =
999 (BUF_SAVE_MODIFF (buf) < BUF_MODIFF (buf)) ? Qt : Qnil;
1000 Lisp_Object argument_flag = (NILP (flag)) ? Qnil : Qt;
1001 #endif
1002
1003 #ifdef CLASH_DETECTION
1004 /* If buffer becoming modified, lock the file.
1005 If buffer becoming unmodified, unlock the file. */
1006
1007 fn = buf->file_truename;
1008 if (!NILP (fn))
1009 {
1010 int already = BUF_SAVE_MODIFF (buf) < BUF_MODIFF (buf);
1011 if (already == NILP (flag))
1012 {
1013 int count = specpdl_depth ();
1014 /* lock_file() and unlock_file() currently use current_buffer */
1015 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
1016 set_buffer_internal (buf);
1017 if (!already && !NILP (flag))
1018 lock_file (fn);
1019 else if (already && NILP (flag))
1020 unlock_file (fn);
1021 unbind_to (count, Qnil);
1022 }
1023 }
1024 #endif /* CLASH_DETECTION */
1025
1026 /* This is often called when the buffer contents are altered but we
1027 don't want to treat the changes that way (e.g. selective
1028 display). We still need to make sure redisplay realizes that the
1029 contents have potentially altered and it needs to do some
1030 work. */
1031 BUF_MODIFF (buf)++;
1032 BUF_SAVE_MODIFF (buf) = NILP (flag) ? BUF_MODIFF (buf) : 0;
1033 MARK_MODELINE_CHANGED;
1034
1035 #ifdef ENERGIZE
1036 /* don't send any notification if we are "setting" the modification bit
1037 to be the same as it already was */
1038 if (!EQ (starting_flag, argument_flag))
1039 {
1040 extern Lisp_Object Qenergize_buffer_modified_hook;
1041 int count = specpdl_depth ();
1042 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
1043 set_buffer_internal (buf);
1044 va_run_hook_with_args (Qenergize_buffer_modified_hook, 3,
1045 flag, make_int (BUF_BEG (buf)),
1046 make_int (BUF_Z (buf)));
1047 unbind_to (count, Qnil);
1048 }
1049 #endif /* ENERGIZE */
1050
1051 return flag;
1052 }
1053
1054 DEFUN ("buffer-modified-tick", Fbuffer_modified_tick, Sbuffer_modified_tick,
1055 0, 1, 0 /*
1056 Return BUFFER's tick counter, incremented for each change in text.
1057 Each buffer has a tick counter which is incremented each time the text in
1058 that buffer is changed. It wraps around occasionally.
1059 No argument or nil as argument means use current buffer as BUFFER.
1060 */ )
1061 (buffer)
1062 Lisp_Object buffer;
1063 {
1064 struct buffer *buf = decode_buffer (buffer, 0);
1065
1066 return make_int (BUF_MODIFF (buf));
1067 }
1068
1069 DEFUN ("rename-buffer", Frename_buffer, Srename_buffer, 1, 2,
1070 "sRename buffer (to new name): \nP" /*
1071 Change current buffer's name to NEWNAME (a string).
1072 If second arg UNIQUE is nil or omitted, it is an error if a
1073 buffer named NEWNAME already exists.
1074 If UNIQUE is non-nil, come up with a new name using
1075 `generate-new-buffer-name'.
1076 Interactively, one can set UNIQUE with a prefix argument.
1077 Returns the name we actually gave the buffer.
1078 This does not change the name of the visited file (if any).
1079 */ )
1080 (newname, unique)
1081 Lisp_Object newname, unique;
1082 {
1083 /* This function can GC */
1084 Lisp_Object tem, buf;
1085
1086 #ifdef I18N3
1087 /* #### Doc string should indicate that the buffer name will get
1088 translated. */
1089 #endif
1090 CHECK_STRING (newname);
1091 newname = LISP_GETTEXT (newname);
1092
1093 if (string_length (XSTRING (newname)) == 0)
1094 error ("Empty string is invalid as a buffer name");
1095
1096 tem = Fget_buffer (newname);
1097 /* Don't short-circuit if UNIQUE is t. That is a useful way to rename
1098 the buffer automatically so you can create another with the original name.
1099 It makes UNIQUE equivalent to
1100 (rename-buffer (generate-new-buffer-name NEWNAME)). */
1101 /* XEmacs change: added check for nil */
1102 if (NILP (unique) && !NILP (tem) && XBUFFER (tem) == current_buffer)
1103 return current_buffer->name;
1104 if (!NILP (tem))
1105 {
1106 if (!NILP (unique))
1107 newname = Fgenerate_new_buffer_name (newname, current_buffer->name);
1108 else
1109 error ("Buffer name \"%s\" is in use",
1110 string_data (XSTRING (newname)));
1111 }
1112
1113 current_buffer->name = newname;
1114
1115 /* Catch redisplay's attention. Unless we do this, the modelines for
1116 any windows displaying current_buffer will stay unchanged. */
1117 MARK_MODELINE_CHANGED;
1118
1119 buf = Fcurrent_buffer ();
1120
1121 /* The aconses in the Vbuffer_alist are shared with frame->buffer_alist,
1122 so this will change it in the per-frame ordering as well. */
1123 Fsetcar (Frassq (buf, Vbuffer_alist), newname);
1124 if (NILP (current_buffer->filename)
1125 && !NILP (current_buffer->auto_save_file_name))
1126 call0 (Qrename_auto_save_file);
1127 /* refetch since that last call may have done GC */
1128 /* (hypothetical relocating GC) */
1129 return current_buffer->name;
1130 }
1131
1132 DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 3, 0 /*
1133 Return most recently selected buffer other than BUFFER.
1134 Buffers not visible in windows are preferred to visible buffers,
1135 unless optional third argument VISIBLE-OK is non-nil.
1136 If no other buffer exists, the buffer `*scratch*' is returned.
1137 If BUFFER is omitted or nil, some interesting buffer is returned.
1138
1139 The ordering is for this frame; If second optional argument FRAME
1140 is provided, then the ordering is for that frame. If the second arg
1141 is t, then the global ordering is returned.
1142
1143 Note: In FSF Emacs, this function takes two arguments: BUFFER and
1144 VISIBLE-OK.
1145 */ )
1146 (buffer, frame, visible_ok)
1147 Lisp_Object buffer, frame, visible_ok;
1148 {
1149 /* This function can GC */
1150 Lisp_Object tail, buf, notsogood, tem;
1151 Lisp_Object alist;
1152
1153 notsogood = Qnil;
1154
1155 if (EQ (frame, Qt))
1156 alist = Vbuffer_alist;
1157 else
1158 {
1159 struct frame *f = decode_frame (frame);
1160
1161 XSETFRAME (frame, f);
1162 alist = f->buffer_alist;
1163 }
1164
1165 for (tail = alist; !NILP (tail); tail = Fcdr (tail))
1166 {
1167 buf = Fcdr (Fcar (tail));
1168 if (EQ (buf, buffer))
1169 continue;
1170 if (string_byte (XSTRING (XBUFFER (buf)->name), 0) == ' ')
1171 continue;
1172 /* If FRAME has a buffer_predicate,
1173 disregard buffers that don't fit the predicate. */
1174 if (FRAMEP (frame))
1175 {
1176 tem = XFRAME (frame)->buffer_predicate;
1177 if (!NILP (tem))
1178 {
1179 tem = call1 (tem, buf);
1180 if (NILP (tem))
1181 continue;
1182 }
1183 }
1184
1185 if (NILP (visible_ok))
1186 {
1187 /* get-buffer-window will handle nil or t frame */
1188 tem = Fget_buffer_window (buf, frame, Qnil);
1189 }
1190 else
1191 tem = Qnil;
1192 if (NILP (tem))
1193 return buf;
1194 if (NILP (notsogood))
1195 notsogood = buf;
1196 }
1197 if (!NILP (notsogood))
1198 return notsogood;
1199 return Fget_buffer_create (QSscratch);
1200 }
1201
1202 /* XEmacs change: Make this argument required because this is a dangerous
1203 function. */
1204 DEFUN ("buffer-disable-undo", Fbuffer_disable_undo, Sbuffer_disable_undo, 1, 1, "" /*
1205 Make BUFFER stop keeping undo information.
1206 Any undo records it already has are discarded.
1207 */ )
1208 (buffer)
1209 Lisp_Object buffer;
1210 {
1211 /* Allowing nil is an RMSism */
1212 struct buffer *real_buf = decode_buffer (buffer, 1);
1213 real_buf->undo_list = Qt;
1214 return Qnil;
1215 }
1216
1217 DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, Sbuffer_enable_undo,
1218 0, 1, "" /*
1219 Start keeping undo information for buffer BUFFER.
1220 No argument or nil as argument means do this for the current buffer.
1221 */ )
1222 (buffer)
1223 Lisp_Object buffer;
1224 {
1225 /* Allowing nil is an RMSism */
1226 struct buffer *real_buf = decode_buffer (buffer, 1);
1227 if (EQ (real_buf->undo_list, Qt))
1228 real_buf->undo_list = Qnil;
1229
1230 return Qnil;
1231 }
1232
1233 DEFUN ("kill-buffer", Fkill_buffer, Skill_buffer, 1, 1, "bKill buffer: " /*
1234 Kill the buffer BUFNAME.
1235 The argument may be a buffer or may be the name of a buffer.
1236 An argument of nil means kill the current buffer.
1237
1238 Value is t if the buffer is actually killed, nil if user says no.
1239
1240 The value of `kill-buffer-hook' (which may be local to that buffer),
1241 if not void, is a list of functions to be called, with no arguments,
1242 before the buffer is actually killed. The buffer to be killed is current
1243 when the hook functions are called.
1244
1245 Any processes that have this buffer as the `process-buffer' are killed
1246 with `delete-process'.
1247 */ )
1248 (bufname)
1249 Lisp_Object bufname;
1250 {
1251 /* This function can GC */
1252 Lisp_Object buf;
1253 REGISTER struct buffer *b;
1254 struct gcpro gcpro1, gcpro2;
1255
1256 if (NILP (bufname))
1257 buf = Fcurrent_buffer ();
1258 else if (BUFFERP (bufname))
1259 buf = bufname;
1260 else
1261 {
1262 buf = get_buffer (bufname, 0);
1263 if (NILP (buf)) nsberror (bufname);
1264 }
1265
1266 b = XBUFFER (buf);
1267
1268 /* OK to delete an already-deleted buffer. */
1269 if (!BUFFER_LIVE_P (b))
1270 return Qnil;
1271
1272 /* Don't kill the minibuffer now current. */
1273 if (EQ (buf, Vminibuffer_zero))
1274 return Qnil;
1275
1276 /* Or the echo area. */
1277 if (EQ (buf, Vecho_area_buffer))
1278 return Qnil;
1279
1280 /* Query if the buffer is still modified. */
1281 if (INTERACTIVE && !NILP (b->filename)
1282 && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b))
1283 {
1284 Lisp_Object killp;
1285 GCPRO2 (buf, bufname);
1286 killp = call1
1287 (Qyes_or_no_p,
1288 (emacs_doprnt_string_c
1289 ((CONST Bufbyte *) GETTEXT ("Buffer %s modified; kill anyway? "),
1290 Qnil, -1, string_data (XSTRING (b->name)))));
1291 UNGCPRO;
1292 if (NILP (killp))
1293 return Qnil;
1294 b = XBUFFER (buf); /* Hypothetical relocating GC. */
1295 }
1296
1297 /* Run hooks with the buffer to be killed temporarily selected,
1298 unless the buffer is already dead (could have been deleted
1299 in the question above).
1300 */
1301 if (BUFFER_LIVE_P (b))
1302 {
1303 int speccount = specpdl_depth ();
1304 Lisp_Object tail = Qnil;
1305
1306 GCPRO2 (buf, tail);
1307 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1308 Fset_buffer (buf);
1309
1310 /* First run the query functions; if any query is answered no,
1311 don't kill the buffer. */
1312 for (tail = Vkill_buffer_query_functions;
1313 !NILP (tail);
1314 tail = Fcdr (tail))
1315 {
1316 if (NILP (call0 (Fcar (tail))))
1317 {
1318 UNGCPRO;
1319 return unbind_to (speccount, Qnil);
1320 }
1321 }
1322
1323 /* Then run the hooks. */
1324 run_hook (Qkill_buffer_hook);
1325 #ifdef HAVE_X_WINDOWS
1326 /* If an X selection was in this buffer, disown it.
1327 We could have done this by simply adding this function to the
1328 kill-buffer-hook, but the user might mess that up.
1329 */
1330 if (EQ (Vwindow_system, Qx))
1331 call0 (intern ("xselect-kill-buffer-hook"));
1332 /* #### generalize me! */
1333 #endif
1334 unbind_to (speccount, Qnil);
1335 UNGCPRO;
1336 b = XBUFFER (buf); /* Hypothetical relocating GC. */
1337 }
1338
1339 /* We have no more questions to ask. Verify that it is valid
1340 to kill the buffer. This must be done after the questions
1341 since anything can happen within yes-or-no-p. */
1342
1343 /* Don't kill the minibuffer now current. */
1344 if (EQ (buf, XWINDOW (minibuf_window)->buffer))
1345 return Qnil;
1346
1347 /* Might have been deleted during the last question above */
1348 if (!BUFFER_LIVE_P (b))
1349 return Qnil;
1350
1351 /* When we kill a base buffer, kill all its indirect buffers.
1352 We do it at this stage so nothing terrible happens if they
1353 ask questions or their hooks get errors. */
1354 if (! b->base_buffer)
1355 {
1356 Lisp_Object rest;
1357
1358 GCPRO1 (buf);
1359
1360 LIST_LOOP (rest, b->indirect_children)
1361 Fkill_buffer (XCAR (rest));
1362
1363 UNGCPRO;
1364 }
1365
1366 /* Make this buffer not be current.
1367 In the process, notice if this is the sole visible buffer
1368 and give up if so. */
1369 if (b == current_buffer)
1370 {
1371 Fset_buffer (Fother_buffer (buf, Qnil, Qnil));
1372 if (b == current_buffer)
1373 return Qnil;
1374 }
1375
1376 /* Now there is no question: we can kill the buffer. */
1377
1378 #ifdef CLASH_DETECTION
1379 /* Unlock this buffer's file, if it is locked. */
1380 unlock_buffer (b);
1381 #endif /* CLASH_DETECTION */
1382
1383 {
1384 int speccount = specpdl_depth ();
1385 specbind (Qinhibit_quit, Qt);
1386
1387 kill_buffer_processes (buf);
1388
1389 /* #### This is a problem if this buffer is in a dedicated window.
1390 Need to undedicate any windows of this buffer first (and delete them?)
1391 */
1392 Freplace_buffer_in_windows (buf);
1393
1394 delete_from_buffer_alist (buf);
1395
1396 font_lock_buffer_was_killed (b);
1397
1398 /* Delete any auto-save file, if we saved it in this session. */
1399 if (STRINGP (b->auto_save_file_name)
1400 && b->auto_save_modified != 0
1401 && BUF_SAVE_MODIFF (b) < b->auto_save_modified)
1402 {
1403 if (!NILP (Vdelete_auto_save_files))
1404 internal_delete_file (b->auto_save_file_name);
1405 }
1406
1407 uninit_buffer_markers (b);
1408
1409 kill_buffer_local_variables (b);
1410
1411 b->name = Qnil;
1412 uninit_buffer_text (b, !!b->base_buffer);
1413 b->undo_list = Qnil;
1414 uninit_buffer_extents (b);
1415 if (b->base_buffer)
1416 {
1417 #ifdef ERROR_CHECK_BUFPOS
1418 assert (!NILP (memq_no_quit (buf, b->base_buffer->indirect_children)));
1419 #endif
1420 b->base_buffer->indirect_children =
1421 delq_no_quit (buf, b->base_buffer->indirect_children);
1422 }
1423
1424 /* Clear away all Lisp objects, so that they
1425 won't be protected from GC. */
1426 nuke_all_buffer_slots (b, Qnil);
1427
1428 unbind_to (speccount, Qnil);
1429 }
1430 return Qt;
1431 }
1432
1433 DEFUN ("record-buffer", Frecord_buffer,
1434 Srecord_buffer, 1, 1, 0 /*
1435 Put the element for buffer BUF at the front of buffer-alist.
1436 This is done when a buffer is selected \"visibly\".
1437 It keeps buffer-alist in the order of recency of selection
1438 so that other-buffer will return something nice.
1439 */ )
1440 (buf)
1441 Lisp_Object buf;
1442 {
1443 REGISTER Lisp_Object lynk, prev;
1444 struct frame *f = selected_frame ();
1445
1446 prev = Qnil;
1447 for (lynk = Vbuffer_alist; CONSP (lynk); lynk = XCDR (lynk))
1448 {
1449 if (EQ (XCDR (XCAR (lynk)), buf))
1450 break;
1451 prev = lynk;
1452 }
1453 /* Effectively do Vbuffer_alist = delq_no_quit (lynk, Vbuffer_alist) */
1454 if (NILP (prev))
1455 Vbuffer_alist = XCDR (Vbuffer_alist);
1456 else
1457 XCDR (prev) = XCDR (XCDR (prev));
1458 XCDR (lynk) = Vbuffer_alist;
1459 Vbuffer_alist = lynk;
1460
1461 /* That was the global one. Now do the same thing for the
1462 per-frame buffer-alist. */
1463 prev = Qnil;
1464 for (lynk = f->buffer_alist; CONSP (lynk); lynk = XCDR (lynk))
1465 {
1466 if (EQ (XCDR (XCAR (lynk)), buf))
1467 break;
1468 prev = lynk;
1469 }
1470 /* Effectively do f->buffer_alist = delq_no_quit (lynk, f->buffer_alist) */
1471 if (NILP (prev))
1472 f->buffer_alist = XCDR (f->buffer_alist);
1473 else
1474 XCDR (prev) = XCDR (XCDR (prev));
1475 XCDR (lynk) = f->buffer_alist;
1476 f->buffer_alist = lynk;
1477 return Qnil;
1478 }
1479
1480 DEFUN ("set-buffer-major-mode", Fset_buffer_major_mode,
1481 Sset_buffer_major_mode, 1, 1, 0 /*
1482 Set an appropriate major mode for BUFFER, according to `default-major-mode'.
1483 Use this function before selecting the buffer, since it may need to inspect
1484 the current buffer's major mode.
1485 */ )
1486 (buf)
1487 Lisp_Object buf;
1488 {
1489 int speccount = specpdl_depth ();
1490 REGISTER Lisp_Object function, tem;
1491
1492 function = XBUFFER (Vbuffer_defaults)->major_mode;
1493 if (NILP (function))
1494 {
1495 tem = Fget (current_buffer->major_mode, Qmode_class, Qnil);
1496 if (NILP (tem))
1497 function = current_buffer->major_mode;
1498 }
1499
1500 if (NILP (function) || EQ (function, Qfundamental_mode))
1501 return Qnil;
1502
1503 /* To select a nonfundamental mode,
1504 select the buffer temporarily and then call the mode function. */
1505
1506 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
1507
1508 Fset_buffer (buf);
1509 call0 (function);
1510
1511 return unbind_to (speccount, Qnil);
1512 }
1513
1514 void
1515 switch_to_buffer (Lisp_Object bufname, Lisp_Object norecord)
1516 {
1517 call2 (Qswitch_to_buffer, bufname, norecord);
1518 }
1519
1520
1521 DEFUN ("current-buffer", Fcurrent_buffer, Scurrent_buffer, 0, 0, 0 /*
1522 Return the current buffer as a Lisp object.
1523 */ )
1524 ()
1525 {
1526 Lisp_Object buf;
1527 XSETBUFFER (buf, current_buffer);
1528 return buf;
1529 }
1530
1531 /* Set the current buffer to B. */
1532
1533 void
1534 set_buffer_internal (struct buffer *b)
1535 {
1536 REGISTER struct buffer *old_buf;
1537 REGISTER Lisp_Object tail;
1538
1539 if (current_buffer == b)
1540 return;
1541
1542 INVALIDATE_PIXEL_TO_GLYPH_CACHE;
1543
1544 old_buf = current_buffer;
1545 current_buffer = b;
1546 invalidate_current_column (); /* invalidate indentation cache */
1547
1548 #ifdef HAVE_FEP
1549 if (!noninteractive && initialized)
1550 {
1551 extern Lisp_Object Ffep_force_on (), Ffep_force_off (), Ffep_get_mode ();
1552
1553 old_buf->fep_mode = Ffep_get_mode ();
1554
1555 if (!NILP (current_buffer->fep_mode))
1556 Ffep_force_on ();
1557 else
1558 Ffep_force_off ();
1559 }
1560 #endif
1561
1562 if (old_buf)
1563 {
1564 /* Put the undo list back in the base buffer, so that it appears
1565 that an indirect buffer shares the undo list of its base. */
1566 if (old_buf->base_buffer)
1567 old_buf->base_buffer->undo_list = old_buf->undo_list;
1568 }
1569
1570 /* Get the undo list from the base buffer, so that it appears
1571 that an indirect buffer shares the undo list of its base. */
1572 if (b->base_buffer)
1573 b->undo_list = b->base_buffer->undo_list;
1574
1575 /* Look down buffer's list of local Lisp variables
1576 to find and update any that forward into C variables. */
1577
1578 LIST_LOOP (tail, b->local_var_alist)
1579 {
1580 Lisp_Object sym = XCAR (XCAR (tail));
1581 Lisp_Object valcontents = XSYMBOL (sym)->value;
1582 if (SYMBOL_VALUE_MAGIC_P (valcontents))
1583 {
1584 /* Just reference the variable
1585 to cause it to become set for this buffer. */
1586 (void) find_symbol_value (sym);
1587 }
1588 }
1589
1590 /* Do the same with any others that were local to the previous buffer */
1591
1592 if (old_buf)
1593 {
1594 for (tail = old_buf->local_var_alist;
1595 !NILP (tail);
1596 tail = XCDR (tail))
1597 {
1598 Lisp_Object sym = XCAR (XCAR (tail));
1599 Lisp_Object valcontents = XSYMBOL (sym)->value;
1600
1601 if (SYMBOL_VALUE_MAGIC_P (valcontents))
1602 {
1603 /* Just reference the variable
1604 to cause it to become set for this buffer. */
1605 (void) find_symbol_value (sym);
1606 }
1607 }
1608 }
1609 }
1610
1611 DEFUN ("set-buffer", Fset_buffer, Sset_buffer, 1, 1, 0 /*
1612 Make the buffer BUFNAME current for editing operations.
1613 BUFNAME may be a buffer or the name of an existing buffer.
1614 See also `save-excursion' when you want to make a buffer current temporarily.
1615 This function does not display the buffer, so its effect ends
1616 when the current command terminates.
1617 Use `switch-to-buffer' or `pop-to-buffer' to switch buffers permanently.
1618 */ )
1619 (bufname)
1620 Lisp_Object bufname;
1621 {
1622 Lisp_Object buffer;
1623 buffer = get_buffer (bufname, 0);
1624 if (NILP (buffer))
1625 error ("Selecting deleted or non-existent buffer");
1626 set_buffer_internal (XBUFFER (buffer));
1627 return buffer;
1628 }
1629
1630
1631 DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only,
1632 Sbarf_if_buffer_read_only, 0, 3, 0 /*
1633 Signal a `buffer-read-only' error if the buffer is read-only.
1634 Optional argument BUFFER defaults to the current buffer.
1635
1636 If optional argument START is non-nil, all extents in the buffer
1637 which overlap that part of the buffer are checked to ensure none has a
1638 `read-only' property. (Extents that lie completely within the range,
1639 however, are not checked.) END defaults to the value of START.
1640
1641 If START and END are equal, the range checked is [START, END] (i.e.
1642 closed on both ends); otherwise, the range checked is (START, END)
1643 (open on both ends), except that extents that lie completely within
1644 [START, END] are not checked. See `extent-in-region-p' for a fuller
1645 discussion.
1646 */ )
1647 (buffer, start, end)
1648 Lisp_Object buffer, start, end;
1649 {
1650 struct buffer *b = decode_buffer (buffer, 0);
1651 Bufpos s, e;
1652
1653 if (NILP (start))
1654 s = e = -1;
1655 else
1656 {
1657 if (NILP (end))
1658 end = start;
1659 get_buffer_range_char (b, start, end, &s, &e, 0);
1660 }
1661 barf_if_buffer_read_only (b, s, e);
1662
1663 return (Qnil);
1664 }
1665
1666 static void
1667 bury_buffer_1 (Lisp_Object buffer, Lisp_Object before,
1668 Lisp_Object *buffer_alist)
1669 {
1670 Lisp_Object aelt = rassq_no_quit (buffer, *buffer_alist);
1671 Lisp_Object lynk = memq_no_quit (aelt, *buffer_alist);
1672 Lisp_Object iter, before_before;
1673
1674 *buffer_alist = delq_no_quit (aelt, *buffer_alist);
1675 for (before_before = Qnil, iter = *buffer_alist;
1676 !NILP (iter) && !EQ (XCDR (XCAR (iter)), before);
1677 before_before = iter, iter = XCDR (iter))
1678 ;
1679 XCDR (lynk) = iter;
1680 if (!NILP (before_before))
1681 XCDR (before_before) = lynk;
1682 else
1683 *buffer_alist = lynk;
1684 }
1685
1686 DEFUN ("bury-buffer", Fbury_buffer, Sbury_buffer, 0, 2, "" /*
1687 Put BUFFER at the end of the list of all buffers.
1688 There it is the least likely candidate for `other-buffer' to return;
1689 thus, the least likely buffer for \\[switch-to-buffer] to select by default.
1690 If BUFFER is nil or omitted, bury the current buffer.
1691 Also, if BUFFER is nil or omitted, remove the current buffer from the
1692 selected window if it is displayed there.
1693 If BEFORE is non-nil, it specifies a buffer before which BUFFER
1694 will be placed, instead of being placed at the end.
1695 */ )
1696 (buffer, before)
1697 Lisp_Object buffer, before;
1698 {
1699 /* This function can GC */
1700 struct buffer *buf = decode_buffer (buffer, 1);
1701 /* If we're burying the current buffer, unshow it. */
1702 /* Note that the behavior of (bury-buffer nil) and
1703 (bury-buffer (current-buffer)) is not the same.
1704 This is illogical but is historical. Changing it
1705 breaks mh-e and TeX and such packages. */
1706 if (NILP (buffer))
1707 switch_to_buffer (Fother_buffer (Fcurrent_buffer (), Qnil, Qnil), Qnil);
1708 XSETBUFFER (buffer, buf);
1709
1710 if (!NILP (before))
1711 before = get_buffer (before, 1);
1712
1713 if (EQ (before, buffer))
1714 error ("Cannot place a buffer before itself");
1715
1716 bury_buffer_1 (buffer, before, &Vbuffer_alist);
1717 bury_buffer_1 (buffer, before, &selected_frame ()->buffer_alist);
1718
1719 return Qnil;
1720 }
1721
1722
1723 DEFUN ("erase-buffer", Ferase_buffer, Serase_buffer, 0, 1, "*" /*
1724 Delete the entire contents of the BUFFER.
1725 Any clipping restriction in effect (see `narrow-to-region') is removed,
1726 so the buffer is truly empty after this.
1727 BUFFER defaults to the current buffer if omitted.
1728 */ )
1729 (buffer)
1730 Lisp_Object buffer;
1731 {
1732 /* This function can GC */
1733 struct buffer *b = decode_buffer (buffer, 1);
1734 /* #### yuck yuck yuck. This is gross. The old echo-area code,
1735 however, was the only place that called erase_buffer() with a
1736 non-zero NO_CLIP argument.
1737
1738 Someone needs to fix up the redisplay code so it is smarter
1739 about this, so that the NO_CLIP junk isn't necessary. */
1740 int no_clip = (b == XBUFFER (Vecho_area_buffer));
1741
1742 INVALIDATE_PIXEL_TO_GLYPH_CACHE;
1743
1744 widen_buffer (b, no_clip);
1745 buffer_delete_range (b, BUF_BEG (b), BUF_Z (b), 0);
1746 b->last_window_start = 1;
1747
1748 /* Prevent warnings, or suspension of auto saving, that would happen
1749 if future size is less than past size. Use of erase-buffer
1750 implies that the future text is not really related to the past text. */
1751 b->save_length = Qzero;
1752
1753 zmacs_region_stays = 0;
1754 return Qnil;
1755 }
1756
1757
1758
1759 DEFUN ("kill-all-local-variables", Fkill_all_local_variables,
1760 Skill_all_local_variables, 0, 0, 0 /*
1761 Switch to Fundamental mode by killing current buffer's local variables.
1762 Most local variable bindings are eliminated so that the default values
1763 become effective once more. Also, the syntax table is set from
1764 `standard-syntax-table', local keymap is set to nil,
1765 the abbrev table is set from `fundamental-mode-abbrev-table',
1766 and all specifier specifications whose locale is the current buffer
1767 are removed. This function also forces redisplay of the modeline.
1768
1769 Every function to select a new major mode starts by
1770 calling this function.
1771
1772 As a special exception, local variables whose names have
1773 a non-nil `permanent-local' property are not eliminated by this function.
1774
1775 The first thing this function does is run
1776 the normal hook `change-major-mode-hook'.
1777 */ )
1778 ()
1779 {
1780 /* This function can GC */
1781 run_hook (Qchange_major_mode_hook);
1782
1783 reset_buffer_local_variables (current_buffer, 0);
1784
1785 kill_buffer_local_variables (current_buffer);
1786
1787 kill_specifier_buffer_locals (Fcurrent_buffer ());
1788
1789 /* Force modeline redisplay. Useful here because all major mode
1790 commands call this function. */
1791 MARK_MODELINE_CHANGED;
1792
1793 return Qnil;
1794 }
1795
1796 #ifdef MEMORY_USAGE_STATS
1797
1798 struct buffer_stats
1799 {
1800 int text;
1801 int markers;
1802 int extents;
1803 int other;
1804 };
1805
1806 static int
1807 compute_buffer_text_usage (struct buffer *b, struct overhead_stats *ovstats)
1808 {
1809 int malloc_use;
1810 int was_requested;
1811 int gap;
1812
1813 was_requested = b->text->z - 1;
1814 gap = b->text->gap_size;
1815 malloc_use = malloced_storage_size (b->text->beg, was_requested + gap, 0);
1816 ovstats->gap_overhead += gap;
1817 ovstats->was_requested += was_requested;
1818 ovstats->malloc_overhead += malloc_use - (was_requested + gap);
1819 return malloc_use;
1820 }
1821
1822 static void
1823 compute_buffer_usage (struct buffer *b, struct buffer_stats *stats,
1824 struct overhead_stats *ovstats)
1825 {
1826 memset (stats, 0, sizeof (*stats));
1827 stats->other += malloced_storage_size (b, sizeof (struct buffer), ovstats);
1828 stats->text += compute_buffer_text_usage (b, ovstats);
1829 stats->markers += compute_buffer_marker_usage (b, ovstats);
1830 stats->extents += compute_buffer_extent_usage (b, ovstats);
1831 }
1832
1833 DEFUN ("buffer-memory-usage", Fbuffer_memory_usage, Sbuffer_memory_usage,
1834 1, 1, 0 /*
1835 Return stats about the memory usage of buffer BUFFER.
1836 The values returned are in the form an alist of usage types and byte
1837 counts. The byte counts attempt to encompass all the memory used
1838 by the buffer (separate from the memory logically associated with a
1839 buffer or frame), including internal structures and any malloc()
1840 overhead associated with them. In practice, the byte counts are
1841 underestimated because certain memory usage is very hard to determine
1842 (e.g. the amount of memory used inside the Xt library or inside the
1843 X server) and because there is other stuff that might logically
1844 be associated with a window, buffer, or frame (e.g. window configurations,
1845 glyphs) but should not obviously be included in the usage counts.
1846
1847 Multiple slices of the total memory usage may be returned, separated
1848 by a nil. Each slice represents a particular view of the memory, a
1849 particular way of partitioning it into groups. Within a slice, there
1850 is no overlap between the groups of memory, and each slice collectively
1851 represents all the memory concerned.
1852 */ )
1853 (buffer)
1854 Lisp_Object buffer;
1855 {
1856 struct buffer_stats stats;
1857 struct overhead_stats ovstats;
1858
1859 CHECK_BUFFER (buffer); /* dead buffers should be allowed, no? */
1860 memset (&ovstats, 0, sizeof (ovstats));
1861 compute_buffer_usage (XBUFFER (buffer), &stats, &ovstats);
1862
1863 return nconc2 (list4 (Fcons (Qtext, make_int (stats.text)),
1864 Fcons (Qmarkers, make_int (stats.markers)),
1865 Fcons (Qextents, make_int (stats.extents)),
1866 Fcons (Qother, make_int (stats.other))),
1867 list5 (Qnil,
1868 Fcons (Qactually_requested,
1869 make_int (ovstats.was_requested)),
1870 Fcons (Qmalloc_overhead,
1871 make_int (ovstats.malloc_overhead)),
1872 Fcons (Qgap_overhead,
1873 make_int (ovstats.malloc_overhead)),
1874 Fcons (Qdynarr_overhead,
1875 make_int (ovstats.dynarr_overhead))));
1876 }
1877
1878 #endif /* MEMORY_USAGE_STATS */
1879
1880 void
1881 syms_of_buffer (void)
1882 {
1883 defsymbol (&Qbuffer_live_p, "buffer-live-p");
1884 defsymbol (&Qbuffer_or_string_p, "buffer-or-string-p");
1885 defsymbol (&Qmode_class, "mode-class");
1886 defsymbol (&Qrename_auto_save_file, "rename-auto-save-file");
1887 defsymbol (&Qkill_buffer_hook, "kill-buffer-hook");
1888 defsymbol (&Qpermanent_local, "permanent-local");
1889
1890 defsymbol (&Qfirst_change_hook, "first-change-hook");
1891 defsymbol (&Qbefore_change_functions, "before-change-functions");
1892 defsymbol (&Qafter_change_functions, "after-change-functions");
1893
1894 /* #### Obsolete, for compatibility */
1895 defsymbol (&Qbefore_change_function, "before-change-function");
1896 defsymbol (&Qafter_change_function, "after-change-function");
1897
1898 defsymbol (&Qbuffer_file_name, "buffer-file-name");
1899 defsymbol (&Qbuffer_undo_list, "buffer-undo-list");
1900 defsymbol (&Qdefault_directory, "default-directory");
1901
1902 defsymbol (&Qget_file_buffer, "get-file-buffer");
1903 defsymbol (&Qchange_major_mode_hook, "change-major-mode-hook");
1904
1905 defsymbol (&Qfundamental_mode, "fundamental-mode");
1906
1907 defsymbol (&Qfind_file_compare_truenames, "find-file-compare-truenames");
1908
1909 defsymbol (&Qswitch_to_buffer, "switch-to-buffer");
1910
1911 defsubr (&Sbufferp);
1912 defsubr (&Sbuffer_live_p);
1913 defsubr (&Sbuffer_list);
1914 defsubr (&Sdecode_buffer);
1915 defsubr (&Sget_buffer);
1916 defsubr (&Sget_file_buffer);
1917 defsubr (&Sget_buffer_create);
1918 defsubr (&Smake_indirect_buffer);
1919
1920 defsubr (&Sgenerate_new_buffer_name);
1921 defsubr (&Sbuffer_name);
1922 defsubr (&Sbuffer_file_name);
1923 defsubr (&Sbuffer_base_buffer);
1924 defsubr (&Sbuffer_indirect_children);
1925 defsubr (&Sbuffer_local_variables);
1926 defsubr (&Sbuffer_dedicated_frame);
1927 defsubr (&Sset_buffer_dedicated_frame);
1928 defsubr (&Sbuffer_modified_p);
1929 defsubr (&Sset_buffer_modified_p);
1930 defsubr (&Sbuffer_modified_tick);
1931 defsubr (&Srename_buffer);
1932 defsubr (&Sother_buffer);
1933 defsubr (&Sbuffer_disable_undo);
1934 defsubr (&Sbuffer_enable_undo);
1935 defsubr (&Skill_buffer);
1936 defsubr (&Serase_buffer);
1937 defsubr (&Srecord_buffer);
1938 defsubr (&Sset_buffer_major_mode);
1939 defsubr (&Scurrent_buffer);
1940 defsubr (&Sset_buffer);
1941 defsubr (&Sbarf_if_buffer_read_only);
1942 defsubr (&Sbury_buffer);
1943 defsubr (&Skill_all_local_variables);
1944 #ifdef MEMORY_USAGE_STATS
1945 defsubr (&Sbuffer_memory_usage);
1946 #endif
1947
1948 deferror (&Qprotected_field, "protected-field",
1949 "Attempt to modify a protected field", Qerror);
1950 }
1951
1952 /* initialize the buffer routines */
1953 void
1954 vars_of_buffer (void)
1955 {
1956 /* This function can GC */
1957 staticpro (&QSFundamental);
1958 staticpro (&QSscratch);
1959 staticpro (&Vbuffer_alist);
1960
1961 QSFundamental = Fpurecopy (build_string ("Fundamental"));
1962 QSscratch = Fpurecopy (build_string (DEFER_GETTEXT ("*scratch*")));
1963
1964 Vbuffer_alist = Qnil;
1965 current_buffer = 0;
1966
1967 DEFVAR_LISP ("change-major-mode-hook", &Vchange_major_mode_hook /*
1968 List of hooks to be run before killing local variables in a buffer.
1969 This should be used by by any mode that temporarily alters the contents or
1970 the read-only state of the buffer. See also `kill-all-local-variables'.
1971 */ );
1972 Vchange_major_mode_hook = Qnil;
1973
1974 DEFVAR_BOOL ("find-file-compare-truenames", &find_file_compare_truenames /*
1975 If this is true, then the find-file command will check the truenames
1976 of all visited files when deciding whether a given file is already in
1977 a buffer, instead of just the buffer-file-name. This means that if you
1978 attempt to visit another file which is a symbolic-link to a file which is
1979 already in a buffer, the existing buffer will be found instead of a newly-
1980 created one. This works if any component of the pathname (including a non-
1981 terminal component) is a symbolic link as well, but doesn't work with hard
1982 links (nothing does).
1983
1984 See also the variable find-file-use-truenames.
1985 */ );
1986 find_file_compare_truenames = 0;
1987
1988 DEFVAR_BOOL ("find-file-use-truenames", &find_file_use_truenames /*
1989 If this is true, then a buffer's visited file-name will always be
1990 chased back to the real file; it will never be a symbolic link, and there
1991 will never be a symbolic link anywhere in its directory path.
1992 That is, the buffer-file-name and buffer-file-truename will be equal.
1993 This doesn't work with hard links.
1994
1995 See also the variable find-file-compare-truenames.
1996 */ );
1997 find_file_use_truenames = 0;
1998
1999 DEFVAR_LISP ("before-change-functions", &Vbefore_change_functions /*
2000 List of functions to call before each text change.
2001 Two arguments are passed to each function: the positions of
2002 the beginning and end of the range of old text to be changed.
2003 \(For an insertion, the beginning and end are at the same place.)
2004 No information is given about the length of the text after the change.
2005
2006 Buffer changes made while executing the `before-change-functions'
2007 don't call any before-change or after-change functions.
2008 */ );
2009 Vbefore_change_functions = Qnil;
2010
2011 /* FSF Emacs has the following additional doc at the end of
2012 before-change-functions and after-change-functions:
2013
2014 That's because these variables are temporarily set to nil.\n\
2015 As a result, a hook function cannot straightforwardly alter the value of\n\
2016 these variables. See the Emacs Lisp manual for a way of\n\
2017 accomplishing an equivalent result by using other variables.
2018
2019 But this doesn't apply under XEmacs because things are
2020 handled better. */
2021
2022 DEFVAR_LISP ("after-change-functions", &Vafter_change_functions /*
2023 List of functions to call after each text change.
2024 Three arguments are passed to each function: the positions of
2025 the beginning and end of the range of changed text,
2026 and the length of the pre-change text replaced by that range.
2027 \(For an insertion, the pre-change length is zero;
2028 for a deletion, that length is the number of characters deleted,
2029 and the post-change beginning and end are at the same place.)
2030
2031 Buffer changes made while executing `after-change-functions'
2032 don't call any before-change or after-change functions.
2033 */ );
2034 Vafter_change_functions = Qnil;
2035
2036 DEFVAR_LISP ("before-change-function", &Vbefore_change_function /*
2037
2038 */ ); /* obsoleteness will be documented */
2039 Vbefore_change_function = Qnil;
2040
2041 DEFVAR_LISP ("after-change-function", &Vafter_change_function /*
2042
2043 */ ); /* obsoleteness will be documented */
2044 Vafter_change_function = Qnil;
2045
2046 DEFVAR_LISP ("first-change-hook", &Vfirst_change_hook /*
2047 A list of functions to call before changing a buffer which is unmodified.
2048 The functions are run using the `run-hooks' function.
2049 */ );
2050 Vfirst_change_hook = Qnil;
2051
2052 #if 0 /* FSFmacs */
2053 xxDEFVAR_LISP ("transient-mark-mode", &Vtransient_mark_mode /*
2054 *Non-nil means deactivate the mark when the buffer contents change.
2055 */ );
2056 Vtransient_mark_mode = Qnil;
2057 #endif
2058
2059 DEFVAR_INT ("undo-threshold", &undo_threshold /*
2060 Keep no more undo information once it exceeds this size.
2061 This threshold is applied when garbage collection happens.
2062 The size is counted as the number of bytes occupied,
2063 which includes both saved text and other data.
2064 */ );
2065 undo_threshold = 20000;
2066
2067 DEFVAR_INT ("undo-high-threshold", &undo_high_threshold /*
2068 Don't keep more than this much size of undo information.
2069 A command which pushes past this size is itself forgotten.
2070 This threshold is applied when garbage collection happens.
2071 The size is counted as the number of bytes occupied,
2072 which includes both saved text and other data.
2073 */ );
2074 undo_high_threshold = 30000;
2075
2076 DEFVAR_LISP ("inhibit-read-only", &Vinhibit_read_only /*
2077 *Non-nil means disregard read-only status of buffers or characters.
2078 If the value is t, disregard `buffer-read-only' and all `read-only'
2079 text properties. If the value is a list, disregard `buffer-read-only'
2080 and disregard a `read-only' extent property or text property if the
2081 property value is a member of the list.
2082 */ );
2083 Vinhibit_read_only = Qnil;
2084
2085 DEFVAR_LISP ("kill-buffer-query-functions", &Vkill_buffer_query_functions /*
2086 List of functions called with no args to query before killing a buffer.
2087 */ );
2088 Vkill_buffer_query_functions = Qnil;
2089
2090 DEFVAR_LISP ("delete-auto-save-files", &Vdelete_auto_save_files /*
2091 *Non-nil means delete auto-save file when a buffer is saved or killed.
2092 */ );
2093 Vdelete_auto_save_files = Qt;
2094 }
2095
2096 /* DOC is ignored because it is snagged and recorded externally
2097 * by make-docfile */
2098 /* Renamed from DEFVAR_PER_BUFFER because FSFmacs D_P_B takes
2099 * a bogus extra arg, which confuses an otherwise identical make-docfile.c */
2100 /* Declaring this stuff as const produces 'Cannot reinitialize' messages
2101 from SunPro C's fix-and-continue feature (a way neato feature that
2102 makes debugging unbelievably more bearable) */
2103 #define DEFVAR_BUFFER_LOCAL(lname, field_name) \
2104 do { static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \
2105 = { { { { lrecord_symbol_value_forward }, \
2106 (void *) &(buffer_local_flags.field_name), 69 }, \
2107 SYMVAL_CURRENT_BUFFER_FORWARD }, 0 }; \
2108 defvar_buffer_local ((lname), &I_hate_C); \
2109 } while (0)
2110
2111 #define DEFVAR_BUFFER_LOCAL_MAGIC(lname, field_name, magicfun) \
2112 do { static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \
2113 = { { { { lrecord_symbol_value_forward }, \
2114 (void *) &(buffer_local_flags.field_name), 69 }, \
2115 SYMVAL_CURRENT_BUFFER_FORWARD }, magicfun }; \
2116 defvar_buffer_local ((lname), &I_hate_C); \
2117 } while (0)
2118
2119 #define DEFVAR_CONST_BUFFER_LOCAL(lname, field_name) \
2120 do { static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \
2121 = { { { { lrecord_symbol_value_forward }, \
2122 (void *) &(buffer_local_flags.field_name), 69 }, \
2123 SYMVAL_CONST_CURRENT_BUFFER_FORWARD }, 0 }; \
2124 defvar_buffer_local ((lname), &I_hate_C); \
2125 } while (0)
2126
2127 #define DEFVAR_CONST_BUFFER_LOCAL_MAGIC(lname, field_name, magicfun) \
2128 do { static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \
2129 = { { { { lrecord_symbol_value_forward }, \
2130 (void *) &(buffer_local_flags.field_name), 69 }, \
2131 SYMVAL_CONST_CURRENT_BUFFER_FORWARD }, magicfun }; \
2132 defvar_buffer_local ((lname), &I_hate_C); \
2133 } while (0)
2134
2135 static void
2136 defvar_buffer_local (CONST char *namestring,
2137 CONST struct symbol_value_forward *m)
2138 {
2139 int offset = ((char *)symbol_value_forward_forward (m)
2140 - (char *)&buffer_local_flags);
2141
2142 defvar_mumble (namestring, m, sizeof (*m));
2143
2144 *((Lisp_Object *)(offset + (char *)XBUFFER (Vbuffer_local_symbols)))
2145 = intern (namestring);
2146 }
2147
2148 /* DOC is ignored because it is snagged and recorded externally
2149 * by make-docfile */
2150 #define DEFVAR_BUFFER_DEFAULTS(lname, field_name) \
2151 do { static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \
2152 = { { { { lrecord_symbol_value_forward }, \
2153 (void *) &(buffer_local_flags.field_name), 69 }, \
2154 SYMVAL_DEFAULT_BUFFER_FORWARD }, 0 }; \
2155 defvar_mumble ((lname), &I_hate_C, sizeof (I_hate_C)); \
2156 } while (0)
2157
2158 #define DEFVAR_BUFFER_DEFAULTS_MAGIC(lname, field_name, magicfun) \
2159 do { static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \
2160 = { { { { lrecord_symbol_value_forward }, \
2161 (void *) &(buffer_local_flags.field_name), 69 }, \
2162 SYMVAL_DEFAULT_BUFFER_FORWARD }, magicfun }; \
2163 defvar_mumble ((lname), &I_hate_C, sizeof (I_hate_C)); \
2164 } while (0)
2165
2166 static void
2167 nuke_all_buffer_slots (struct buffer *b, Lisp_Object zap)
2168 {
2169 zero_lcrecord (b);
2170
2171 #define MARKED_SLOT(x) b->x = (zap);
2172 #include "bufslots.h"
2173 #undef MARKED_SLOT
2174 }
2175
2176 void
2177 complex_vars_of_buffer (void)
2178 {
2179 /* Make sure all markable slots in buffer_defaults
2180 are initialized reasonably, so mark_buffer won't choke.
2181 */
2182 struct buffer *defs = alloc_lcrecord (sizeof (struct buffer),
2183 lrecord_buffer);
2184 struct buffer *syms = alloc_lcrecord (sizeof (struct buffer),
2185 lrecord_buffer);
2186
2187 staticpro (&Vbuffer_defaults);
2188 staticpro (&Vbuffer_local_symbols);
2189 XSETBUFFER (Vbuffer_defaults, defs);
2190 XSETBUFFER (Vbuffer_local_symbols, syms);
2191
2192 nuke_all_buffer_slots (syms, Qnil);
2193 nuke_all_buffer_slots (defs, Qnil);
2194 defs->text = &defs->own_text;
2195 syms->text = &syms->own_text;
2196
2197 /* Set up the non-nil default values of various buffer slots.
2198 Must do these before making the first buffer.
2199 */
2200 defs->major_mode = Qfundamental_mode;
2201 defs->mode_name = QSFundamental;
2202 defs->abbrev_table = Qnil; /* real default setup by Lisp code */
2203 defs->downcase_table = Vascii_downcase_table;
2204 defs->upcase_table = Vascii_upcase_table;
2205 defs->case_canon_table = Vascii_canon_table;
2206 defs->case_eqv_table = Vascii_eqv_table;
2207 defs->syntax_table = Vstandard_syntax_table;
2208
2209 defs->modeline_format = build_string ("%-"); /* reset in loaddefs.el */
2210 defs->case_fold_search = Qt;
2211 defs->selective_display_ellipses = Qt;
2212 defs->tab_width = make_int (8);
2213 defs->ctl_arrow = Qt;
2214 defs->fill_column = make_int (70);
2215 defs->left_margin = Qzero;
2216 defs->save_length = Qzero; /* lisp code wants int-or-nil */
2217 defs->modtime = 0;
2218 defs->auto_save_modified = 0;
2219 defs->auto_save_failure_time = -1;
2220 defs->invisibility_spec = Qt;
2221
2222 {
2223 /* 0 means var is always local. Default used only at creation.
2224 * -1 means var is always local. Default used only at reset and
2225 * creation.
2226 * -2 means there's no lisp variable corresponding to this slot
2227 * and the default is only used at creation.
2228 * -3 means no Lisp variable. Default used only at reset and creation.
2229 * >0 is mask. Var is local if ((buffer->local_var_flags & mask) != 0)
2230 * Otherwise default is used.
2231 */
2232 Lisp_Object always_local_no_default = make_int (0);
2233 Lisp_Object always_local_resettable = make_int (-1);
2234 Lisp_Object resettable = make_int (-3);
2235
2236 /* Assign the local-flags to the slots that have default values.
2237 The local flag is a bit that is used in the buffer
2238 to say that it has its own local value for the slot.
2239 The local flag bits are in the local_var_flags slot of the
2240 buffer. */
2241
2242 nuke_all_buffer_slots (&buffer_local_flags, make_int (-2));
2243 buffer_local_flags.filename = always_local_no_default;
2244 buffer_local_flags.directory = always_local_no_default;
2245 buffer_local_flags.backed_up = always_local_no_default;
2246 buffer_local_flags.save_length = always_local_no_default;
2247 buffer_local_flags.auto_save_file_name = always_local_no_default;
2248 buffer_local_flags.read_only = always_local_no_default;
2249
2250 buffer_local_flags.major_mode = always_local_resettable;
2251 buffer_local_flags.mode_name = always_local_resettable;
2252 buffer_local_flags.undo_list = always_local_no_default;
2253 #if 0 /* FSFmacs */
2254 buffer_local_flags.mark_active = always_local_resettable;
2255 #endif
2256 buffer_local_flags.point_before_scroll = always_local_resettable;
2257 buffer_local_flags.file_truename = always_local_no_default;
2258 buffer_local_flags.invisibility_spec = always_local_resettable;
2259 buffer_local_flags.file_format = always_local_resettable;
2260 buffer_local_flags.generated_modeline_string = always_local_no_default;
2261
2262 buffer_local_flags.keymap = resettable;
2263 buffer_local_flags.downcase_table = resettable;
2264 buffer_local_flags.upcase_table = resettable;
2265 buffer_local_flags.case_canon_table = resettable;
2266 buffer_local_flags.case_eqv_table = resettable;
2267 buffer_local_flags.syntax_table = resettable;
2268
2269 buffer_local_flags.modeline_format = make_int (1);
2270 buffer_local_flags.abbrev_mode = make_int (2);
2271 buffer_local_flags.overwrite_mode = make_int (4);
2272 buffer_local_flags.case_fold_search = make_int (8);
2273 buffer_local_flags.auto_fill_function = make_int (0x10);
2274 buffer_local_flags.selective_display = make_int (0x20);
2275 buffer_local_flags.selective_display_ellipses = make_int (0x40);
2276 buffer_local_flags.tab_width = make_int (0x80);
2277 buffer_local_flags.truncate_lines = make_int (0x100);
2278 buffer_local_flags.ctl_arrow = make_int (0x200);
2279 buffer_local_flags.fill_column = make_int (0x400);
2280 buffer_local_flags.left_margin = make_int (0x800);
2281 buffer_local_flags.abbrev_table = make_int (0x1000);
2282 #ifdef REGION_CACHE_NEEDS_WORK
2283 buffer_local_flags.cache_long_line_scans = make_int (0x2000);
2284 #endif
2285 buffer_local_flags.buffer_file_type = make_int (0x4000);
2286
2287 /* #### Warning, 0x4000000 (that's six zeroes) is the largest number
2288 currently allowable due to the XINT() handling of this value.
2289 With some rearrangement you can get 4 more bits. */
2290 }
2291
2292 DEFVAR_BUFFER_DEFAULTS ("default-modeline-format", modeline_format /*
2293 Default value of `modeline-format' for buffers that don't override it.
2294 This is the same as (default-value 'modeline-format).
2295 */ );
2296
2297 DEFVAR_BUFFER_DEFAULTS ("default-abbrev-mode", abbrev_mode /*
2298 Default value of `abbrev-mode' for buffers that do not override it.
2299 This is the same as (default-value 'abbrev-mode).
2300 */ );
2301
2302 DEFVAR_BUFFER_DEFAULTS ("default-ctl-arrow", ctl_arrow /*
2303 Default value of `ctl-arrow' for buffers that do not override it.
2304 This is the same as (default-value 'ctl-arrow).
2305 */ );
2306
2307 #if 0 /* #### make this a specifier! */
2308 DEFVAR_BUFFER_DEFAULTS ("default-display-direction", display_direction /*
2309 Default display-direction for buffers that do not override it.
2310 This is the same as (default-value 'display-direction).
2311 Note: This is not yet implemented.
2312 */ );
2313 #endif
2314
2315 DEFVAR_BUFFER_DEFAULTS ("default-truncate-lines", truncate_lines /*
2316 Default value of `truncate-lines' for buffers that do not override it.
2317 This is the same as (default-value 'truncate-lines).
2318 */ );
2319
2320 DEFVAR_BUFFER_DEFAULTS ("default-fill-column", fill_column /*
2321 Default value of `fill-column' for buffers that do not override it.
2322 This is the same as (default-value 'fill-column).
2323 */ );
2324
2325 DEFVAR_BUFFER_DEFAULTS ("default-left-margin", left_margin /*
2326 Default value of `left-margin' for buffers that do not override it.
2327 This is the same as (default-value 'left-margin).
2328 */ );
2329
2330 DEFVAR_BUFFER_DEFAULTS ("default-tab-width", tab_width /*
2331 Default value of `tab-width' for buffers that do not override it.
2332 This is the same as (default-value 'tab-width).
2333 */ );
2334
2335 DEFVAR_BUFFER_DEFAULTS ("default-case-fold-search", case_fold_search /*
2336 Default value of `case-fold-search' for buffers that don't override it.
2337 This is the same as (default-value 'case-fold-search).
2338 */ );
2339
2340 DEFVAR_BUFFER_DEFAULTS ("default-buffer-file-type", buffer_file_type /*
2341 Default file type for buffers that do not override it.
2342 This is the same as (default-value 'buffer-file-type).
2343 The file type is nil for text, t for binary.
2344 */ );
2345
2346 DEFVAR_BUFFER_LOCAL ("modeline-format", modeline_format /*
2347 Template for displaying modeline for current buffer.
2348 Each buffer has its own value of this variable.
2349 Value may be a string, a symbol or a list or cons cell.
2350 For a symbol, its value is used (but it is ignored if t or nil).
2351 A string appearing directly as the value of a symbol is processed verbatim
2352 in that the %-constructs below are not recognized.
2353 For a glyph, it is inserted as is.
2354 For a list whose car is a symbol, the symbol's value is taken,
2355 and if that is non-nil, the cadr of the list is processed recursively.
2356 Otherwise, the caddr of the list (if there is one) is processed.
2357 For a list whose car is a string or list, each element is processed
2358 recursively and the results are effectively concatenated.
2359 For a list whose car is an integer, the cdr of the list is processed
2360 and padded (if the number is positive) or truncated (if negative)
2361 to the width specified by that number.
2362 For a list whose car is an extent, the cdr of the list is processed
2363 normally but the results are displayed using the face of the
2364 extent, and mouse clicks over this section are processed using the
2365 keymap of the extent. (In addition, if the extent has a help-echo
2366 property, that string will be echoed when the mouse moves over this
2367 section.) See `generated-modeline-string' for more information.
2368 For a list whose car is a face, the cdr of the list is processed
2369 normally but the results will be displayed using the face in the car.
2370 For a list whose car is a keymap, the cdr of the list is processed
2371 normally but the keymap will apply for mouse clicks over the results,
2372 in addition to `modeline-map'. Nested keymap specifications are
2373 handled properly.
2374 A string is printed verbatim in the modeline except for %-constructs:
2375 (%-constructs are processed when the string is the entire modeline-format
2376 or when it is found in a cons-cell or a list)
2377 %b -- print buffer name. %c -- print the current column number.
2378 %f -- print visited file name.
2379 %* -- print %, * or hyphen. %+ -- print *, % or hyphen.
2380 % means buffer is read-only and * means it is modified.
2381 For a modified read-only buffer, %* gives % and %+ gives *.
2382 %s -- print process status. %l -- print the current line number.
2383 %S -- print name of selected frame (only meaningful under X Windows).
2384 %p -- print percent of buffer above top of window, or Top, Bot or All.
2385 %P -- print percent of buffer above bottom of window, perhaps plus Top,
2386 or print Bottom or All.
2387 %n -- print Narrow if appropriate.
2388 %t -- Under MS-DOS, print T if files is text, B if binary.
2389 %[ -- print one [ for each recursive editing level. %] similar.
2390 %% -- print %. %- -- print infinitely many dashes.
2391 Decimal digits after the % specify field width to which to pad. */ );
2392
2393 DEFVAR_BUFFER_DEFAULTS ("default-major-mode", major_mode /*
2394 *Major mode for new buffers. Defaults to `fundamental-mode'.
2395 nil here means use current buffer's major mode.
2396 */ );
2397
2398 DEFVAR_BUFFER_DEFAULTS ("fundamental-mode-abbrev-table", abbrev_table /*
2399 The abbrev table of mode-specific abbrevs for Fundamental Mode.
2400 */ );
2401
2402 DEFVAR_BUFFER_LOCAL ("major-mode", major_mode /*
2403 Symbol for current buffer's major mode.
2404 */ );
2405
2406 DEFVAR_BUFFER_LOCAL ("mode-name", mode_name /*
2407 Pretty name of current buffer's major mode (a string).
2408 */ );
2409
2410 DEFVAR_BUFFER_LOCAL ("abbrev-mode", abbrev_mode /*
2411 Non-nil turns on automatic expansion of abbrevs as they are inserted.
2412 Automatically becomes buffer-local when set in any fashion.
2413 */ );
2414
2415 DEFVAR_BUFFER_LOCAL ("case-fold-search", case_fold_search /*
2416 *Non-nil if searches should ignore case.
2417 Automatically becomes buffer-local when set in any fashion.
2418 */ );
2419
2420 DEFVAR_BUFFER_LOCAL ("fill-column", fill_column /*
2421 *Column beyond which automatic line-wrapping should happen.
2422 Automatically becomes buffer-local when set in any fashion.
2423 */ );
2424
2425 DEFVAR_BUFFER_LOCAL ("left-margin", left_margin /*
2426 *Column for the default indent-line-function to indent to.
2427 Linefeed indents to this column in Fundamental mode.
2428 Automatically becomes buffer-local when set in any fashion.
2429 Do not confuse this with the specifier `left-margin-width';
2430 that controls the size of a margin that is displayed outside
2431 of the text area.
2432 */ );
2433
2434 DEFVAR_BUFFER_LOCAL_MAGIC ("tab-width", tab_width /*
2435 *Distance between tab stops (for display of tab characters), in columns.
2436 Automatically becomes buffer-local when set in any fashion.
2437 */ , redisplay_variable_changed);
2438
2439 DEFVAR_BUFFER_LOCAL_MAGIC ("ctl-arrow", ctl_arrow /*
2440 *Non-nil means display control chars with uparrow.
2441 Nil means use backslash and octal digits.
2442 An integer means characters >= ctl-arrow are assumed to be printable, and
2443 will be displayed as a single glyph.
2444 Any other value is the same as 160 - the code SPC with the high bit on.
2445
2446 The interpretation of this variable is likely to change in the future.
2447
2448 Automatically becomes buffer-local when set in any fashion.
2449 This variable does not apply to characters whose display is specified
2450 in the current display table (if there is one).
2451 */ , redisplay_variable_changed);
2452
2453 #if 0 /* #### Make this a specifier! */
2454 xxDEFVAR_BUFFER_LOCAL ("display-direction", display_direction /*
2455 *Non-nil means lines in the buffer are displayed right to left.
2456 Nil means left to right. (Not yet implemented.)
2457 */ );
2458 #endif
2459
2460 DEFVAR_BUFFER_LOCAL_MAGIC ("truncate-lines", truncate_lines /*
2461 *Non-nil means do not display continuation lines;
2462 give each line of text one frame line.
2463 Automatically becomes buffer-local when set in any fashion.
2464
2465 Note that this is overridden by the variable
2466 `truncate-partial-width-windows' if that variable is non-nil
2467 and this buffer is not full-frame width.
2468 */ ,
2469 redisplay_variable_changed);
2470
2471 DEFVAR_BUFFER_LOCAL ("default-directory", directory /*
2472 Name of default directory of current buffer. Should end with slash.
2473 Each buffer has its own value of this variable.
2474 */ );
2475
2476 DEFVAR_BUFFER_LOCAL ("buffer-file-type", buffer_file_type /*
2477 "Non-nil if the visited file is a binary file.
2478 This variable is meaningful on MS-DOG and Windows NT.
2479 On those systems, it is automatically local in every buffer.
2480 On other systems, this variable is normally always nil.
2481 */ );
2482
2483 DEFVAR_BUFFER_LOCAL ("auto-fill-function", auto_fill_function /*
2484 Function called (if non-nil) to perform auto-fill.
2485 It is called after self-inserting a space at a column beyond `fill-column'.
2486 Each buffer has its own value of this variable.
2487 NOTE: This variable is not an ordinary hook;
2488 It may not be a list of functions.
2489 */ );
2490
2491 DEFVAR_BUFFER_LOCAL ("buffer-file-name", filename /*
2492 Name of file visited in current buffer, or nil if not visiting a file.
2493 Each buffer has its own value of this variable.
2494 */ );
2495
2496 #if 0 /* FSFmacs */
2497 /*
2498 Abbreviated truename of file visited in current buffer, or nil if none.
2499 The truename of a file is calculated by `file-truename'
2500 and then abbreviated with `abbreviate-file-name'.
2501 Each buffer has its own value of this variable.
2502 */
2503 #endif /* FSFmacs */
2504
2505 DEFVAR_BUFFER_LOCAL ("buffer-file-truename", file_truename /*
2506 The real name of the file visited in the current buffer,
2507 or nil if not visiting a file. This is the result of passing
2508 buffer-file-name to the `file-truename' function. Every buffer has
2509 its own value of this variable. This variable is automatically
2510 maintained by the functions that change the file name associated
2511 with a buffer.
2512 */ );
2513
2514 DEFVAR_BUFFER_LOCAL ("buffer-auto-save-file-name", auto_save_file_name /*
2515 Name of file for auto-saving current buffer,
2516 or nil if buffer should not be auto-saved.
2517 Each buffer has its own value of this variable.
2518 */ );
2519
2520 DEFVAR_BUFFER_LOCAL ("buffer-read-only", read_only /*
2521 Non-nil if this buffer is read-only.
2522 Each buffer has its own value of this variable.
2523 */ );
2524
2525 DEFVAR_BUFFER_LOCAL ("buffer-backed-up", backed_up /*
2526 Non-nil if this buffer's file has been backed up.
2527 Backing up is done before the first time the file is saved.
2528 Each buffer has its own value of this variable.
2529 */ );
2530
2531 DEFVAR_BUFFER_LOCAL ("buffer-saved-size", save_length /*
2532 Length of current buffer when last read in, saved or auto-saved.
2533 0 initially.
2534 Each buffer has its own value of this variable.
2535 */ );
2536
2537 DEFVAR_BUFFER_LOCAL_MAGIC ("selective-display", selective_display /*
2538 Non-nil enables selective display:
2539 Integer N as value means display only lines
2540 that start with less than n columns of space.
2541 A value of t means, after a ^M, all the rest of the line is invisible.
2542 Then ^M's in the file are written into files as newlines.
2543
2544 Automatically becomes buffer-local when set in any fashion.
2545 */, redisplay_variable_changed);
2546
2547 #ifndef old
2548 DEFVAR_BUFFER_LOCAL_MAGIC ("selective-display-ellipses",
2549 selective_display_ellipses /*
2550 t means display ... on previous line when a line is invisible.
2551 Automatically becomes buffer-local when set in any fashion.
2552 */, redisplay_variable_changed);
2553 #endif
2554
2555 DEFVAR_BUFFER_LOCAL ("local-abbrev-table", abbrev_table /*
2556 Local (mode-specific) abbrev table of current buffer.
2557 */ );
2558
2559 DEFVAR_BUFFER_LOCAL ("overwrite-mode", overwrite_mode /*
2560 Non-nil if self-insertion should replace existing text.
2561 The value should be one of `overwrite-mode-textual',
2562 `overwrite-mode-binary', or nil.
2563 If it is `overwrite-mode-textual', self-insertion still
2564 inserts at the end of a line, and inserts when point is before a tab,
2565 until the tab is filled in.
2566 If `overwrite-mode-binary', self-insertion replaces newlines and tabs too.
2567 Automatically becomes buffer-local when set in any fashion.
2568 */ );
2569
2570 #if 0 /* FSFmacs */
2571 /* Adds the following to the doc string for buffer-undo-list:
2572
2573 An entry (nil PROPERTY VALUE BEG . END) indicates that a text property
2574 was modified between BEG and END. PROPERTY is the property name,
2575 and VALUE is the old value.
2576 */
2577 #endif
2578
2579 DEFVAR_BUFFER_LOCAL ("buffer-undo-list", undo_list /*
2580 List of undo entries in current buffer.
2581 Recent changes come first; older changes follow newer.
2582
2583 An entry (BEG . END) represents an insertion which begins at
2584 position BEG and ends at position END.
2585
2586 An entry (TEXT . POSITION) represents the deletion of the string TEXT
2587 from (abs POSITION). If POSITION is positive, point was at the front
2588 of the text being deleted; if negative, point was at the end.
2589
2590 An entry (t HIGH . LOW) indicates that the buffer previously had
2591 \"unmodified\" status. HIGH and LOW are the high and low 16-bit portions
2592 of the visited file's modification time, as of that time. If the
2593 modification time of the most recent save is different, this entry is
2594 obsolete.
2595
2596 An entry of the form EXTENT indicates that EXTENT was attached in
2597 the buffer. Undoing an entry of this form detaches EXTENT.
2598
2599 An entry of the form (EXTENT START END) indicates that EXTENT was
2600 detached from the buffer. Undoing an entry of this form attaches
2601 EXTENT from START to END.
2602
2603 An entry of the form POSITION indicates that point was at the buffer
2604 location given by the integer. Undoing an entry of this form places
2605 point at POSITION.
2606
2607 nil marks undo boundaries. The undo command treats the changes
2608 between two undo boundaries as a single step to be undone.
2609
2610 If the value of the variable is t, undo information is not recorded.
2611 */ );
2612
2613 #if 0 /* FSFmacs */
2614 xxDEFVAR_BUFFER_LOCAL ("mark-active", mark_active /*
2615 Non-nil means the mark and region are currently active in this buffer.
2616 Automatically local in all buffers.
2617 */ );
2618 #endif
2619
2620 #ifdef REGION_CACHE_NEEDS_WORK
2621 xxDEFVAR_BUFFER_LOCAL ("cache-long-line-scans", cache_long_line_scans /*
2622 Non-nil means that Emacs should use caches to handle long lines more quickly.
2623 This variable is buffer-local, in all buffers.
2624
2625 Normally, the line-motion functions work by scanning the buffer for
2626 newlines. Columnar operations (like move-to-column and
2627 compute-motion) also work by scanning the buffer, summing character
2628 widths as they go. This works well for ordinary text, but if the
2629 buffer's lines are very long (say, more than 500 characters), these
2630 motion functions will take longer to execute. Emacs may also take
2631 longer to update the display.
2632
2633 If cache-long-line-scans is non-nil, these motion functions cache the
2634 results of their scans, and consult the cache to avoid rescanning
2635 regions of the buffer until the text is modified. The caches are most
2636 beneficial when they prevent the most searching---that is, when the
2637 buffer contains long lines and large regions of characters with the
2638 same, fixed screen width.
2639
2640 When cache-long-line-scans is non-nil, processing short lines will
2641 become slightly slower (because of the overhead of consulting the
2642 cache), and the caches will use memory roughly proportional to the
2643 number of newlines and characters whose screen width varies.
2644
2645 The caches require no explicit maintenance; their accuracy is
2646 maintained internally by the Emacs primitives. Enabling or disabling
2647 the cache should not affect the behavior of any of the motion
2648 functions; it should only affect their performance.
2649 */ );
2650 #endif /* REGION_CACHE_NEEDS_WORK */
2651
2652 DEFVAR_BUFFER_LOCAL ("point-before-scroll", point_before_scroll /*
2653 Value of point before the last series of scroll operations, or nil.
2654 */ );
2655
2656 DEFVAR_BUFFER_LOCAL ("buffer-file-format", file_format /*
2657 List of formats to use when saving this buffer.
2658 Formats are defined by `format-alist'. This variable is
2659 set when a file is visited. Automatically local in all buffers.
2660 */ );
2661
2662 DEFVAR_BUFFER_LOCAL_MAGIC ("buffer-invisibility-spec", invisibility_spec /*
2663 Invisibility spec of this buffer.
2664 The default is t, which means that text is invisible
2665 if it has (or is covered by an extent with) a non-nil `invisible' property.
2666 If the value is a list, a text character is invisible if its `invisible'
2667 property is an element in that list.
2668 If an element is a cons cell of the form (PROP . ELLIPSIS),
2669 then characters with property value PROP are invisible,
2670 and they have an ellipsis as well if ELLIPSIS is non-nil.
2671 Note that the actual characters used for the ellipsis are controllable
2672 using `invisible-text-glyph', and default to \"...\".
2673 */, redisplay_variable_changed);
2674
2675 DEFVAR_CONST_BUFFER_LOCAL ("generated-modeline-string",
2676 generated_modeline_string /*
2677 String of characters in this buffer's modeline as of the last redisplay.
2678 Each time the modeline is recomputed, the resulting characters are
2679 stored in this string, which is resized as necessary. You may not
2680 set this variable, and modifying this string will not change the
2681 modeline; you have to change `modeline-format' if you want that.
2682
2683 For each extent in `modeline-format' that is encountered when
2684 processing the modeline, a corresponding extent is placed in
2685 `generated-modeline-string' and covers the text over which the
2686 extent in `modeline-format' applies. The extent in
2687 `generated-modeline-string' is made a child of the extent in
2688 `modeline-format', which means that it inherits all properties from
2689 that extent. Note that the extents in `generated-modeline-string'
2690 are managed automatically. You should not explicitly put any extents
2691 in `generated-modeline-string'; if you do, they will disappear the
2692 next time the modeline is processed.
2693
2694 For extents in `modeline-format', the following properties are currently
2695 handled:
2696
2697 `face'
2698 Affects the face of the modeline text. Currently, faces do
2699 not merge properly; only the most recently encountered face
2700 is used. This is a bug.
2701
2702 `keymap'
2703 Affects the disposition of button events over the modeline
2704 text. Multiple applicable keymaps *are* handled properly,
2705 and `modeline-map' still applies to any events that don't
2706 have bindings in extent-specific keymaps.
2707
2708 `help-echo'
2709 If a string, causes the string to be displayed when the mouse
2710 moves over the text.
2711 */ );
2712
2713 /* Check for DEFVAR_BUFFER_LOCAL without initializing the corresponding
2714 slot of buffer_local_flags and vice-versa. Must be done after all
2715 DEFVAR_BUFFER_LOCAL() calls. */
2716 #define MARKED_SLOT(slot) \
2717 if ((XINT (buffer_local_flags.slot) != -2 && \
2718 XINT (buffer_local_flags.slot) != -3) \
2719 != !(NILP (XBUFFER (Vbuffer_local_symbols)->slot))) \
2720 abort ()
2721 #include "bufslots.h"
2722 #undef MARKED_SLOT
2723
2724 Vprin1_to_string_buffer
2725 = Fget_buffer_create (Fpurecopy (build_string (" prin1")));
2726 /* Reset Vbuffer_alist again so that the above buf is magically
2727 invisible */
2728 Vbuffer_alist = Qnil;
2729 /* Want no undo records for prin1_to_string_buffer */
2730 Fbuffer_disable_undo (Vprin1_to_string_buffer);
2731
2732 {
2733 Lisp_Object scratch =
2734 Fset_buffer (Fget_buffer_create (QSscratch));
2735 /* Want no undo records for *scratch* until after Emacs is dumped */
2736 Fbuffer_disable_undo (scratch);
2737 }
2738 }
2739
2740 void
2741 init_buffer (void)
2742 {
2743 /* This function can GC */
2744 char buf[MAXPATHLEN+1];
2745 char *pwd;
2746 struct stat dotstat, pwdstat;
2747 int rc;
2748
2749 buf[0] = 0;
2750
2751 Fset_buffer (Fget_buffer_create (QSscratch));
2752
2753 /* If PWD is accurate, use it instead of calling getwd. This is faster
2754 when PWD is right, and may avoid a fatal error. */
2755 if ((pwd = getenv ("PWD")) != 0 && IS_DIRECTORY_SEP (*pwd)
2756 && stat (pwd, &pwdstat) == 0
2757 && stat (".", &dotstat) == 0
2758 && dotstat.st_ino == pwdstat.st_ino
2759 && dotstat.st_dev == pwdstat.st_dev
2760 && (int) strlen (pwd) < MAXPATHLEN)
2761 strcpy (buf, pwd);
2762 else if (getwd (buf) == 0)
2763 fatal ("`getwd' failed: %s\n", buf);
2764
2765 #ifndef VMS
2766 /* Maybe this should really use some standard subroutine
2767 whose definition is filename syntax dependent. */
2768 rc = strlen (buf);
2769 if (!(IS_DIRECTORY_SEP (buf[rc - 1])))
2770 {
2771 buf[rc] = DIRECTORY_SEP;
2772 buf[rc + 1] = '\0';
2773 }
2774 #endif /* not VMS */
2775 current_buffer->directory = build_string (buf);
2776
2777 #if 0 /* FSFmacs */
2778 /* #### is this correct? */
2779 temp = get_minibuffer (0);
2780 XBUFFER (temp)->directory = current_buffer->directory;
2781 #endif
2782 }