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