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