eb440de5ac70f8bb0e9b090f83267cdf5d480bba
[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 "select.h"     /* for select_notify_buffer_kill */
88 #include "specifier.h"
89 #include "syntax.h"
90 #include "sysdep.h"     /* for getwd */
91 #include "window.h"
92
93 #include "sysfile.h"
94
95 struct buffer *current_buffer;  /* the current buffer */
96
97 /* This structure holds the default values of the buffer-local variables
98    defined with DEFVAR_BUFFER_LOCAL, that have special slots in each buffer.
99    The default value occupies the same slot in this structure
100    as an individual buffer's value occupies in that buffer.
101    Setting the default value also goes through the alist of buffers
102    and stores into each buffer that does not say it has a local value.  */
103 Lisp_Object Vbuffer_defaults;
104 static void *buffer_defaults_saved_slots;
105
106 /* This structure marks which slots in a buffer have corresponding
107    default values in Vbuffer_defaults.
108    Each such slot has a nonzero value in this structure.
109    The value has only one nonzero bit.
110
111    When a buffer has its own local value for a slot,
112    the bit for that slot (found in the same slot in this structure)
113    is turned on in the buffer's local_var_flags slot.
114
115    If a slot in this structure is 0, then there is a DEFVAR_BUFFER_LOCAL
116    for the slot, but there is no default value for it; the corresponding
117    slot in Vbuffer_defaults is not used except to initialize newly-created
118    buffers.
119
120    If a slot is -1, then there is a DEFVAR_BUFFER_LOCAL for it
121    as well as a default value which is used to initialize newly-created
122    buffers and as a reset-value when local-vars are killed.
123
124    If a slot is -2, there is no DEFVAR_BUFFER_LOCAL for it.
125    (The slot is always local, but there's no lisp variable for it.)
126    The default value is only used to initialize newly-creation buffers.
127
128    If a slot is -3, then there is no DEFVAR_BUFFER_LOCAL for it but
129    there is a default which is used to initialize newly-creation
130    buffers and as a reset-value when local-vars are killed.  */
131 struct buffer buffer_local_flags;
132
133 /* This is the initial (startup) directory, as used for the *scratch* buffer.
134    We're making this a global to make others aware of the startup directory.
135    `initial_directory' is stored in external format.
136  */
137 char initial_directory[MAXPATHLEN+1];
138
139 /* This structure holds the names of symbols whose values may be
140    buffer-local.  It is indexed and accessed in the same way as the above. */
141 static Lisp_Object Vbuffer_local_symbols;
142 static void *buffer_local_symbols_saved_slots;
143
144 /* Alist of all buffer names vs the buffers. */
145 /* This used to be a variable, but is no longer,
146    to prevent lossage due to user rplac'ing this alist or its elements.
147    Note that there is a per-frame copy of this as well; the frame slot
148    and the global variable contain the same data, but possibly in different
149    orders, so that the buffer ordering can be per-frame.
150   */
151 Lisp_Object Vbuffer_alist;
152
153 /* Functions to call before and after each text change. */
154 Lisp_Object Qbefore_change_functions;
155 Lisp_Object Qafter_change_functions;
156 Lisp_Object Vbefore_change_functions;
157 Lisp_Object Vafter_change_functions;
158
159 /* #### Obsolete, for compatibility */
160 Lisp_Object Qbefore_change_function;
161 Lisp_Object Qafter_change_function;
162 Lisp_Object Vbefore_change_function;
163 Lisp_Object Vafter_change_function;
164
165 #if 0 /* FSFmacs */
166 Lisp_Object Vtransient_mark_mode;
167 #endif
168
169 /* t means ignore all read-only text properties.
170    A list means ignore such a property if its value is a member of the list.
171    Any non-nil value means ignore buffer-read-only.  */
172 Lisp_Object Vinhibit_read_only;
173
174 /* List of functions to call that can query about killing a buffer.
175    If any of these functions returns nil, we don't kill it.  */
176 Lisp_Object Vkill_buffer_query_functions;
177
178 /* Non-nil means delete a buffer's auto-save file when the buffer is saved. */
179 int delete_auto_save_files;
180
181 Lisp_Object Qbuffer_live_p;
182 Lisp_Object Qbuffer_or_string_p;
183
184 /* List of functions to call before changing an unmodified buffer.  */
185 Lisp_Object Vfirst_change_hook;
186 Lisp_Object Qfirst_change_hook;
187
188 Lisp_Object Qfundamental_mode;
189 Lisp_Object Qmode_class;
190 Lisp_Object Qpermanent_local;
191
192 Lisp_Object Qprotected_field;
193
194 Lisp_Object QSFundamental;      /* A string "Fundamental" */
195 Lisp_Object QSscratch;          /* "*scratch*" */
196 Lisp_Object Qdefault_directory;
197
198 Lisp_Object Qkill_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
1031   if (NILP (current_buffer->filename)
1032       && !NILP (current_buffer->auto_save_file_name))
1033     call0 (Qrename_auto_save_file);
1034   /* refetch since that last call may have done GC */
1035   /* (hypothetical relocating GC) */
1036   return current_buffer->name;
1037 }
1038
1039 DEFUN ("other-buffer", Fother_buffer, 0, 3, 0, /*
1040 Return most recently selected buffer other than BUFFER.
1041 Buffers not visible in windows are preferred to visible buffers,
1042 unless optional third argument VISIBLE-OK is non-nil.
1043 If no other buffer exists, the buffer `*scratch*' is returned.
1044 If BUFFER is omitted or nil, some interesting buffer is returned.
1045
1046 The ordering is for this frame; If second optional argument FRAME
1047 is provided, then the ordering is for that frame.  If the second arg
1048 is t, then the global ordering is returned.
1049
1050 Note: In FSF Emacs, this function takes two arguments: BUFFER and
1051 VISIBLE-OK.
1052 */
1053        (buffer, frame, visible_ok))
1054 {
1055   /* This function can GC */
1056   Lisp_Object tail, buf, notsogood, tem;
1057   Lisp_Object alist;
1058
1059   notsogood = Qnil;
1060
1061   if (EQ (frame, Qt))
1062     alist = Vbuffer_alist;
1063   else
1064     {
1065       struct frame *f = decode_frame (frame);
1066
1067       XSETFRAME (frame, f);
1068       alist = f->buffer_alist;
1069     }
1070
1071   for (tail = alist; !NILP (tail); tail = Fcdr (tail))
1072     {
1073       buf = Fcdr (Fcar (tail));
1074       if (EQ (buf, buffer))
1075         continue;
1076       if (string_byte (XSTRING (XBUFFER (buf)->name), 0) == ' ')
1077         continue;
1078       /* If FRAME has a buffer_predicate,
1079          disregard buffers that don't fit the predicate.  */
1080       if (FRAMEP (frame))
1081         {
1082           tem = XFRAME (frame)->buffer_predicate;
1083           if (!NILP (tem))
1084             {
1085               tem = call1 (tem, buf);
1086               if (NILP (tem))
1087                 continue;
1088             }
1089         }
1090
1091       if (NILP (visible_ok))
1092         {
1093           /* get-buffer-window will handle nil or t frame */
1094           tem = Fget_buffer_window (buf, frame, Qnil);
1095         }
1096       else
1097         tem = Qnil;
1098       if (NILP (tem))
1099         return buf;
1100       if (NILP (notsogood))
1101         notsogood = buf;
1102     }
1103   if (!NILP (notsogood))
1104     return notsogood;
1105   return Fget_buffer_create (QSscratch);
1106 }
1107 \f
1108 DEFUN ("buffer-disable-undo", Fbuffer_disable_undo, 0, 1, "", /*
1109 Make BUFFER stop keeping undo information.
1110 Any undo records it already has are discarded.
1111 No argument or nil as argument means do this for the current buffer.
1112 */
1113        (buffer))
1114 {
1115   /* Allowing nil is an RMSism */
1116   struct buffer *real_buf = decode_buffer (buffer, 1);
1117   real_buf->undo_list = Qt;
1118   return Qnil;
1119 }
1120
1121 DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, 0, 1, "", /*
1122 Start keeping undo information for buffer BUFFER.
1123 No argument or nil as argument means do this for the current buffer.
1124 */
1125        (buffer))
1126 {
1127   /* Allowing nil is an RMSism */
1128   struct buffer *real_buf = decode_buffer (buffer, 1);
1129   if (EQ (real_buf->undo_list, Qt))
1130     real_buf->undo_list = Qnil;
1131
1132   return Qnil;
1133 }
1134
1135 DEFUN ("kill-buffer", Fkill_buffer, 1, 1, "bKill buffer: ", /*
1136 Kill the buffer BUFFER.
1137 The argument may be a buffer or may be the name of a buffer.
1138 An argument of nil means kill the current buffer.
1139
1140 Value is t if the buffer is actually killed, nil if user says no.
1141
1142 The value of `kill-buffer-hook' (which may be local to that buffer),
1143 if not void, is a list of functions to be called, with no arguments,
1144 before the buffer is actually killed.  The buffer to be killed is current
1145 when the hook functions are called.
1146
1147 Any processes that have this buffer as the `process-buffer' are killed
1148 with `delete-process'.
1149 */
1150        (buffer))
1151 {
1152   /* This function can call lisp */
1153   Lisp_Object buf;
1154   REGISTER struct buffer *b;
1155   struct gcpro gcpro1, gcpro2;
1156
1157   if (NILP (buffer))
1158     buf = Fcurrent_buffer ();
1159   else if (BUFFERP (buffer))
1160     buf = buffer;
1161   else
1162     {
1163       buf = get_buffer (buffer, 0);
1164       if (NILP (buf)) nsberror (buffer);
1165     }
1166
1167   b = XBUFFER (buf);
1168
1169   /* OK to delete an already-deleted buffer.  */
1170   if (!BUFFER_LIVE_P (b))
1171     return Qnil;
1172
1173   /* Don't kill the minibuffer now current.  */
1174   if (EQ (buf, Vminibuffer_zero))
1175     return Qnil;
1176
1177   /* Or the echo area.  */
1178   if (EQ (buf, Vecho_area_buffer))
1179     return Qnil;
1180
1181   /* Query if the buffer is still modified.  */
1182   if (INTERACTIVE && !NILP (b->filename)
1183       && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b))
1184     {
1185       Lisp_Object killp;
1186       GCPRO1 (buf);
1187       killp = call1
1188         (Qyes_or_no_p,
1189          (emacs_doprnt_string_c
1190           ((const Bufbyte *) GETTEXT ("Buffer %s modified; kill anyway? "),
1191            Qnil, -1, XSTRING_DATA (b->name))));
1192       UNGCPRO;
1193       if (NILP (killp))
1194         return Qnil;
1195       b = XBUFFER (buf);        /* Hypothetical relocating GC. */
1196     }
1197
1198   /* Run hooks with the buffer to be killed temporarily selected,
1199      unless the buffer is already dead (could have been deleted
1200      in the question above).
1201    */
1202   if (BUFFER_LIVE_P (b))
1203     {
1204       int speccount = specpdl_depth ();
1205       Lisp_Object tail = Qnil;
1206
1207       GCPRO2 (buf, tail);
1208       record_unwind_protect (save_excursion_restore, save_excursion_save ());
1209       Fset_buffer (buf);
1210
1211       /* First run the query functions; if any query is answered no,
1212          don't kill the buffer.  */
1213       EXTERNAL_LIST_LOOP (tail, Vkill_buffer_query_functions)
1214         {
1215           if (NILP (call0 (Fcar (tail))))
1216             {
1217               UNGCPRO;
1218               return unbind_to (speccount, Qnil);
1219             }
1220         }
1221
1222       /* Then run the hooks.  */
1223       run_hook (Qkill_buffer_hook);
1224
1225       /* Inform the selection code that a buffer just got killed.
1226          We do this in C because (a) it's faster, and (b) it needs
1227          to access data internal to select.c that can't be seen from
1228          Lisp (so the Lisp code would just call into C anyway. */
1229       select_notify_buffer_kill (buf);
1230       
1231       unbind_to (speccount, Qnil);
1232       UNGCPRO;
1233       b = XBUFFER (buf);        /* Hypothetical relocating GC. */
1234   }
1235
1236   /* We have no more questions to ask.  Verify that it is valid
1237      to kill the buffer.  This must be done after the questions
1238      since anything can happen within yes-or-no-p.  */
1239
1240   /* Might have been deleted during the last question above */
1241   if (!BUFFER_LIVE_P (b))
1242     return Qnil;
1243
1244   /* Don't kill the minibuffer now current.  */
1245   if (EQ (buf, XWINDOW (minibuf_window)->buffer))
1246     return Qnil;
1247
1248   /* When we kill a base buffer, kill all its indirect buffers.
1249      We do it at this stage so nothing terrible happens if they
1250      ask questions or their hooks get errors.  */
1251   if (! b->base_buffer)
1252     {
1253       Lisp_Object rest;
1254
1255       GCPRO1 (buf);
1256
1257       LIST_LOOP (rest, b->indirect_children)
1258         {
1259           Fkill_buffer (XCAR (rest));
1260           /* Keep indirect_children updated in case a
1261              query-function/hook throws.  */
1262           b->indirect_children = XCDR (rest);
1263         }
1264
1265       UNGCPRO;
1266     }
1267
1268   /* Make this buffer not be current.
1269      In the process, notice if this is the sole visible buffer
1270      and give up if so.  */
1271   if (b == current_buffer)
1272     {
1273       Fset_buffer (Fother_buffer (buf, Qnil, Qnil));
1274       if (b == current_buffer)
1275         return Qnil;
1276     }
1277
1278   /* Now there is no question: we can kill the buffer.  */
1279
1280 #ifdef CLASH_DETECTION
1281   /* Unlock this buffer's file, if it is locked.  unlock_buffer
1282      can both GC and kill the current buffer, and wreak general
1283      havok by running lisp code. */
1284   GCPRO1 (buf);
1285   unlock_buffer (b);
1286   UNGCPRO;
1287   b = XBUFFER (buf);
1288
1289   if (!BUFFER_LIVE_P (b))
1290     return Qnil;
1291
1292   if (b == current_buffer)
1293     {
1294       Fset_buffer (Fother_buffer (buf, Qnil, Qnil));
1295       if (b == current_buffer)
1296         return Qnil;
1297     }
1298 #endif /* CLASH_DETECTION */
1299
1300   {
1301     int speccount = specpdl_depth ();
1302     specbind (Qinhibit_quit, Qt);
1303
1304     kill_buffer_processes (buf);
1305
1306     delete_from_buffer_alist (buf);
1307
1308     /* #### This is a problem if this buffer is in a dedicated window.
1309        Need to undedicate any windows of this buffer first (and delete them?)
1310        */
1311     Freplace_buffer_in_windows (buf);
1312
1313     font_lock_buffer_was_killed (b);
1314
1315     /* Delete any auto-save file, if we saved it in this session.  */
1316     if (STRINGP (b->auto_save_file_name)
1317         && b->auto_save_modified != 0
1318         && BUF_SAVE_MODIFF (b) < b->auto_save_modified)
1319       {
1320         if (delete_auto_save_files != 0)
1321           {
1322             /* deleting the auto save file might kill b! */
1323             /* #### dmoore - fix this crap, we do this same gcpro and
1324                buffer liveness check multiple times.  Let's get a
1325                macro or something for it. */
1326             GCPRO1 (buf);
1327             internal_delete_file (b->auto_save_file_name);
1328             UNGCPRO;
1329             b = XBUFFER (buf);
1330
1331             if (!BUFFER_LIVE_P (b))
1332               return Qnil;
1333
1334             if (b == current_buffer)
1335               {
1336                 Fset_buffer (Fother_buffer (buf, Qnil, Qnil));
1337                 if (b == current_buffer)
1338                   return Qnil;
1339               }
1340           }
1341       }
1342
1343     uninit_buffer_markers (b);
1344
1345     kill_buffer_local_variables (b);
1346
1347     b->name = Qnil;
1348     uninit_buffer_text (b);
1349     b->undo_list = Qnil;
1350     uninit_buffer_extents (b);
1351     if (b->base_buffer)
1352       {
1353 #ifdef ERROR_CHECK_BUFPOS
1354         assert (!NILP (memq_no_quit (buf, b->base_buffer->indirect_children)));
1355 #endif
1356         b->base_buffer->indirect_children =
1357           delq_no_quit (buf, b->base_buffer->indirect_children);
1358       }
1359
1360   /* Clear away all Lisp objects, so that they
1361      won't be protected from GC. */
1362     nuke_all_buffer_slots (b, Qnil);
1363
1364     unbind_to (speccount, Qnil);
1365   }
1366   return Qt;
1367 }
1368 \f
1369 DEFUN ("record-buffer", Frecord_buffer, 1, 1, 0, /*
1370 Place buffer BUFFER first in the buffer order.
1371 Call this function when a buffer is selected "visibly".
1372
1373 This function changes the global buffer order and the per-frame buffer
1374 order for the selected frame.  The buffer order keeps track of recency
1375 of selection so that `other-buffer' will return a recently selected
1376 buffer.  See `other-buffer' for more information.
1377 */
1378        (buffer))
1379 {
1380   REGISTER Lisp_Object lynk, prev;
1381   struct frame *f = selected_frame ();
1382
1383   prev = Qnil;
1384   for (lynk = Vbuffer_alist; CONSP (lynk); lynk = XCDR (lynk))
1385     {
1386       if (EQ (XCDR (XCAR (lynk)), buffer))
1387         break;
1388       prev = lynk;
1389     }
1390   /* Effectively do Vbuffer_alist = delq_no_quit (lynk, Vbuffer_alist) */
1391   if (NILP (prev))
1392     Vbuffer_alist = XCDR (Vbuffer_alist);
1393   else
1394     XCDR (prev) = XCDR (XCDR (prev));
1395   XCDR (lynk) = Vbuffer_alist;
1396   Vbuffer_alist = lynk;
1397
1398   /* That was the global one.  Now do the same thing for the
1399      per-frame buffer-alist. */
1400   prev = Qnil;
1401   for (lynk = f->buffer_alist; CONSP (lynk); lynk = XCDR (lynk))
1402     {
1403       if (EQ (XCDR (XCAR (lynk)), buffer))
1404         break;
1405       prev = lynk;
1406     }
1407   /* Effectively do f->buffer_alist = delq_no_quit (lynk, f->buffer_alist) */
1408   if (NILP (prev))
1409     f->buffer_alist = XCDR (f->buffer_alist);
1410   else
1411     XCDR (prev) = XCDR (XCDR (prev));
1412   XCDR (lynk) = f->buffer_alist;
1413   f->buffer_alist = lynk;
1414
1415   return Qnil;
1416 }
1417
1418 DEFUN ("set-buffer-major-mode", Fset_buffer_major_mode, 1, 1, 0, /*
1419 Set an appropriate major mode for BUFFER, according to `default-major-mode'.
1420 Use this function before selecting the buffer, since it may need to inspect
1421 the current buffer's major mode.
1422 */
1423        (buffer))
1424 {
1425   int speccount = specpdl_depth ();
1426   Lisp_Object function = XBUFFER (Vbuffer_defaults)->major_mode;
1427
1428   if (NILP (function))
1429     {
1430       Lisp_Object tem = Fget (current_buffer->major_mode, Qmode_class, Qnil);
1431       if (NILP (tem))
1432         function = current_buffer->major_mode;
1433     }
1434
1435   if (NILP (function) || EQ (function, Qfundamental_mode))
1436     return Qnil;
1437
1438   /* To select a nonfundamental mode,
1439      select the buffer temporarily and then call the mode function. */
1440
1441   record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
1442
1443   Fset_buffer (buffer);
1444   call0 (function);
1445
1446   return unbind_to (speccount, Qnil);
1447 }
1448
1449 void
1450 switch_to_buffer (Lisp_Object bufname, Lisp_Object norecord)
1451 {
1452   call2 (Qswitch_to_buffer, bufname, norecord);
1453 }
1454
1455
1456 DEFUN ("current-buffer", Fcurrent_buffer, 0, 0, 0, /*
1457 Return the current buffer as a Lisp object.
1458 */
1459        ())
1460 {
1461   Lisp_Object buffer;
1462   XSETBUFFER (buffer, current_buffer);
1463   return buffer;
1464 }
1465 \f
1466 /* Set the current buffer to B.  */
1467
1468 void
1469 set_buffer_internal (struct buffer *b)
1470 {
1471   REGISTER struct buffer *old_buf;
1472   REGISTER Lisp_Object tail;
1473
1474   if (current_buffer == b)
1475     return;
1476
1477   INVALIDATE_PIXEL_TO_GLYPH_CACHE;
1478
1479   old_buf = current_buffer;
1480   current_buffer = b;
1481   invalidate_current_column ();   /* invalidate indentation cache */
1482
1483   if (old_buf)
1484     {
1485       /* Put the undo list back in the base buffer, so that it appears
1486          that an indirect buffer shares the undo list of its base.  */
1487       if (old_buf->base_buffer)
1488         old_buf->base_buffer->undo_list = old_buf->undo_list;
1489     }
1490
1491   /* Get the undo list from the base buffer, so that it appears
1492      that an indirect buffer shares the undo list of its base.  */
1493   if (b->base_buffer)
1494     b->undo_list = b->base_buffer->undo_list;
1495
1496   /* Look down buffer's list of local Lisp variables
1497      to find and update any that forward into C variables. */
1498
1499   LIST_LOOP (tail, b->local_var_alist)
1500     {
1501       Lisp_Object sym = XCAR (XCAR (tail));
1502       Lisp_Object valcontents = XSYMBOL (sym)->value;
1503       if (SYMBOL_VALUE_MAGIC_P (valcontents))
1504         {
1505           /* Just reference the variable
1506              to cause it to become set for this buffer.  */
1507           /* Use find_symbol_value_quickly to avoid an unnecessary O(n)
1508              lookup. */
1509           (void) find_symbol_value_quickly (XCAR (tail), 1);
1510         }
1511     }
1512
1513   /* Do the same with any others that were local to the previous buffer */
1514
1515   if (old_buf)
1516     {
1517       LIST_LOOP (tail, old_buf->local_var_alist)
1518         {
1519           Lisp_Object sym = XCAR (XCAR (tail));
1520           Lisp_Object valcontents = XSYMBOL (sym)->value;
1521
1522           if (SYMBOL_VALUE_MAGIC_P (valcontents))
1523             {
1524               /* Just reference the variable
1525                  to cause it to become set for this buffer.  */
1526               /* Use find_symbol_value_quickly with find_it_p as 0 to avoid an
1527                  unnecessary O(n) lookup which is guaranteed to be worst case.
1528                  Any symbols which are local are guaranteed to have been
1529                  handled in the previous loop, above. */
1530               (void) find_symbol_value_quickly (sym, 0);
1531             }
1532         }
1533     }
1534 }
1535
1536 DEFUN ("set-buffer", Fset_buffer, 1, 1, 0, /*
1537 Make the buffer BUFFER current for editing operations.
1538 BUFFER may be a buffer or the name of an existing buffer.
1539 See also `save-excursion' when you want to make a buffer current temporarily.
1540 This function does not display the buffer, so its effect ends
1541 when the current command terminates.
1542 Use `switch-to-buffer' or `pop-to-buffer' to switch buffers permanently.
1543 */
1544        (buffer))
1545 {
1546   buffer = get_buffer (buffer, 0);
1547   if (NILP (buffer))
1548     error ("Selecting deleted or non-existent buffer");
1549   set_buffer_internal (XBUFFER (buffer));
1550   return buffer;
1551 }
1552
1553 \f
1554 DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only, 0, 3, 0, /*
1555 Signal a `buffer-read-only' error if the buffer is read-only.
1556 Optional argument BUFFER defaults to the current buffer.
1557
1558 If optional argument START is non-nil, all extents in the buffer
1559 which overlap that part of the buffer are checked to ensure none has a
1560 `read-only' property. (Extents that lie completely within the range,
1561 however, are not checked.) END defaults to the value of START.
1562
1563 If START and END are equal, the range checked is [START, END] (i.e.
1564 closed on both ends); otherwise, the range checked is (START, END)
1565 \(open on both ends), except that extents that lie completely within
1566 [START, END] are not checked.  See `extent-in-region-p' for a fuller
1567 discussion.
1568 */
1569        (buffer, start, end))
1570 {
1571   struct buffer *b = decode_buffer (buffer, 0);
1572   Bufpos s, e;
1573
1574   if (NILP (start))
1575     s = e = -1;
1576   else
1577     {
1578       if (NILP (end))
1579         end = start;
1580       get_buffer_range_char (b, start, end, &s, &e, 0);
1581     }
1582   barf_if_buffer_read_only (b, s, e);
1583
1584   return Qnil;
1585 }
1586
1587 static void
1588 bury_buffer_1 (Lisp_Object buffer, Lisp_Object before,
1589                Lisp_Object *buffer_alist)
1590 {
1591   Lisp_Object aelt = rassq_no_quit (buffer, *buffer_alist);
1592   Lisp_Object lynk = memq_no_quit (aelt, *buffer_alist);
1593   Lisp_Object iter, before_before;
1594
1595   *buffer_alist = delq_no_quit (aelt, *buffer_alist);
1596   for (before_before = Qnil, iter = *buffer_alist;
1597        !NILP (iter) && !EQ (XCDR (XCAR (iter)), before);
1598        before_before = iter, iter = XCDR (iter))
1599     ;
1600   XCDR (lynk) = iter;
1601   if (!NILP (before_before))
1602     XCDR (before_before) = lynk;
1603   else
1604     *buffer_alist = lynk;
1605 }
1606
1607 DEFUN ("bury-buffer", Fbury_buffer, 0, 2, "", /*
1608 Put BUFFER at the end of the list of all buffers.
1609 There it is the least likely candidate for `other-buffer' to return;
1610 thus, the least likely buffer for \\[switch-to-buffer] to select by default.
1611 If BUFFER is nil or omitted, bury the current buffer.
1612 Also, if BUFFER is nil or omitted, remove the current buffer from the
1613 selected window if it is displayed there.
1614 Because of this, you may need to specify (current-buffer) as
1615 BUFFER when calling from minibuffer.
1616 If BEFORE is non-nil, it specifies a buffer before which BUFFER
1617 will be placed, instead of being placed at the end.
1618 */
1619        (buffer, before))
1620 {
1621   /* This function can GC */
1622   struct buffer *buf = decode_buffer (buffer, 1);
1623   /* If we're burying the current buffer, unshow it.  */
1624   /* Note that the behavior of (bury-buffer nil) and
1625      (bury-buffer (current-buffer)) is not the same.
1626      This is illogical but is historical.  Changing it
1627      breaks mh-e and TeX and such packages. */
1628   if (NILP (buffer))
1629     switch_to_buffer (Fother_buffer (Fcurrent_buffer (), Qnil, Qnil), Qnil);
1630   XSETBUFFER (buffer, buf);
1631
1632   if (!NILP (before))
1633     before = get_buffer (before, 1);
1634
1635   if (EQ (before, buffer))
1636     error ("Cannot place a buffer before itself");
1637
1638   bury_buffer_1 (buffer, before, &Vbuffer_alist);
1639   bury_buffer_1 (buffer, before, &selected_frame ()->buffer_alist);
1640
1641   return Qnil;
1642 }
1643
1644 \f
1645 DEFUN ("erase-buffer", Ferase_buffer, 0, 1, "*", /*
1646 Delete the entire contents of the BUFFER.
1647 Any clipping restriction in effect (see `narrow-to-region') is removed,
1648 so the buffer is truly empty after this.
1649 BUFFER defaults to the current buffer if omitted.
1650 */
1651        (buffer))
1652 {
1653   /* This function can GC */
1654   struct buffer *b = decode_buffer (buffer, 1);
1655   /* #### yuck yuck yuck.  This is gross.  The old echo-area code,
1656      however, was the only place that called erase_buffer() with a
1657      non-zero NO_CLIP argument.
1658
1659      Someone needs to fix up the redisplay code so it is smarter
1660      about this, so that the NO_CLIP junk isn't necessary. */
1661   int no_clip = (b == XBUFFER (Vecho_area_buffer));
1662
1663   INVALIDATE_PIXEL_TO_GLYPH_CACHE;
1664
1665   widen_buffer (b, no_clip);
1666   buffer_delete_range (b, BUF_BEG (b), BUF_Z (b), 0);
1667   b->last_window_start = 1;
1668
1669   /* Prevent warnings, or suspension of auto saving, that would happen
1670      if future size is less than past size.  Use of erase-buffer
1671      implies that the future text is not really related to the past text.  */
1672   b->saved_size = Qzero;
1673
1674   zmacs_region_stays = 0;
1675   return Qnil;
1676 }
1677
1678 \f
1679
1680 DEFUN ("kill-all-local-variables", Fkill_all_local_variables, 0, 0, 0, /*
1681 Switch to Fundamental mode by killing current buffer's local variables.
1682 Most local variable bindings are eliminated so that the default values
1683 become effective once more.  Also, the syntax table is set from
1684 `standard-syntax-table', the category table is set from
1685 `standard-category-table' (if support for Mule exists), local keymap is set
1686 to nil, the abbrev table is set from `fundamental-mode-abbrev-table',
1687 and all specifier specifications whose locale is the current buffer
1688 are removed.  This function also forces redisplay of the modeline.
1689
1690 Every function to select a new major mode starts by
1691 calling this function.
1692
1693 As a special exception, local variables whose names have
1694 a non-nil `permanent-local' property are not eliminated by this function.
1695
1696 The first thing this function does is run
1697 the normal hook `change-major-mode-hook'.
1698 */
1699        ())
1700 {
1701   /* This function can GC */
1702   run_hook (Qchange_major_mode_hook);
1703
1704   reset_buffer_local_variables (current_buffer, 0);
1705
1706   kill_buffer_local_variables (current_buffer);
1707
1708   kill_specifier_buffer_locals (Fcurrent_buffer ());
1709
1710   /* Force modeline redisplay.  Useful here because all major mode
1711      commands call this function.  */
1712   MARK_MODELINE_CHANGED;
1713
1714   return Qnil;
1715 }
1716
1717 #ifdef MEMORY_USAGE_STATS
1718
1719 struct buffer_stats
1720 {
1721   int text;
1722   int markers;
1723   int extents;
1724   int other;
1725 };
1726
1727 static size_t
1728 compute_buffer_text_usage (struct buffer *b, struct overhead_stats *ovstats)
1729 {
1730   int was_requested = b->text->z - 1;
1731   size_t gap = b->text->gap_size + b->text->end_gap_size;
1732   size_t malloc_use = malloced_storage_size (b->text->beg, was_requested + gap, 0);
1733
1734   ovstats->gap_overhead    += gap;
1735   ovstats->was_requested   += was_requested;
1736   ovstats->malloc_overhead += malloc_use - (was_requested + gap);
1737   return malloc_use;
1738 }
1739
1740 static void
1741 compute_buffer_usage (struct buffer *b, struct buffer_stats *stats,
1742                       struct overhead_stats *ovstats)
1743 {
1744   xzero (*stats);
1745   stats->other   += malloced_storage_size (b, sizeof (*b), ovstats);
1746   stats->text    += compute_buffer_text_usage   (b, ovstats);
1747   stats->markers += compute_buffer_marker_usage (b, ovstats);
1748   stats->extents += compute_buffer_extent_usage (b, ovstats);
1749 }
1750
1751 DEFUN ("buffer-memory-usage", Fbuffer_memory_usage, 1, 1, 0, /*
1752 Return stats about the memory usage of buffer BUFFER.
1753 The values returned are in the form of an alist of usage types and byte
1754 counts.  The byte counts attempt to encompass all the memory used
1755 by the buffer (separate from the memory logically associated with a
1756 buffer or frame), including internal structures and any malloc()
1757 overhead associated with them.  In practice, the byte counts are
1758 underestimated because certain memory usage is very hard to determine
1759 \(e.g. the amount of memory used inside the Xt library or inside the
1760 X server) and because there is other stuff that might logically
1761 be associated with a window, buffer, or frame (e.g. window configurations,
1762 glyphs) but should not obviously be included in the usage counts.
1763
1764 Multiple slices of the total memory usage may be returned, separated
1765 by a nil.  Each slice represents a particular view of the memory, a
1766 particular way of partitioning it into groups.  Within a slice, there
1767 is no overlap between the groups of memory, and each slice collectively
1768 represents all the memory concerned.
1769 */
1770        (buffer))
1771 {
1772   struct buffer_stats stats;
1773   struct overhead_stats ovstats;
1774   Lisp_Object val = Qnil;
1775
1776   CHECK_BUFFER (buffer); /* dead buffers should be allowed, no? */
1777   xzero (ovstats);
1778   compute_buffer_usage (XBUFFER (buffer), &stats, &ovstats);
1779
1780   val = acons (Qtext,    make_int (stats.text),    val);
1781   val = acons (Qmarkers, make_int (stats.markers), val);
1782   val = acons (Qextents, make_int (stats.extents), val);
1783   val = acons (Qother,   make_int (stats.other),   val);
1784   val = Fcons (Qnil, val);
1785   val = acons (Qactually_requested, make_int (ovstats.was_requested),   val);
1786   val = acons (Qmalloc_overhead,    make_int (ovstats.malloc_overhead), val);
1787   val = acons (Qgap_overhead,       make_int (ovstats.gap_overhead),    val);
1788   val = acons (Qdynarr_overhead,    make_int (ovstats.dynarr_overhead), val);
1789
1790   return Fnreverse (val);
1791 }
1792
1793 #endif /* MEMORY_USAGE_STATS */
1794
1795 \f
1796 /************************************************************************/
1797 /*           Implement TO_EXTERNAL_FORMAT, TO_INTERNAL_FORMAT           */
1798 /************************************************************************/
1799
1800 /* This implementation should probably be elsewhere, but it can't be
1801    in file-coding.c since that file is only available if FILE_CODING
1802    is defined. */
1803 #ifdef FILE_CODING
1804 static int
1805 coding_system_is_binary (Lisp_Object coding_system)
1806 {
1807   Lisp_Coding_System *cs = XCODING_SYSTEM (coding_system);
1808   return
1809     (CODING_SYSTEM_TYPE (cs) == CODESYS_NO_CONVERSION &&
1810      CODING_SYSTEM_EOL_TYPE (cs) == EOL_LF &&
1811      EQ (CODING_SYSTEM_POST_READ_CONVERSION (cs), Qnil) &&
1812      EQ (CODING_SYSTEM_PRE_WRITE_CONVERSION (cs), Qnil));
1813 }
1814 #else
1815 #define coding_system_is_binary(coding_system) 1
1816 #endif
1817
1818 typedef struct
1819 {
1820   Dynarr_declare (Bufbyte_dynarr *);
1821 } Bufbyte_dynarr_dynarr;
1822
1823 typedef struct
1824 {
1825   Dynarr_declare (Extbyte_dynarr *);
1826 } Extbyte_dynarr_dynarr;
1827
1828 static Extbyte_dynarr_dynarr *conversion_out_dynarr_list;
1829 static Bufbyte_dynarr_dynarr *conversion_in_dynarr_list;
1830
1831 static int dfc_convert_to_external_format_in_use;
1832 static int dfc_convert_to_internal_format_in_use;
1833
1834 static Lisp_Object
1835 dfc_convert_to_external_format_reset_in_use (Lisp_Object value)
1836 {
1837   dfc_convert_to_external_format_in_use = XINT (value);
1838   return Qnil;
1839 }
1840
1841 static Lisp_Object
1842 dfc_convert_to_internal_format_reset_in_use (Lisp_Object value)
1843 {
1844   dfc_convert_to_internal_format_in_use = XINT (value);
1845   return Qnil;
1846 }
1847
1848 void
1849 dfc_convert_to_external_format (dfc_conversion_type source_type,
1850                                 dfc_conversion_data *source,
1851 #ifdef FILE_CODING
1852                                 Lisp_Object coding_system,
1853 #endif
1854                                 dfc_conversion_type sink_type,
1855                                 dfc_conversion_data *sink)
1856 {
1857   int count = specpdl_depth ();
1858   Extbyte_dynarr *conversion_out_dynarr;
1859
1860   type_checking_assert
1861     (((source_type == DFC_TYPE_DATA) ||
1862       (source_type == DFC_TYPE_LISP_LSTREAM && LSTREAMP (source->lisp_object)) ||
1863       (source_type == DFC_TYPE_LISP_STRING && STRINGP (source->lisp_object)))
1864      &&
1865      ((sink_type == DFC_TYPE_DATA) ||
1866       (sink_type == DFC_TYPE_LISP_LSTREAM && LSTREAMP (source->lisp_object))));
1867
1868   record_unwind_protect (dfc_convert_to_external_format_reset_in_use,
1869                          make_int (dfc_convert_to_external_format_in_use));
1870   if (Dynarr_length (conversion_out_dynarr_list) <=
1871       dfc_convert_to_external_format_in_use)
1872     Dynarr_add (conversion_out_dynarr_list, Dynarr_new (Extbyte));
1873   conversion_out_dynarr = Dynarr_at (conversion_out_dynarr_list,
1874                                      dfc_convert_to_external_format_in_use);
1875   dfc_convert_to_external_format_in_use++;
1876   Dynarr_reset (conversion_out_dynarr);
1877
1878 #ifdef FILE_CODING
1879   coding_system = Fget_coding_system (coding_system);
1880 #endif
1881
1882   /* Here we optimize in the case where the coding system does no
1883      conversion. However, we don't want to optimize in case the source
1884      or sink is an lstream, since writing to an lstream can cause a
1885      garbage collection, and this could be problematic if the source
1886      is a lisp string. */
1887   if (source_type != DFC_TYPE_LISP_LSTREAM &&
1888       sink_type   != DFC_TYPE_LISP_LSTREAM &&
1889       coding_system_is_binary (coding_system))
1890     {
1891       const Bufbyte *ptr;
1892       Bytecount len;
1893
1894       if (source_type == DFC_TYPE_LISP_STRING)
1895         {
1896           ptr = XSTRING_DATA   (source->lisp_object);
1897           len = XSTRING_LENGTH (source->lisp_object);
1898         }
1899       else
1900         {
1901           ptr = (Bufbyte *) source->data.ptr;
1902           len = source->data.len;
1903         }
1904
1905 #ifdef MULE
1906       {
1907         const Bufbyte *end;
1908         for (end = ptr + len; ptr < end;)
1909           {
1910             Bufbyte c =
1911               (BYTE_ASCII_P (*ptr))                ? *ptr :
1912               (*ptr == LEADING_BYTE_CONTROL_1)     ? (*(ptr+1) - 0x20) :
1913               (*ptr == LEADING_BYTE_LATIN_ISO8859_1) ? (*(ptr+1)) :
1914               '~';
1915
1916             Dynarr_add (conversion_out_dynarr, (Extbyte) c);
1917             INC_CHARPTR (ptr);
1918           }
1919         bufpos_checking_assert (ptr == end);
1920       }
1921 #else
1922       Dynarr_add_many (conversion_out_dynarr, ptr, len);
1923 #endif
1924
1925     }
1926   else
1927     {
1928       Lisp_Object streams_to_delete[3];
1929       int delete_count = 0;
1930       Lisp_Object instream, outstream;
1931       Lstream *reader, *writer;
1932       struct gcpro gcpro1, gcpro2;
1933
1934       if (source_type == DFC_TYPE_LISP_LSTREAM)
1935         instream = source->lisp_object;
1936       else if (source_type == DFC_TYPE_DATA)
1937         streams_to_delete[delete_count++] = instream =
1938           make_fixed_buffer_input_stream (source->data.ptr, source->data.len);
1939       else
1940         {
1941           type_checking_assert (source_type == DFC_TYPE_LISP_STRING);
1942           streams_to_delete[delete_count++] = instream =
1943             make_lisp_string_input_stream (source->lisp_object, 0, -1);
1944         }
1945
1946       if (sink_type == DFC_TYPE_LISP_LSTREAM)
1947         outstream = sink->lisp_object;
1948       else
1949         {
1950           type_checking_assert (sink_type == DFC_TYPE_DATA);
1951           streams_to_delete[delete_count++] = outstream =
1952             make_dynarr_output_stream
1953             ((unsigned_char_dynarr *) conversion_out_dynarr);
1954         }
1955
1956 #ifdef FILE_CODING
1957       streams_to_delete[delete_count++] = outstream =
1958         make_encoding_output_stream (XLSTREAM (outstream), coding_system);
1959 #endif
1960
1961       reader = XLSTREAM (instream);
1962       writer = XLSTREAM (outstream);
1963       /* decoding_stream will gc-protect outstream */
1964       GCPRO2 (instream, outstream);
1965
1966       while (1)
1967         {
1968           ssize_t size_in_bytes;
1969           char tempbuf[1024]; /* some random amount */
1970
1971           size_in_bytes = Lstream_read (reader, tempbuf, sizeof (tempbuf));
1972
1973           if (size_in_bytes == 0)
1974             break;
1975           else if (size_in_bytes < 0)
1976             error ("Error converting to external format");
1977
1978           size_in_bytes = Lstream_write (writer, tempbuf, size_in_bytes);
1979
1980           if (size_in_bytes <= 0)
1981             error ("Error converting to external format");
1982         }
1983
1984       /* Closing writer will close any stream at the other end of writer. */
1985       Lstream_close (writer);
1986       Lstream_close (reader);
1987       UNGCPRO;
1988
1989       /* The idea is that this function will create no garbage. */
1990       while (delete_count)
1991         Lstream_delete (XLSTREAM (streams_to_delete [--delete_count]));
1992     }
1993
1994   unbind_to (count, Qnil);
1995
1996   if (sink_type != DFC_TYPE_LISP_LSTREAM)
1997     {
1998       sink->data.len = Dynarr_length (conversion_out_dynarr);
1999       Dynarr_add (conversion_out_dynarr, 0);
2000       sink->data.ptr = Dynarr_atp (conversion_out_dynarr, 0);
2001     }
2002 }
2003
2004 void
2005 dfc_convert_to_internal_format (dfc_conversion_type source_type,
2006                                 dfc_conversion_data *source,
2007 #ifdef FILE_CODING
2008                                 Lisp_Object coding_system,
2009 #endif
2010                                 dfc_conversion_type sink_type,
2011                                 dfc_conversion_data *sink)
2012 {
2013   int count = specpdl_depth ();
2014   Bufbyte_dynarr *conversion_in_dynarr;
2015
2016   type_checking_assert
2017     ((source_type == DFC_TYPE_DATA ||
2018       source_type == DFC_TYPE_LISP_LSTREAM)
2019     &&
2020     (sink_type   == DFC_TYPE_DATA ||
2021      sink_type   == DFC_TYPE_LISP_LSTREAM));
2022
2023   record_unwind_protect (dfc_convert_to_internal_format_reset_in_use,
2024                          make_int (dfc_convert_to_internal_format_in_use));
2025   if (Dynarr_length (conversion_in_dynarr_list) <=
2026       dfc_convert_to_internal_format_in_use)
2027     Dynarr_add (conversion_in_dynarr_list, Dynarr_new (Bufbyte));
2028   conversion_in_dynarr = Dynarr_at (conversion_in_dynarr_list,
2029                                     dfc_convert_to_internal_format_in_use);
2030   dfc_convert_to_internal_format_in_use++;
2031   Dynarr_reset (conversion_in_dynarr);
2032
2033 #ifdef FILE_CODING
2034   coding_system = Fget_coding_system (coding_system);
2035 #endif
2036
2037   if (source_type != DFC_TYPE_LISP_LSTREAM &&
2038       sink_type   != DFC_TYPE_LISP_LSTREAM &&
2039       coding_system_is_binary (coding_system))
2040     {
2041 #ifdef MULE
2042       const Bufbyte *ptr = (const Bufbyte *) source->data.ptr;
2043       Bytecount len = source->data.len;
2044       const Bufbyte *end = ptr + len;
2045
2046       for (; ptr < end; ptr++)
2047         {
2048           Extbyte c = *ptr;
2049
2050           if (BYTE_ASCII_P (c))
2051             Dynarr_add (conversion_in_dynarr, c);
2052           else if (BYTE_C1_P (c))
2053             {
2054               Dynarr_add (conversion_in_dynarr, LEADING_BYTE_CONTROL_1);
2055               Dynarr_add (conversion_in_dynarr, c + 0x20);
2056             }
2057           else
2058             {
2059               Dynarr_add (conversion_in_dynarr, LEADING_BYTE_LATIN_ISO8859_1);
2060               Dynarr_add (conversion_in_dynarr, c);
2061             }
2062         }
2063 #else
2064       Dynarr_add_many (conversion_in_dynarr, source->data.ptr, source->data.len);
2065 #endif
2066     }
2067   else
2068     {
2069       Lisp_Object streams_to_delete[3];
2070       int delete_count = 0;
2071       Lisp_Object instream, outstream;
2072       Lstream *reader, *writer;
2073       struct gcpro gcpro1, gcpro2;
2074
2075       if (source_type == DFC_TYPE_LISP_LSTREAM)
2076         instream = source->lisp_object;
2077       else
2078         {
2079           type_checking_assert (source_type == DFC_TYPE_DATA);
2080           streams_to_delete[delete_count++] = instream =
2081             make_fixed_buffer_input_stream (source->data.ptr, source->data.len);
2082         }
2083
2084       if (sink_type == DFC_TYPE_LISP_LSTREAM)
2085         outstream = sink->lisp_object;
2086       else
2087         {
2088           type_checking_assert (sink_type == DFC_TYPE_DATA);
2089           streams_to_delete[delete_count++] = outstream =
2090             make_dynarr_output_stream
2091             ((unsigned_char_dynarr *) conversion_in_dynarr);
2092         }
2093
2094 #ifdef FILE_CODING
2095       streams_to_delete[delete_count++] = outstream =
2096         make_decoding_output_stream (XLSTREAM (outstream), coding_system);
2097 #endif
2098
2099       reader = XLSTREAM (instream);
2100       writer = XLSTREAM (outstream);
2101       /* outstream will gc-protect its sink stream, if necessary */
2102       GCPRO2 (instream, outstream);
2103
2104       while (1)
2105         {
2106           ssize_t size_in_bytes;
2107           char tempbuf[1024]; /* some random amount */
2108
2109           size_in_bytes = Lstream_read (reader, tempbuf, sizeof (tempbuf));
2110
2111           if (size_in_bytes == 0)
2112             break;
2113           else if (size_in_bytes < 0)
2114             error ("Error converting to internal format");
2115
2116           size_in_bytes = Lstream_write (writer, tempbuf, size_in_bytes);
2117
2118           if (size_in_bytes <= 0)
2119             error ("Error converting to internal format");
2120         }
2121
2122       /* Closing writer will close any stream at the other end of writer. */
2123       Lstream_close (writer);
2124       Lstream_close (reader);
2125       UNGCPRO;
2126
2127       /* The idea is that this function will create no garbage. */
2128       while (delete_count)
2129         Lstream_delete (XLSTREAM (streams_to_delete [--delete_count]));
2130     }
2131
2132   unbind_to (count, Qnil);
2133
2134   if (sink_type != DFC_TYPE_LISP_LSTREAM)
2135     {
2136       sink->data.len = Dynarr_length (conversion_in_dynarr);
2137       Dynarr_add (conversion_in_dynarr, 0); /* remember to zero-terminate! */
2138       sink->data.ptr = Dynarr_atp (conversion_in_dynarr, 0);
2139     }
2140 }
2141 \f
2142
2143 void
2144 syms_of_buffer (void)
2145 {
2146   INIT_LRECORD_IMPLEMENTATION (buffer);
2147
2148   defsymbol (&Qbuffer_live_p, "buffer-live-p");
2149   defsymbol (&Qbuffer_or_string_p, "buffer-or-string-p");
2150   defsymbol (&Qmode_class, "mode-class");
2151   defsymbol (&Qrename_auto_save_file, "rename-auto-save-file");
2152   defsymbol (&Qkill_buffer_hook, "kill-buffer-hook");
2153   defsymbol (&Qpermanent_local, "permanent-local");
2154
2155   defsymbol (&Qfirst_change_hook, "first-change-hook");
2156   defsymbol (&Qbefore_change_functions, "before-change-functions");
2157   defsymbol (&Qafter_change_functions, "after-change-functions");
2158
2159   /* #### Obsolete, for compatibility */
2160   defsymbol (&Qbefore_change_function, "before-change-function");
2161   defsymbol (&Qafter_change_function, "after-change-function");
2162
2163   defsymbol (&Qdefault_directory, "default-directory");
2164
2165   defsymbol (&Qget_file_buffer, "get-file-buffer");
2166   defsymbol (&Qchange_major_mode_hook, "change-major-mode-hook");
2167
2168   defsymbol (&Qfundamental_mode, "fundamental-mode");
2169
2170   defsymbol (&Qfind_file_compare_truenames, "find-file-compare-truenames");
2171
2172   defsymbol (&Qswitch_to_buffer, "switch-to-buffer");
2173
2174   DEFSUBR (Fbufferp);
2175   DEFSUBR (Fbuffer_live_p);
2176   DEFSUBR (Fbuffer_list);
2177   DEFSUBR (Fdecode_buffer);
2178   DEFSUBR (Fget_buffer);
2179   DEFSUBR (Fget_file_buffer);
2180   DEFSUBR (Fget_buffer_create);
2181   DEFSUBR (Fmake_indirect_buffer);
2182
2183   DEFSUBR (Fgenerate_new_buffer_name);
2184   DEFSUBR (Fbuffer_name);
2185   DEFSUBR (Fbuffer_file_name);
2186   DEFSUBR (Fbuffer_base_buffer);
2187   DEFSUBR (Fbuffer_indirect_children);
2188   DEFSUBR (Fbuffer_local_variables);
2189   DEFSUBR (Fbuffer_dedicated_frame);
2190   DEFSUBR (Fset_buffer_dedicated_frame);
2191   DEFSUBR (Fbuffer_modified_p);
2192   DEFSUBR (Fset_buffer_modified_p);
2193   DEFSUBR (Fbuffer_modified_tick);
2194   DEFSUBR (Frename_buffer);
2195   DEFSUBR (Fother_buffer);
2196   DEFSUBR (Fbuffer_disable_undo);
2197   DEFSUBR (Fbuffer_enable_undo);
2198   DEFSUBR (Fkill_buffer);
2199   DEFSUBR (Ferase_buffer);
2200   DEFSUBR (Frecord_buffer);
2201   DEFSUBR (Fset_buffer_major_mode);
2202   DEFSUBR (Fcurrent_buffer);
2203   DEFSUBR (Fset_buffer);
2204   DEFSUBR (Fbarf_if_buffer_read_only);
2205   DEFSUBR (Fbury_buffer);
2206   DEFSUBR (Fkill_all_local_variables);
2207 #ifdef MEMORY_USAGE_STATS
2208   DEFSUBR (Fbuffer_memory_usage);
2209 #endif
2210
2211   deferror (&Qprotected_field, "protected-field",
2212             "Attempt to modify a protected field", Qerror);
2213 }
2214
2215 void
2216 reinit_vars_of_buffer (void)
2217 {
2218   conversion_in_dynarr_list = Dynarr_new2 (Bufbyte_dynarr_dynarr,
2219                                            Bufbyte_dynarr *);
2220   conversion_out_dynarr_list = Dynarr_new2 (Extbyte_dynarr_dynarr,
2221                                             Extbyte_dynarr *);
2222
2223   staticpro_nodump (&Vbuffer_alist);
2224   Vbuffer_alist = Qnil;
2225   current_buffer = 0;
2226 }
2227
2228 /* initialize the buffer routines */
2229 void
2230 vars_of_buffer (void)
2231 {
2232   /* This function can GC */
2233   reinit_vars_of_buffer ();
2234
2235   staticpro (&QSFundamental);
2236   staticpro (&QSscratch);
2237
2238   QSFundamental = build_string ("Fundamental");
2239   QSscratch = build_string (DEFER_GETTEXT ("*scratch*"));
2240
2241   DEFVAR_LISP ("change-major-mode-hook", &Vchange_major_mode_hook /*
2242 List of hooks to be run before killing local variables in a buffer.
2243 This should be used by any mode that temporarily alters the contents or
2244 the read-only state of the buffer.  See also `kill-all-local-variables'.
2245 */ );
2246   Vchange_major_mode_hook = Qnil;
2247
2248   DEFVAR_BOOL ("find-file-compare-truenames", &find_file_compare_truenames /*
2249 If this is true, then the find-file command will check the truenames
2250 of all visited files when deciding whether a given file is already in
2251 a buffer, instead of just the buffer-file-name.  This means that if you
2252 attempt to visit another file which is a symbolic-link to a file which is
2253 already in a buffer, the existing buffer will be found instead of a newly-
2254 created one.  This works if any component of the pathname (including a non-
2255 terminal component) is a symbolic link as well, but doesn't work with hard
2256 links (nothing does).
2257
2258 See also the variable find-file-use-truenames.
2259 */ );
2260   find_file_compare_truenames = 0;
2261
2262   DEFVAR_BOOL ("find-file-use-truenames", &find_file_use_truenames /*
2263 If this is true, then a buffer's visited file-name will always be
2264 chased back to the real file; it will never be a symbolic link, and there
2265 will never be a symbolic link anywhere in its directory path.
2266 That is, the buffer-file-name and buffer-file-truename will be equal.
2267 This doesn't work with hard links.
2268
2269 See also the variable find-file-compare-truenames.
2270 */ );
2271   find_file_use_truenames = 0;
2272
2273   DEFVAR_LISP ("before-change-functions", &Vbefore_change_functions /*
2274 List of functions to call before each text change.
2275 Two arguments are passed to each function: the positions of
2276 the beginning and end of the range of old text to be changed.
2277 \(For an insertion, the beginning and end are at the same place.)
2278 No information is given about the length of the text after the change.
2279
2280 Buffer changes made while executing the `before-change-functions'
2281 don't call any before-change or after-change functions.
2282 */ );
2283   Vbefore_change_functions = Qnil;
2284
2285   /* FSF Emacs has the following additional doc at the end of
2286      before-change-functions and after-change-functions:
2287
2288 That's because these variables are temporarily set to nil.
2289 As a result, a hook function cannot straightforwardly alter the value of
2290 these variables.  See the Emacs Lisp manual for a way of
2291 accomplishing an equivalent result by using other variables.
2292
2293      But this doesn't apply under XEmacs because things are
2294      handled better. */
2295
2296   DEFVAR_LISP ("after-change-functions", &Vafter_change_functions /*
2297 List of functions to call after each text change.
2298 Three arguments are passed to each function: the positions of
2299 the beginning and end of the range of changed text,
2300 and the length of the pre-change text replaced by that range.
2301 \(For an insertion, the pre-change length is zero;
2302 for a deletion, that length is the number of characters deleted,
2303 and the post-change beginning and end are at the same place.)
2304
2305 Buffer changes made while executing `after-change-functions'
2306 don't call any before-change or after-change functions.
2307 */ );
2308   Vafter_change_functions = Qnil;
2309
2310   DEFVAR_LISP ("before-change-function", &Vbefore_change_function /*
2311
2312 */ ); /* obsoleteness will be documented */
2313   Vbefore_change_function = Qnil;
2314
2315   DEFVAR_LISP ("after-change-function", &Vafter_change_function /*
2316
2317 */ ); /* obsoleteness will be documented */
2318   Vafter_change_function = Qnil;
2319
2320   DEFVAR_LISP ("first-change-hook", &Vfirst_change_hook /*
2321 A list of functions to call before changing a buffer which is unmodified.
2322 The functions are run using the `run-hooks' function.
2323 */ );
2324   Vfirst_change_hook = Qnil;
2325
2326 #if 0 /* FSFmacs */
2327   xxDEFVAR_LISP ("transient-mark-mode", &Vtransient_mark_mode /*
2328 *Non-nil means deactivate the mark when the buffer contents change.
2329 */ );
2330   Vtransient_mark_mode = Qnil;
2331 #endif /* FSFmacs */
2332
2333   DEFVAR_INT ("undo-threshold", &undo_threshold /*
2334 Keep no more undo information once it exceeds this size.
2335 This threshold is applied when garbage collection happens.
2336 The size is counted as the number of bytes occupied,
2337 which includes both saved text and other data.
2338 */ );
2339   undo_threshold = 20000;
2340
2341   DEFVAR_INT ("undo-high-threshold", &undo_high_threshold /*
2342 Don't keep more than this much size of undo information.
2343 A command which pushes past this size is itself forgotten.
2344 This threshold is applied when garbage collection happens.
2345 The size is counted as the number of bytes occupied,
2346 which includes both saved text and other data.
2347 */ );
2348   undo_high_threshold = 30000;
2349
2350   DEFVAR_LISP ("inhibit-read-only", &Vinhibit_read_only /*
2351 *Non-nil means disregard read-only status of buffers or characters.
2352 If the value is t, disregard `buffer-read-only' and all `read-only'
2353 text properties.  If the value is a list, disregard `buffer-read-only'
2354 and disregard a `read-only' extent property or text property if the
2355 property value is a member of the list.
2356 */ );
2357   Vinhibit_read_only = Qnil;
2358
2359   DEFVAR_LISP ("kill-buffer-query-functions", &Vkill_buffer_query_functions /*
2360 List of functions called with no args to query before killing a buffer.
2361 */ );
2362   Vkill_buffer_query_functions = Qnil;
2363
2364   DEFVAR_BOOL ("delete-auto-save-files", &delete_auto_save_files /*
2365 *Non-nil means delete auto-save file when a buffer is saved or killed.
2366 */ );
2367   delete_auto_save_files = 1;
2368 }
2369
2370 /* The docstrings for DEFVAR_* are recorded externally by make-docfile.  */
2371
2372 /* Renamed from DEFVAR_PER_BUFFER because FSFmacs D_P_B takes
2373    a bogus extra arg, which confuses an otherwise identical make-docfile.c */
2374 #define DEFVAR_BUFFER_LOCAL_1(lname, field_name, forward_type, magicfun) do {   \
2375   static const struct symbol_value_forward I_hate_C =                           \
2376   { /* struct symbol_value_forward */                                           \
2377     { /* struct symbol_value_magic */                                           \
2378       { /* struct lcrecord_header */                                            \
2379         { /* struct lrecord_header */                                           \
2380           lrecord_type_symbol_value_forward, /* lrecord_type_index */           \
2381           1, /* mark bit */                                                     \
2382           1, /* c_readonly bit */                                               \
2383           1  /* lisp_readonly bit */                                            \
2384         },                                                                      \
2385         0, /* next */                                                           \
2386         0, /* uid  */                                                           \
2387         0  /* free */                                                           \
2388       },                                                                        \
2389       &(buffer_local_flags.field_name),                                         \
2390       forward_type                                                              \
2391     },                                                                          \
2392     magicfun                                                                    \
2393   };                                                                            \
2394                                                                                 \
2395   {                                                                             \
2396     int offset = ((char *)symbol_value_forward_forward (&I_hate_C) -            \
2397                   (char *)&buffer_local_flags);                                 \
2398     defvar_magic (lname, &I_hate_C);                                            \
2399                                                                                 \
2400     *((Lisp_Object *)(offset + (char *)XBUFFER (Vbuffer_local_symbols)))        \
2401       = intern (lname);                                                         \
2402   }                                                                             \
2403 } while (0)
2404
2405 #define DEFVAR_BUFFER_LOCAL_MAGIC(lname, field_name, magicfun)          \
2406         DEFVAR_BUFFER_LOCAL_1 (lname, field_name,                       \
2407                                SYMVAL_CURRENT_BUFFER_FORWARD, magicfun)
2408 #define DEFVAR_BUFFER_LOCAL(lname, field_name)                          \
2409         DEFVAR_BUFFER_LOCAL_MAGIC (lname, field_name, 0)
2410 #define DEFVAR_CONST_BUFFER_LOCAL_MAGIC(lname, field_name, magicfun)    \
2411         DEFVAR_BUFFER_LOCAL_1 (lname, field_name,                       \
2412                                SYMVAL_CONST_CURRENT_BUFFER_FORWARD, magicfun)
2413 #define DEFVAR_CONST_BUFFER_LOCAL(lname, field_name)                    \
2414         DEFVAR_CONST_BUFFER_LOCAL_MAGIC (lname, field_name, 0)
2415
2416 #define DEFVAR_BUFFER_DEFAULTS_MAGIC(lname, field_name, magicfun)       \
2417         DEFVAR_SYMVAL_FWD (lname, &(buffer_local_flags.field_name),     \
2418                            SYMVAL_DEFAULT_BUFFER_FORWARD, magicfun)
2419 #define DEFVAR_BUFFER_DEFAULTS(lname, field_name)                       \
2420         DEFVAR_BUFFER_DEFAULTS_MAGIC (lname, field_name, 0)
2421
2422 static void
2423 nuke_all_buffer_slots (struct buffer *b, Lisp_Object zap)
2424 {
2425   zero_lcrecord (b);
2426
2427   b->extent_info = Qnil;
2428   b->indirect_children = Qnil;
2429   b->own_text.line_number_cache = Qnil;
2430
2431 #define MARKED_SLOT(x)  b->x = zap
2432 #include "bufslots.h"
2433 #undef MARKED_SLOT
2434 }
2435
2436 static void
2437 common_init_complex_vars_of_buffer (void)
2438 {
2439   /* Make sure all markable slots in buffer_defaults
2440      are initialized reasonably, so mark_buffer won't choke. */
2441   struct buffer *defs = alloc_lcrecord_type (struct buffer, &lrecord_buffer);
2442   struct buffer *syms = alloc_lcrecord_type (struct buffer, &lrecord_buffer);
2443
2444   staticpro_nodump (&Vbuffer_defaults);
2445   staticpro_nodump (&Vbuffer_local_symbols);
2446   XSETBUFFER (Vbuffer_defaults, defs);
2447   XSETBUFFER (Vbuffer_local_symbols, syms);
2448
2449   nuke_all_buffer_slots (syms, Qnil);
2450   nuke_all_buffer_slots (defs, Qnil);
2451   defs->text = &defs->own_text;
2452   syms->text = &syms->own_text;
2453
2454   /* Set up the non-nil default values of various buffer slots.
2455      Must do these before making the first buffer. */
2456   defs->major_mode = Qfundamental_mode;
2457   defs->mode_name = QSFundamental;
2458   defs->abbrev_table = Qnil;    /* real default setup by Lisp code */
2459
2460   defs->downcase_table   = Vascii_downcase_table;
2461   defs->upcase_table     = Vascii_upcase_table;
2462   defs->case_canon_table = Vascii_canon_table;
2463   defs->case_eqv_table   = Vascii_eqv_table;
2464 #ifdef MULE
2465   defs->mirror_downcase_table   = Vmirror_ascii_downcase_table;
2466   defs->mirror_upcase_table     = Vmirror_ascii_upcase_table;
2467   defs->mirror_case_canon_table = Vmirror_ascii_canon_table;
2468   defs->mirror_case_eqv_table   = Vmirror_ascii_eqv_table;
2469
2470   defs->category_table = Vstandard_category_table;
2471 #endif /* MULE */
2472   defs->syntax_table = Vstandard_syntax_table;
2473   defs->mirror_syntax_table =
2474     XCHAR_TABLE (Vstandard_syntax_table)->mirror_table;
2475   defs->modeline_format = build_string ("%-");  /* reset in loaddefs.el */
2476   defs->case_fold_search = Qt;
2477   defs->selective_display_ellipses = Qt;
2478   defs->tab_width = make_int (8);
2479   defs->ctl_arrow = Qt;
2480   defs->fill_column = make_int (70);
2481   defs->left_margin = Qzero;
2482   defs->saved_size = Qzero;     /* lisp code wants int-or-nil */
2483   defs->modtime = 0;
2484   defs->auto_save_modified = 0;
2485   defs->auto_save_failure_time = -1;
2486   defs->invisibility_spec = Qt;
2487
2488   defs->indirect_children = Qnil;
2489   syms->indirect_children = Qnil;
2490
2491   {
2492     /*  0 means var is always local.  Default used only at creation.
2493      * -1 means var is always local.  Default used only at reset and
2494      *    creation.
2495      * -2 means there's no lisp variable corresponding to this slot
2496      *    and the default is only used at creation.
2497      * -3 means no Lisp variable.  Default used only at reset and creation.
2498      * >0 is mask.  Var is local if ((buffer->local_var_flags & mask) != 0)
2499      *              Otherwise default is used.
2500      */
2501     Lisp_Object always_local_no_default = make_int (0);
2502     Lisp_Object always_local_resettable = make_int (-1);
2503     Lisp_Object resettable              = make_int (-3);
2504
2505     /* Assign the local-flags to the slots that have default values.
2506        The local flag is a bit that is used in the buffer
2507        to say that it has its own local value for the slot.
2508        The local flag bits are in the local_var_flags slot of the
2509        buffer.  */
2510
2511     nuke_all_buffer_slots (&buffer_local_flags, make_int (-2));
2512     buffer_local_flags.filename            = always_local_no_default;
2513     buffer_local_flags.directory           = always_local_no_default;
2514     buffer_local_flags.backed_up           = always_local_no_default;
2515     buffer_local_flags.saved_size          = always_local_no_default;
2516     buffer_local_flags.auto_save_file_name = always_local_no_default;
2517     buffer_local_flags.read_only           = always_local_no_default;
2518
2519     buffer_local_flags.major_mode          = always_local_resettable;
2520     buffer_local_flags.mode_name           = always_local_resettable;
2521     buffer_local_flags.undo_list           = always_local_no_default;
2522 #if 0 /* FSFmacs */
2523     buffer_local_flags.mark_active         = always_local_resettable;
2524 #endif
2525     buffer_local_flags.point_before_scroll = always_local_resettable;
2526     buffer_local_flags.file_truename       = always_local_no_default;
2527     buffer_local_flags.invisibility_spec   = always_local_resettable;
2528     buffer_local_flags.file_format         = always_local_resettable;
2529     buffer_local_flags.generated_modeline_string = always_local_no_default;
2530
2531     buffer_local_flags.keymap           = resettable;
2532     buffer_local_flags.downcase_table   = resettable;
2533     buffer_local_flags.upcase_table     = resettable;
2534     buffer_local_flags.case_canon_table = resettable;
2535     buffer_local_flags.case_eqv_table   = resettable;
2536     buffer_local_flags.syntax_table     = resettable;
2537 #ifdef MULE
2538     buffer_local_flags.category_table   = resettable;
2539 #endif
2540
2541     buffer_local_flags.modeline_format            = make_int (1<<0);
2542     buffer_local_flags.abbrev_mode                = make_int (1<<1);
2543     buffer_local_flags.overwrite_mode             = make_int (1<<2);
2544     buffer_local_flags.case_fold_search           = make_int (1<<3);
2545     buffer_local_flags.auto_fill_function         = make_int (1<<4);
2546     buffer_local_flags.selective_display          = make_int (1<<5);
2547     buffer_local_flags.selective_display_ellipses = make_int (1<<6);
2548     buffer_local_flags.tab_width                  = make_int (1<<7);
2549     buffer_local_flags.truncate_lines             = make_int (1<<8);
2550     buffer_local_flags.ctl_arrow                  = make_int (1<<9);
2551     buffer_local_flags.fill_column                = make_int (1<<10);
2552     buffer_local_flags.left_margin                = make_int (1<<11);
2553     buffer_local_flags.abbrev_table               = make_int (1<<12);
2554 #ifdef REGION_CACHE_NEEDS_WORK
2555     buffer_local_flags.cache_long_line_scans      = make_int (1<<13);
2556 #endif
2557 #ifdef FILE_CODING
2558     buffer_local_flags.buffer_file_coding_system  = make_int (1<<14);
2559 #endif
2560
2561     /* #### Warning: 1<<31 is the largest number currently allowable
2562        due to the XINT() handling of this value.  With some
2563        rearrangement you can get 3 more bits. */
2564   }
2565 }
2566
2567 #define BUFFER_SLOTS_SIZE (offsetof (struct buffer, BUFFER_SLOTS_LAST_NAME) - offsetof (struct buffer, BUFFER_SLOTS_FIRST_NAME) + sizeof (Lisp_Object))
2568 #define BUFFER_SLOTS_COUNT (BUFFER_SLOTS_SIZE / sizeof (Lisp_Object))
2569
2570 void
2571 reinit_complex_vars_of_buffer (void)
2572 {
2573   struct buffer *defs, *syms;
2574
2575   common_init_complex_vars_of_buffer ();
2576
2577   defs = XBUFFER (Vbuffer_defaults);
2578   syms = XBUFFER (Vbuffer_local_symbols);
2579   memcpy (&defs->BUFFER_SLOTS_FIRST_NAME,
2580           buffer_defaults_saved_slots,
2581           BUFFER_SLOTS_SIZE);
2582   memcpy (&syms->BUFFER_SLOTS_FIRST_NAME,
2583           buffer_local_symbols_saved_slots,
2584           BUFFER_SLOTS_SIZE);
2585 }
2586
2587
2588 static const struct lrecord_description buffer_slots_description_1[] = {
2589   { XD_LISP_OBJECT_ARRAY, 0, BUFFER_SLOTS_COUNT },
2590   { XD_END }
2591 };
2592
2593 static const struct struct_description buffer_slots_description = {
2594   BUFFER_SLOTS_SIZE,
2595   buffer_slots_description_1
2596 };
2597
2598 void
2599 complex_vars_of_buffer (void)
2600 {
2601   struct buffer *defs, *syms;
2602
2603   common_init_complex_vars_of_buffer ();
2604
2605   defs = XBUFFER (Vbuffer_defaults);
2606   syms = XBUFFER (Vbuffer_local_symbols);
2607   buffer_defaults_saved_slots      = &defs->BUFFER_SLOTS_FIRST_NAME;
2608   buffer_local_symbols_saved_slots = &syms->BUFFER_SLOTS_FIRST_NAME;
2609   dumpstruct (&buffer_defaults_saved_slots,      &buffer_slots_description);
2610   dumpstruct (&buffer_local_symbols_saved_slots, &buffer_slots_description);
2611
2612   DEFVAR_BUFFER_DEFAULTS ("default-modeline-format", modeline_format /*
2613 Default value of `modeline-format' for buffers that don't override it.
2614 This is the same as (default-value 'modeline-format).
2615 */ );
2616
2617   DEFVAR_BUFFER_DEFAULTS ("default-abbrev-mode", abbrev_mode /*
2618 Default value of `abbrev-mode' for buffers that do not override it.
2619 This is the same as (default-value 'abbrev-mode).
2620 */ );
2621
2622   DEFVAR_BUFFER_DEFAULTS ("default-ctl-arrow", ctl_arrow /*
2623 Default value of `ctl-arrow' for buffers that do not override it.
2624 This is the same as (default-value 'ctl-arrow).
2625 */ );
2626
2627 #if 0 /* #### make this a specifier! */
2628   DEFVAR_BUFFER_DEFAULTS ("default-display-direction", display_direction /*
2629 Default display-direction for buffers that do not override it.
2630 This is the same as (default-value 'display-direction).
2631 Note: This is not yet implemented.
2632 */ );
2633 #endif
2634
2635   DEFVAR_BUFFER_DEFAULTS ("default-truncate-lines", truncate_lines /*
2636 Default value of `truncate-lines' for buffers that do not override it.
2637 This is the same as (default-value 'truncate-lines).
2638 */ );
2639
2640   DEFVAR_BUFFER_DEFAULTS ("default-fill-column", fill_column /*
2641 Default value of `fill-column' for buffers that do not override it.
2642 This is the same as (default-value 'fill-column).
2643 */ );
2644
2645   DEFVAR_BUFFER_DEFAULTS ("default-left-margin", left_margin /*
2646 Default value of `left-margin' for buffers that do not override it.
2647 This is the same as (default-value 'left-margin).
2648 */ );
2649
2650   DEFVAR_BUFFER_DEFAULTS ("default-tab-width", tab_width /*
2651 Default value of `tab-width' for buffers that do not override it.
2652 This is the same as (default-value 'tab-width).
2653 */ );
2654
2655   DEFVAR_BUFFER_DEFAULTS ("default-case-fold-search", case_fold_search /*
2656 Default value of `case-fold-search' for buffers that don't override it.
2657 This is the same as (default-value 'case-fold-search).
2658 */ );
2659
2660   DEFVAR_BUFFER_LOCAL ("modeline-format", modeline_format /*
2661 Template for displaying modeline for current buffer.
2662 Each buffer has its own value of this variable.
2663 Value may be a string, symbol, glyph, generic specifier, list or cons cell.
2664 For a symbol, its value is processed (but it is ignored if t or nil).
2665  A string appearing directly as the value of a symbol is processed verbatim
2666  in that the %-constructs below are not recognized.
2667 For a glyph, it is inserted as is.
2668 For a generic specifier (i.e. a specifier of type `generic'), its instance
2669  is computed in the current window using the equivalent of `specifier-instance'
2670  and the value is processed.
2671 For a list whose car is a symbol, the symbol's value is taken,
2672  and if that is non-nil, the cadr of the list is processed recursively.
2673  Otherwise, the caddr of the list (if there is one) is processed.
2674 For a list whose car is a string or list, each element is processed
2675  recursively and the results are effectively concatenated.
2676 For a list whose car is an integer, the cdr of the list is processed
2677  and padded (if the number is positive) or truncated (if negative)
2678  to the width specified by that number.
2679 For a list whose car is an extent, the cdr of the list is processed
2680  normally but the results are displayed using the face of the
2681  extent, and mouse clicks over this section are processed using the
2682  keymap of the extent. (In addition, if the extent has a help-echo
2683  property, that string will be echoed when the mouse moves over this
2684  section.) If extents are nested, all keymaps are properly consulted
2685  when processing mouse clicks, but multiple faces are not correctly
2686  merged (only the first face is used), and lists of faces are not
2687  correctly handled.  See `generated-modeline-string' for more information.
2688 A string is printed verbatim in the modeline except for %-constructs:
2689   (%-constructs are processed when the string is the entire modeline-format
2690    or when it is found in a cons-cell or a list)
2691   %b -- print buffer name.      %c -- print the current column number.
2692   %f -- print visited file name.
2693   %* -- print %, * or hyphen.   %+ -- print *, % or hyphen.
2694         % means buffer is read-only and * means it is modified.
2695         For a modified read-only buffer, %* gives % and %+ gives *.
2696   %s -- print process status.   %l -- print the current line number.
2697   %S -- print name of selected frame (only meaningful under X Windows).
2698   %p -- print percent of buffer above top of window, or Top, Bot or All.
2699   %P -- print percent of buffer above bottom of window, perhaps plus Top,
2700         or print Bottom or All.
2701   %n -- print Narrow if appropriate.
2702   %C -- under XEmacs/mule, print the mnemonic for `buffer-file-coding-system'.
2703   %[ -- print one [ for each recursive editing level.  %] similar.
2704   %% -- print %.                %- -- print infinitely many dashes.
2705 Decimal digits after the % specify field width to which to pad.
2706 */ );
2707
2708   DEFVAR_BUFFER_DEFAULTS ("default-major-mode", major_mode /*
2709 *Major mode for new buffers.  Defaults to `fundamental-mode'.
2710 nil here means use current buffer's major mode.
2711 */ );
2712
2713   DEFVAR_BUFFER_DEFAULTS ("fundamental-mode-abbrev-table", abbrev_table /*
2714 The abbrev table of mode-specific abbrevs for Fundamental Mode.
2715 */ );
2716
2717   DEFVAR_BUFFER_LOCAL ("major-mode", major_mode /*
2718 Symbol for current buffer's major mode.
2719 */ );
2720
2721   DEFVAR_BUFFER_LOCAL ("mode-name", mode_name /*
2722 Pretty name of current buffer's major mode (a string).
2723 */ );
2724
2725   DEFVAR_BUFFER_LOCAL ("abbrev-mode", abbrev_mode /*
2726 Non-nil turns on automatic expansion of abbrevs as they are inserted.
2727 Automatically becomes buffer-local when set in any fashion.
2728 */ );
2729
2730   DEFVAR_BUFFER_LOCAL ("case-fold-search", case_fold_search /*
2731 *Non-nil if searches should ignore case.
2732 Automatically becomes buffer-local when set in any fashion.
2733
2734 BUG: Under XEmacs/Mule, translations to or from non-ASCII characters
2735  (this includes chars in the range 128 - 255) are ignored by
2736  the string/buffer-searching routines.  Thus, `case-fold-search'
2737  will not correctly conflate a-umlaut and A-umlaut even if the
2738  case tables call for this.
2739 */ );
2740
2741   DEFVAR_BUFFER_LOCAL ("fill-column", fill_column /*
2742 *Column beyond which automatic line-wrapping should happen.
2743 Automatically becomes buffer-local when set in any fashion.
2744 */ );
2745
2746   DEFVAR_BUFFER_LOCAL ("left-margin", left_margin /*
2747 *Column for the default indent-line-function to indent to.
2748 Linefeed indents to this column in Fundamental mode.
2749 Automatically becomes buffer-local when set in any fashion.
2750 Do not confuse this with the specifier `left-margin-width';
2751 that controls the size of a margin that is displayed outside
2752 of the text area.
2753 */ );
2754
2755   DEFVAR_BUFFER_LOCAL_MAGIC ("tab-width", tab_width /*
2756 *Distance between tab stops (for display of tab characters), in columns.
2757 Automatically becomes buffer-local when set in any fashion.
2758 */ , redisplay_variable_changed);
2759
2760   DEFVAR_BUFFER_LOCAL_MAGIC ("ctl-arrow", ctl_arrow /*
2761 *Non-nil means display control chars with uparrow.
2762 Nil means use backslash and octal digits.
2763 An integer means characters >= ctl-arrow are assumed to be printable, and
2764 will be displayed as a single glyph.
2765 Any other value is the same as 160 - the code SPC with the high bit on.
2766
2767 The interpretation of this variable is likely to change in the future.
2768
2769 Automatically becomes buffer-local when set in any fashion.
2770 This variable does not apply to characters whose display is specified
2771 in the current display table (if there is one).
2772 */ , redisplay_variable_changed);
2773
2774 #if 0 /* #### Make this a specifier! */
2775   xxDEFVAR_BUFFER_LOCAL ("display-direction", display_direction /*
2776 *Non-nil means lines in the buffer are displayed right to left.
2777 Nil means left to right. (Not yet implemented.)
2778 */ );
2779 #endif /* Not yet implemented */
2780
2781   DEFVAR_BUFFER_LOCAL_MAGIC ("truncate-lines", truncate_lines /*
2782 *Non-nil means do not display continuation lines;
2783 give each line of text one frame line.
2784 Automatically becomes buffer-local when set in any fashion.
2785
2786 Note that this is overridden by the variable
2787 `truncate-partial-width-windows' if that variable is non-nil
2788 and this buffer is not full-frame width.
2789 */ , redisplay_variable_changed);
2790
2791   DEFVAR_BUFFER_LOCAL ("default-directory", directory /*
2792 Name of default directory of current buffer.  Should end with slash.
2793 Each buffer has its own value of this variable.
2794 */ );
2795
2796 #ifdef FILE_CODING
2797   DEFVAR_BUFFER_DEFAULTS ("default-buffer-file-coding-system", buffer_file_coding_system /*
2798 Default value of `buffer-file-coding-system' for buffers that do not override it.
2799 This is the same as (default-value 'buffer-file-coding-system).
2800 This value is used both for buffers without associated files and
2801 for buffers whose files do not have any apparent coding system.
2802 See `buffer-file-coding-system'.
2803 */ );
2804
2805   DEFVAR_BUFFER_LOCAL ("buffer-file-coding-system", buffer_file_coding_system /*
2806 *Current coding system for the current buffer.
2807 When the buffer is written out into a file, this coding system will be
2808 used for the encoding.  Automatically buffer-local when set in any
2809 fashion.  This is normally set automatically when a file is loaded in
2810 based on the determined coding system of the file (assuming that
2811 `buffer-file-coding-system-for-read' is set to `undecided', which
2812 calls for automatic determination of the file's coding system).
2813 Normally the modeline indicates the current file coding system using
2814 its mnemonic abbreviation.
2815
2816 The default value for this variable (which is normally used for
2817 buffers without associated files) is also used when automatic
2818 detection of a file's encoding is called for and there was no
2819 discernible encoding in the file (i.e. it was entirely or almost
2820 entirely ASCII).  The default value should generally *not* be set to
2821 nil (equivalent to `no-conversion'), because if extended characters
2822 are ever inserted into the buffer, they will be lost when the file is
2823 written out.  A good choice is `iso-2022-8' (the simple ISO 2022 8-bit
2824 encoding), which will write out ASCII and Latin-1 characters in the
2825 standard (and highly portable) fashion and use standard escape
2826 sequences for other charsets.  Another reasonable choice is
2827 `escape-quoted', which is equivalent to `iso-2022-8' but prefixes
2828 certain control characters with ESC to make sure they are not
2829 interpreted as escape sequences when read in.  This latter coding
2830 system results in more "correct" output in the presence of control
2831 characters in the buffer, in the sense that when read in again using
2832 the same coding system, the result will virtually always match the
2833 original contents of the buffer, which is not the case with
2834 `iso-2022-8'; but the output is less portable when dealing with binary
2835 data -- there may be stray ESC characters when the file is read by
2836 another program.
2837
2838 `buffer-file-coding-system' does *not* control the coding system used when
2839 a file is read in.  Use the variables `buffer-file-coding-system-for-read'
2840 and `buffer-file-coding-system-alist' for that.  From a Lisp program, if
2841 you wish to unilaterally specify the coding system used for one
2842 particular operation, you should bind the variable
2843 `coding-system-for-read' rather than changing the other two
2844 variables just mentioned, which are intended to be used for
2845 global environment specification.
2846 */ );
2847 #endif /* FILE_CODING */
2848
2849   DEFVAR_BUFFER_LOCAL ("auto-fill-function", auto_fill_function /*
2850 Function called (if non-nil) to perform auto-fill.
2851 It is called after self-inserting a space at a column beyond `fill-column'.
2852 Each buffer has its own value of this variable.
2853 NOTE: This variable is not an ordinary hook;
2854 It may not be a list of functions.
2855 */ );
2856
2857   DEFVAR_BUFFER_LOCAL ("buffer-file-name", filename /*
2858 Name of file visited in current buffer, or nil if not visiting a file.
2859 Each buffer has its own value of this variable.
2860 */ );
2861
2862 #if 0 /* FSFmacs */
2863 /*
2864 Abbreviated truename of file visited in current buffer, or nil if none.
2865 The truename of a file is calculated by `file-truename'
2866 and then abbreviated with `abbreviate-file-name'.
2867 Each buffer has its own value of this variable.
2868 */
2869 #endif /* FSFmacs */
2870
2871   DEFVAR_BUFFER_LOCAL ("buffer-file-truename", file_truename /*
2872 The real name of the file visited in the current buffer,
2873 or nil if not visiting a file.  This is the result of passing
2874 buffer-file-name to the `file-truename' function.  Every buffer has
2875 its own value of this variable.  This variable is automatically
2876 maintained by the functions that change the file name associated
2877 with a buffer.
2878 */ );
2879
2880   DEFVAR_BUFFER_LOCAL ("buffer-auto-save-file-name", auto_save_file_name /*
2881 Name of file for auto-saving current buffer,
2882 or nil if buffer should not be auto-saved.
2883 Each buffer has its own value of this variable.
2884 */ );
2885
2886   DEFVAR_BUFFER_LOCAL ("buffer-read-only", read_only /*
2887 Non-nil if this buffer is read-only.
2888 Each buffer has its own value of this variable.
2889 */ );
2890
2891   DEFVAR_BUFFER_LOCAL ("buffer-backed-up", backed_up /*
2892 Non-nil if this buffer's file has been backed up.
2893 Backing up is done before the first time the file is saved.
2894 Each buffer has its own value of this variable.
2895 */ );
2896
2897   DEFVAR_BUFFER_LOCAL ("buffer-saved-size", saved_size /*
2898 Length of current buffer when last read in, saved or auto-saved.
2899 0 initially.
2900 Each buffer has its own value of this variable.
2901 */ );
2902
2903   DEFVAR_BUFFER_LOCAL_MAGIC ("selective-display", selective_display /*
2904 Non-nil enables selective display:
2905 Integer N as value means display only lines
2906  that start with less than n columns of space.
2907 A value of t means, after a ^M, all the rest of the line is invisible.
2908  Then ^M's in the file are written into files as newlines.
2909
2910 Automatically becomes buffer-local when set in any fashion.
2911 */, redisplay_variable_changed);
2912
2913 #ifndef old
2914   DEFVAR_BUFFER_LOCAL_MAGIC ("selective-display-ellipses",
2915                              selective_display_ellipses /*
2916 t means display ... on previous line when a line is invisible.
2917 Automatically becomes buffer-local when set in any fashion.
2918 */, redisplay_variable_changed);
2919 #endif
2920
2921   DEFVAR_BUFFER_LOCAL ("local-abbrev-table", abbrev_table /*
2922 Local (mode-specific) abbrev table of current buffer.
2923 */ );
2924
2925   DEFVAR_BUFFER_LOCAL ("overwrite-mode", overwrite_mode /*
2926 Non-nil if self-insertion should replace existing text.
2927 The value should be one of `overwrite-mode-textual',
2928 `overwrite-mode-binary', or nil.
2929 If it is `overwrite-mode-textual', self-insertion still
2930 inserts at the end of a line, and inserts when point is before a tab,
2931 until the tab is filled in.
2932 If `overwrite-mode-binary', self-insertion replaces newlines and tabs too.
2933 Automatically becomes buffer-local when set in any fashion.
2934
2935 Normally, you shouldn't modify this variable by hand, but use the functions
2936 `overwrite-mode' and `binary-overwrite-mode' instead. However, you can
2937 customize the default value from the options menu.
2938 */ );
2939
2940 #if 0 /* FSFmacs */
2941   /* Adds the following to the doc string for buffer-undo-list:
2942
2943 An entry (nil PROPERTY VALUE BEG . END) indicates that a text property
2944 was modified between BEG and END.  PROPERTY is the property name,
2945 and VALUE is the old value.
2946 */
2947 #endif /* FSFmacs */
2948
2949   DEFVAR_BUFFER_LOCAL ("buffer-undo-list", undo_list /*
2950 List of undo entries in current buffer.
2951 Recent changes come first; older changes follow newer.
2952
2953 An entry (BEG . END) represents an insertion which begins at
2954 position BEG and ends at position END.
2955
2956 An entry (TEXT . POSITION) represents the deletion of the string TEXT
2957 from (abs POSITION).  If POSITION is positive, point was at the front
2958 of the text being deleted; if negative, point was at the end.
2959
2960 An entry (t HIGH . LOW) indicates that the buffer previously had
2961 "unmodified" status.  HIGH and LOW are the high and low 16-bit portions
2962 of the visited file's modification time, as of that time.  If the
2963 modification time of the most recent save is different, this entry is
2964 obsolete.
2965
2966 An entry of the form EXTENT indicates that EXTENT was attached in
2967 the buffer.  Undoing an entry of this form detaches EXTENT.
2968
2969 An entry of the form (EXTENT START END) indicates that EXTENT was
2970 detached from the buffer.  Undoing an entry of this form attaches
2971 EXTENT from START to END.
2972
2973 An entry of the form POSITION indicates that point was at the buffer
2974 location given by the integer.  Undoing an entry of this form places
2975 point at POSITION.
2976
2977 nil marks undo boundaries.  The undo command treats the changes
2978 between two undo boundaries as a single step to be undone.
2979
2980 If the value of the variable is t, undo information is not recorded.
2981 */ );
2982
2983 #if 0 /* FSFmacs */
2984   xxDEFVAR_BUFFER_LOCAL ("mark-active", mark_active /*
2985 Non-nil means the mark and region are currently active in this buffer.
2986 Automatically local in all buffers.
2987 */ );
2988 #endif /* FSFmacs */
2989
2990 #ifdef REGION_CACHE_NEEDS_WORK
2991   xxDEFVAR_BUFFER_LOCAL ("cache-long-line-scans", cache_long_line_scans /*
2992 Non-nil means that Emacs should use caches to handle long lines more quickly.
2993 This variable is buffer-local, in all buffers.
2994
2995 Normally, the line-motion functions work by scanning the buffer for
2996 newlines.  Columnar operations (like move-to-column and
2997 compute-motion) also work by scanning the buffer, summing character
2998 widths as they go.  This works well for ordinary text, but if the
2999 buffer's lines are very long (say, more than 500 characters), these
3000 motion functions will take longer to execute.  Emacs may also take
3001 longer to update the display.
3002
3003 If cache-long-line-scans is non-nil, these motion functions cache the
3004 results of their scans, and consult the cache to avoid rescanning
3005 regions of the buffer until the text is modified.  The caches are most
3006 beneficial when they prevent the most searching---that is, when the
3007 buffer contains long lines and large regions of characters with the
3008 same, fixed screen width.
3009
3010 When cache-long-line-scans is non-nil, processing short lines will
3011 become slightly slower (because of the overhead of consulting the
3012 cache), and the caches will use memory roughly proportional to the
3013 number of newlines and characters whose screen width varies.
3014
3015 The caches require no explicit maintenance; their accuracy is
3016 maintained internally by the Emacs primitives.  Enabling or disabling
3017 the cache should not affect the behavior of any of the motion
3018 functions; it should only affect their performance.
3019 */ );
3020 #endif /* REGION_CACHE_NEEDS_WORK */
3021
3022   DEFVAR_BUFFER_LOCAL ("point-before-scroll", point_before_scroll /*
3023 Value of point before the last series of scroll operations, or nil.
3024 */ );
3025
3026   DEFVAR_BUFFER_LOCAL ("buffer-file-format", file_format /*
3027 List of formats to use when saving this buffer.
3028 Formats are defined by `format-alist'.  This variable is
3029 set when a file is visited.  Automatically local in all buffers.
3030 */ );
3031
3032   DEFVAR_BUFFER_LOCAL_MAGIC ("buffer-invisibility-spec", invisibility_spec /*
3033 Invisibility spec of this buffer.
3034 The default is t, which means that text is invisible
3035 if it has (or is covered by an extent with) a non-nil `invisible' property.
3036 If the value is a list, a text character is invisible if its `invisible'
3037 property is an element in that list.
3038 If an element is a cons cell of the form (PROP . ELLIPSIS),
3039 then characters with property value PROP are invisible,
3040 and they have an ellipsis as well if ELLIPSIS is non-nil.
3041 Note that the actual characters used for the ellipsis are controllable
3042 using `invisible-text-glyph', and default to "...".
3043 */, redisplay_variable_changed);
3044
3045   DEFVAR_CONST_BUFFER_LOCAL ("generated-modeline-string",
3046                              generated_modeline_string /*
3047 String of characters in this buffer's modeline as of the last redisplay.
3048 Each time the modeline is recomputed, the resulting characters are
3049 stored in this string, which is resized as necessary.  You may not
3050 set this variable, and modifying this string will not change the
3051 modeline; you have to change `modeline-format' if you want that.
3052
3053 For each extent in `modeline-format' that is encountered when
3054 processing the modeline, a corresponding extent is placed in
3055 `generated-modeline-string' and covers the text over which the
3056 extent in `modeline-format' applies.  The extent in
3057 `generated-modeline-string' is made a child of the extent in
3058 `modeline-format', which means that it inherits all properties from
3059 that extent.  Note that the extents in `generated-modeline-string'
3060 are managed automatically.  You should not explicitly put any extents
3061 in `generated-modeline-string'; if you do, they will disappear the
3062 next time the modeline is processed.
3063
3064 For extents in `modeline-format', the following properties are currently
3065 handled:
3066
3067 `face'
3068         Affects the face of the modeline text.  Currently, faces do
3069         not merge properly; only the most recently encountered face
3070         is used.  This is a bug.
3071
3072 `keymap'
3073         Affects the disposition of button events over the modeline
3074         text.  Multiple applicable keymaps *are* handled properly,
3075         and `modeline-map' still applies to any events that don't
3076         have bindings in extent-specific keymaps.
3077
3078 `help-echo'
3079         If a string, causes the string to be displayed when the mouse
3080         moves over the text.
3081 */ );
3082
3083   /* Check for DEFVAR_BUFFER_LOCAL without initializing the corresponding
3084      slot of buffer_local_flags and vice-versa.  Must be done after all
3085      DEFVAR_BUFFER_LOCAL() calls. */
3086 #define MARKED_SLOT(slot)                                       \
3087   if ((XINT (buffer_local_flags.slot) != -2 &&                  \
3088        XINT (buffer_local_flags.slot) != -3)                    \
3089       != !(NILP (XBUFFER (Vbuffer_local_symbols)->slot)))       \
3090   abort ()
3091 #include "bufslots.h"
3092 #undef MARKED_SLOT
3093
3094   {
3095     Lisp_Object scratch = Fget_buffer_create (QSscratch);
3096     Fset_buffer (scratch);
3097     /* Want no undo records for *scratch* until after Emacs is dumped */
3098     Fbuffer_disable_undo (scratch);
3099   }
3100 }
3101
3102 #ifndef WIN32_NATIVE
3103 /* Is PWD another name for `.' ? */
3104 static int
3105 directory_is_current_directory (Extbyte *pwd)
3106 {
3107   Bufbyte *pwd_internal;
3108   Bytecount pwd_internal_len;
3109   struct stat dotstat, pwdstat;
3110
3111   TO_INTERNAL_FORMAT (DATA, (pwd, strlen ((char *)pwd) + 1),
3112                       ALLOCA, (pwd_internal, pwd_internal_len),
3113                       Qfile_name);
3114
3115   return (IS_DIRECTORY_SEP (*pwd_internal)
3116           && stat ((char *) pwd_internal, &pwdstat) == 0
3117           && stat (".", &dotstat) == 0
3118           && dotstat.st_ino == pwdstat.st_ino
3119           && dotstat.st_dev == pwdstat.st_dev
3120           && pwd_internal_len < MAXPATHLEN);
3121 }
3122 #endif
3123
3124 void
3125 init_initial_directory (void)
3126 {
3127   /* This function can GC */
3128
3129 #ifndef WIN32_NATIVE
3130   Extbyte *pwd;
3131 #endif
3132
3133   initial_directory[0] = 0;
3134
3135   /* If PWD is accurate, use it instead of calling getcwd.  This is faster
3136      when PWD is right, and may avoid a fatal error.  */
3137 #ifndef WIN32_NATIVE
3138   if ((pwd = (Extbyte *) getenv ("PWD")) != NULL
3139       && directory_is_current_directory (pwd))
3140     strcpy (initial_directory, (char *) pwd);
3141   else
3142 #endif
3143     if (getcwd (initial_directory, MAXPATHLEN) == NULL)
3144       fatal ("`getcwd' failed: %s\n", strerror (errno));
3145
3146   /* Make sure pwd is DIRECTORY_SEP-terminated.
3147      Maybe this should really use some standard subroutine
3148      whose definition is filename syntax dependent.  */
3149   {
3150     int len = strlen (initial_directory);
3151
3152     if (! IS_DIRECTORY_SEP (initial_directory[len - 1]))
3153       {
3154         initial_directory[len] = DIRECTORY_SEP;
3155         initial_directory[len + 1] = '\0';
3156       }
3157   }
3158
3159 #ifdef CORRECT_DIR_SEPS
3160   CORRECT_DIR_SEPS (initial_directory);
3161 #endif
3162 }
3163
3164 void
3165 init_buffer (void)
3166 {
3167   /* This function can GC */
3168
3169   Fset_buffer (Fget_buffer_create (QSscratch));
3170
3171   current_buffer->directory =
3172     build_ext_string (initial_directory, Qfile_name);
3173
3174 #if 0 /* FSFmacs */
3175   /* #### is this correct? */
3176   temp = get_minibuffer (0);
3177   XBUFFER (temp)->directory = current_buffer->directory;
3178 #endif /* FSFmacs */
3179 }