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