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