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