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