comparison src/buffer.c @ 428:3ecd8885ac67 r21-2-22

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