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