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