buffer.c 98.9 KB
Newer Older
Roland McGrath's avatar
Roland McGrath committed
1
/* Buffer manipulation primitives for GNU Emacs.
2
   Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994
3
	Free Software Foundation, Inc.
Roland McGrath's avatar
Roland McGrath committed
4 5 6 7 8

This file is part of GNU Emacs.

GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
9
the Free Software Foundation; either version 2, or (at your option)
Roland McGrath's avatar
Roland McGrath committed
10 11 12 13 14 15 16 17 18 19 20 21
any later version.

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING.  If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */


22 23
#include <sys/types.h>
#include <sys/stat.h>
Roland McGrath's avatar
Roland McGrath committed
24 25 26 27 28 29 30
#include <sys/param.h>

#ifndef MAXPATHLEN
/* in 4.1, param.h fails to define this. */
#define MAXPATHLEN 1024
#endif /* not MAXPATHLEN */

31
#include <config.h>
Roland McGrath's avatar
Roland McGrath committed
32
#include "lisp.h"
33
#include "intervals.h"
Roland McGrath's avatar
Roland McGrath committed
34 35 36
#include "window.h"
#include "commands.h"
#include "buffer.h"
37
#include "region-cache.h"
Roland McGrath's avatar
Roland McGrath committed
38
#include "indent.h"
Richard M. Stallman's avatar
Richard M. Stallman committed
39
#include "blockinput.h"
Roland McGrath's avatar
Roland McGrath committed
40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92

struct buffer *current_buffer;		/* the current buffer */

/* First buffer in chain of all buffers (in reverse order of creation).
   Threaded through ->next.  */

struct buffer *all_buffers;

/* This structure holds the default values of the buffer-local variables
   defined with DEFVAR_PER_BUFFER, that have special slots in each buffer.
   The default value occupies the same slot in this structure
   as an individual buffer's value occupies in that buffer.
   Setting the default value also goes through the alist of buffers
   and stores into each buffer that does not say it has a local value.  */

struct buffer buffer_defaults;

/* A Lisp_Object pointer to the above, used for staticpro */

static Lisp_Object Vbuffer_defaults;

/* This structure marks which slots in a buffer have corresponding
   default values in buffer_defaults.
   Each such slot has a nonzero value in this structure.
   The value has only one nonzero bit.

   When a buffer has its own local value for a slot,
   the bit for that slot (found in the same slot in this structure)
   is turned on in the buffer's local_var_flags slot.

   If a slot in this structure is -1, then even though there may
   be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
   and the corresponding slot in buffer_defaults is not used.

   If a slot is -2, then there is no DEFVAR_PER_BUFFER for it,
   but there is a default value which is copied into each buffer.

   If a slot in this structure is negative, then even though there may
   be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
   and the corresponding slot in buffer_defaults is not used.

   If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is
   zero, that is a bug */

struct buffer buffer_local_flags;

/* This structure holds the names of symbols whose values may be
   buffer-local.  It is indexed and accessed in the same way as the above. */

struct buffer buffer_local_symbols;
/* A Lisp_Object pointer to the above, used for staticpro */
static Lisp_Object Vbuffer_local_symbols;

93 94 95 96 97 98 99 100
/* This structure holds the required types for the values in the
   buffer-local slots.  If a slot contains Qnil, then the
   corresponding buffer slot may contain a value of any type.  If a
   slot contains an integer, then prospective values' tags must be
   equal to that integer.  When a tag does not match, the function
   buffer_slot_type_mismatch will signal an error.  */
struct buffer buffer_local_types;

Roland McGrath's avatar
Roland McGrath committed
101
Lisp_Object Fset_buffer ();
Roland McGrath's avatar
Roland McGrath committed
102
void set_buffer_internal ();
103
static void call_overlay_mod_hooks ();
Roland McGrath's avatar
Roland McGrath committed
104 105 106 107 108 109 110 111 112

/* Alist of all buffer names vs the buffers. */
/* This used to be a variable, but is no longer,
 to prevent lossage due to user rplac'ing this alist or its elements.  */
Lisp_Object Vbuffer_alist;

/* Functions to call before and after each text change. */
Lisp_Object Vbefore_change_function;
Lisp_Object Vafter_change_function;
113 114
Lisp_Object Vbefore_change_functions;
Lisp_Object Vafter_change_functions;
Roland McGrath's avatar
Roland McGrath committed
115

116 117
Lisp_Object Vtransient_mark_mode;

118 119 120 121 122
/* t means ignore all read-only text properties.
   A list means ignore such a property if its value is a member of the list.
   Any non-nil value means ignore buffer-read-only.  */
Lisp_Object Vinhibit_read_only;

123 124 125 126
/* List of functions to call that can query about killing a buffer.
   If any of these functions returns nil, we don't kill it.  */
Lisp_Object Vkill_buffer_query_functions;

Jim Blandy's avatar
Jim Blandy committed
127 128 129
/* List of functions to call before changing an unmodified buffer.  */
Lisp_Object Vfirst_change_hook;
Lisp_Object Qfirst_change_hook;
Roland McGrath's avatar
Roland McGrath committed
130 131 132 133 134 135 136 137 138

Lisp_Object Qfundamental_mode, Qmode_class, Qpermanent_local;

Lisp_Object Qprotected_field;

Lisp_Object QSFundamental;	/* A string "Fundamental" */

Lisp_Object Qkill_buffer_hook;

Richard M. Stallman's avatar
Richard M. Stallman committed
139 140
Lisp_Object Qget_file_buffer;

Jim Blandy's avatar
Jim Blandy committed
141 142
Lisp_Object Qoverlayp;

Karl Heuer's avatar
Karl Heuer committed
143
Lisp_Object Qpriority, Qwindow, Qevaporate;
144

145 146 147 148
Lisp_Object Qmodification_hooks;
Lisp_Object Qinsert_in_front_hooks;
Lisp_Object Qinsert_behind_hooks;

Roland McGrath's avatar
Roland McGrath committed
149 150 151 152 153 154
/* For debugging; temporary.  See set_buffer_internal.  */
/* Lisp_Object Qlisp_mode, Vcheck_symbol; */

nsberror (spec)
     Lisp_Object spec;
{
155
  if (STRINGP (spec))
Roland McGrath's avatar
Roland McGrath committed
156 157 158 159 160 161 162 163 164 165 166
    error ("No buffer named %s", XSTRING (spec)->data);
  error ("Invalid buffer argument");
}

DEFUN ("buffer-list", Fbuffer_list, Sbuffer_list, 0, 0, 0,
  "Return a list of all existing live buffers.")
  ()
{
  return Fmapcar (Qcdr, Vbuffer_alist);
}

167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187
/* Like Fassoc, but use Fstring_equal to compare
   (which ignores text properties),
   and don't ever QUIT.  */

static Lisp_Object
assoc_ignore_text_properties (key, list)
     register Lisp_Object key;
     Lisp_Object list;
{
  register Lisp_Object tail;
  for (tail = list; !NILP (tail); tail = Fcdr (tail))
    {
      register Lisp_Object elt, tem;
      elt = Fcar (tail);
      tem = Fstring_equal (Fcar (elt), key);
      if (!NILP (tem))
	return elt;
    }
  return Qnil;
}

Roland McGrath's avatar
Roland McGrath committed
188 189 190 191 192 193 194
DEFUN ("get-buffer", Fget_buffer, Sget_buffer, 1, 1, 0,
  "Return the buffer named NAME (a string).\n\
If there is no live buffer named NAME, return nil.\n\
NAME may also be a buffer; if so, the value is that buffer.")
  (name)
     register Lisp_Object name;
{
195
  if (BUFFERP (name))
Roland McGrath's avatar
Roland McGrath committed
196 197 198
    return name;
  CHECK_STRING (name, 0);

199
  return Fcdr (assoc_ignore_text_properties (name, Vbuffer_alist));
Roland McGrath's avatar
Roland McGrath committed
200 201 202 203
}

DEFUN ("get-file-buffer", Fget_file_buffer, Sget_file_buffer, 1, 1, 0,
  "Return the buffer visiting file FILENAME (a string).\n\
Karl Heuer's avatar
Karl Heuer committed
204
The buffer's `buffer-file-name' must match exactly the expansion of FILENAME.\n\
205 206
If there is no such live buffer, return nil.\n\
See also `find-buffer-visiting'.")
Roland McGrath's avatar
Roland McGrath committed
207 208 209 210
  (filename)
     register Lisp_Object filename;
{
  register Lisp_Object tail, buf, tem;
Richard M. Stallman's avatar
Richard M. Stallman committed
211 212
  Lisp_Object handler;

Roland McGrath's avatar
Roland McGrath committed
213 214 215
  CHECK_STRING (filename, 0);
  filename = Fexpand_file_name (filename, Qnil);

Richard M. Stallman's avatar
Richard M. Stallman committed
216 217
  /* If the file name has special constructs in it,
     call the corresponding file handler.  */
218
  handler = Ffind_file_name_handler (filename, Qget_file_buffer);
Richard M. Stallman's avatar
Richard M. Stallman committed
219 220 221
  if (!NILP (handler))
    return call2 (handler, Qget_file_buffer, filename);

Roland McGrath's avatar
Roland McGrath committed
222 223 224
  for (tail = Vbuffer_alist; CONSP (tail); tail = XCONS (tail)->cdr)
    {
      buf = Fcdr (XCONS (tail)->car);
225 226
      if (!BUFFERP (buf)) continue;
      if (!STRINGP (XBUFFER (buf)->filename)) continue;
Roland McGrath's avatar
Roland McGrath committed
227
      tem = Fstring_equal (XBUFFER (buf)->filename, filename);
Jim Blandy's avatar
Jim Blandy committed
228
      if (!NILP (tem))
Roland McGrath's avatar
Roland McGrath committed
229 230 231 232 233 234 235 236 237 238 239
	return buf;
    }
  return Qnil;
}

/* Incremented for each buffer created, to assign the buffer number. */
int buffer_count;

DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 1, 0,
  "Return the buffer named NAME, or create such a buffer and return it.\n\
A new buffer is created if there is no live buffer named NAME.\n\
240
If NAME starts with a space, the new buffer does not keep undo information.\n\
Roland McGrath's avatar
Roland McGrath committed
241 242 243 244 245
If NAME is a buffer instead of a string, then it is the value returned.\n\
The value is never nil.")  
  (name)
     register Lisp_Object name;
{
246
  register Lisp_Object buf;
Roland McGrath's avatar
Roland McGrath committed
247 248 249
  register struct buffer *b;

  buf = Fget_buffer (name);
Jim Blandy's avatar
Jim Blandy committed
250
  if (!NILP (buf))
Roland McGrath's avatar
Roland McGrath committed
251 252
    return buf;

253 254 255
  if (XSTRING (name)->size == 0)
    error ("Empty string for buffer name is not allowed");

256
  b = (struct buffer *) xmalloc (sizeof (struct buffer));
Roland McGrath's avatar
Roland McGrath committed
257 258

  BUF_GAP_SIZE (b) = 20;
259
  BLOCK_INPUT;
Roland McGrath's avatar
Roland McGrath committed
260
  BUFFER_ALLOC (BUF_BEG_ADDR (b), BUF_GAP_SIZE (b));
261
  UNBLOCK_INPUT;
Roland McGrath's avatar
Roland McGrath committed
262 263 264 265 266 267 268 269 270 271
  if (! BUF_BEG_ADDR (b))
    memory_full ();

  BUF_PT (b) = 1;
  BUF_GPT (b) = 1;
  BUF_BEGV (b) = 1;
  BUF_ZV (b) = 1;
  BUF_Z (b) = 1;
  BUF_MODIFF (b) = 1;

272 273 274 275
  b->newline_cache = 0;
  b->width_run_cache = 0;
  b->width_table = Qnil;

Roland McGrath's avatar
Roland McGrath committed
276 277 278 279 280 281
  /* Put this on the chain of all buffers including killed ones.  */
  b->next = all_buffers;
  all_buffers = b;

  b->mark = Fmake_marker ();
  /*b->number = make_number (++buffer_count);*/
282 283 284

  name = Fcopy_sequence (name);
  INITIALIZE_INTERVAL (XSTRING (name), NULL_INTERVAL);
Roland McGrath's avatar
Roland McGrath committed
285
  b->name = name;
286

Roland McGrath's avatar
Roland McGrath committed
287 288 289 290 291 292
  if (XSTRING (name)->data[0] != ' ')
    b->undo_list = Qnil;
  else
    b->undo_list = Qt;

  reset_buffer (b);
293
  reset_buffer_local_variables (b);
Roland McGrath's avatar
Roland McGrath committed
294 295

  /* Put this in the alist of all live buffers.  */
296
  XSETBUFFER (buf, b);
Roland McGrath's avatar
Roland McGrath committed
297 298 299 300 301
  Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));

  b->mark = Fmake_marker ();
  b->markers = Qnil;
  b->name = name;
302
  return buf;
Roland McGrath's avatar
Roland McGrath committed
303 304
}

305 306
/* Reinitialize everything about a buffer except its name and contents
   and local variables.  */
Roland McGrath's avatar
Roland McGrath committed
307 308 309 310 311 312 313 314 315

void
reset_buffer (b)
     register struct buffer *b;
{
  b->filename = Qnil;
  b->directory = (current_buffer) ? current_buffer->directory : Qnil;
  b->modtime = 0;
  b->save_modified = 1;
316
  XSETFASTINT (b->save_length, 0);
Roland McGrath's avatar
Roland McGrath committed
317 318 319
  b->last_window_start = 1;
  b->backed_up = Qnil;
  b->auto_save_modified = 0;
320
  b->auto_save_failure_time = -1;
Roland McGrath's avatar
Roland McGrath committed
321 322
  b->auto_save_file_name = Qnil;
  b->read_only = Qnil;
323 324
  b->overlays_before = Qnil;
  b->overlays_after = Qnil;
325
  XSETFASTINT (b->overlay_center, 1);
326
  b->mark_active = Qnil;
327 328 329

  /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
  INITIALIZE_INTERVAL (b, NULL_INTERVAL);
Roland McGrath's avatar
Roland McGrath committed
330 331
}

332 333 334 335 336
/* Reset buffer B's local variables info.
   Don't use this on a buffer that has already been in use;
   it does not treat permanent locals consistently.
   Instead, use Fkill_all_local_variables.  */

337
reset_buffer_local_variables (b)
Roland McGrath's avatar
Roland McGrath committed
338 339 340 341 342 343 344 345 346 347 348 349 350 351 352
     register struct buffer *b;
{
  register int offset;

  /* Reset the major mode to Fundamental, together with all the
     things that depend on the major mode.
     default-major-mode is handled at a higher level.
     We ignore it here.  */
  b->major_mode = Qfundamental_mode;
  b->keymap = Qnil;
  b->abbrev_table = Vfundamental_mode_abbrev_table;
  b->mode_name = QSFundamental;
  b->minor_modes = Qnil;
  b->downcase_table = Vascii_downcase_table;
  b->upcase_table = Vascii_upcase_table;
353 354
  b->case_canon_table = Vascii_canon_table;
  b->case_eqv_table = Vascii_eqv_table;
Roland McGrath's avatar
Roland McGrath committed
355 356 357 358 359 360 361 362 363 364 365 366 367 368
#if 0
  b->sort_table = XSTRING (Vascii_sort_table);
  b->folding_sort_table = XSTRING (Vascii_folding_sort_table);
#endif /* 0 */

  /* Reset all per-buffer variables to their defaults.  */
  b->local_var_alist = Qnil;
  b->local_var_flags = 0;

  /* For each slot that has a default value,
     copy that into the slot.  */

  for (offset = (char *)&buffer_local_flags.name - (char *)&buffer_local_flags;
       offset < sizeof (struct buffer);
369
       offset += sizeof (Lisp_Object)) /* sizeof EMACS_INT == sizeof Lisp_Object */
370 371 372 373 374 375
    {
      int flag = XINT (*(Lisp_Object *)(offset + (char *)&buffer_local_flags));
      if (flag > 0 || flag == -2)
	*(Lisp_Object *)(offset + (char *)b) =
	  *(Lisp_Object *)(offset + (char *)&buffer_defaults);
    }
Roland McGrath's avatar
Roland McGrath committed
376 377
}

Roland McGrath's avatar
Roland McGrath committed
378 379 380 381 382
/* We split this away from generate-new-buffer, because rename-buffer
   and set-visited-file-name ought to be able to use this to really
   rename the buffer properly.  */

DEFUN ("generate-new-buffer-name", Fgenerate_new_buffer_name, Sgenerate_new_buffer_name,
383
  1, 2, 0,
Roland McGrath's avatar
Roland McGrath committed
384 385
  "Return a string that is the name of no existing buffer based on NAME.\n\
If there is no live buffer named NAME, then return NAME.\n\
Roland McGrath's avatar
Roland McGrath committed
386
Otherwise modify name by appending `<NUMBER>', incrementing NUMBER\n\
387
until an unused name is found, and then return that name.\n\
388
Optional second argument IGNORE specifies a name that is okay to use\n\
389
\(if it is in the sequence to be tried)\n\
390
even if a buffer with that name exists.")
391 392
 (name, ignore)
     register Lisp_Object name, ignore;
Roland McGrath's avatar
Roland McGrath committed
393 394 395 396 397 398 399 400
{
  register Lisp_Object gentemp, tem;
  int count;
  char number[10];

  CHECK_STRING (name, 0);

  tem = Fget_buffer (name);
Jim Blandy's avatar
Jim Blandy committed
401
  if (NILP (tem))
Roland McGrath's avatar
Roland McGrath committed
402
    return name;
Roland McGrath's avatar
Roland McGrath committed
403 404 405 406 407 408

  count = 1;
  while (1)
    {
      sprintf (number, "<%d>", ++count);
      gentemp = concat2 (name, build_string (number));
409
      tem = Fstring_equal (gentemp, ignore);
410 411
      if (!NILP (tem))
	return gentemp;
Roland McGrath's avatar
Roland McGrath committed
412
      tem = Fget_buffer (gentemp);
Jim Blandy's avatar
Jim Blandy committed
413
      if (NILP (tem))
Roland McGrath's avatar
Roland McGrath committed
414
	return gentemp;
Roland McGrath's avatar
Roland McGrath committed
415 416 417 418 419 420
    }
}


DEFUN ("buffer-name", Fbuffer_name, Sbuffer_name, 0, 1, 0,
  "Return the name of BUFFER, as a string.\n\
Roland McGrath's avatar
Roland McGrath committed
421
With no argument or nil as argument, return the name of the current buffer.")
Roland McGrath's avatar
Roland McGrath committed
422 423 424
  (buffer)
     register Lisp_Object buffer;
{
Jim Blandy's avatar
Jim Blandy committed
425
  if (NILP (buffer))
Roland McGrath's avatar
Roland McGrath committed
426 427 428 429 430 431 432 433 434 435 436
    return current_buffer->name;
  CHECK_BUFFER (buffer, 0);
  return XBUFFER (buffer)->name;
}

DEFUN ("buffer-file-name", Fbuffer_file_name, Sbuffer_file_name, 0, 1, 0,
  "Return name of file BUFFER is visiting, or nil if none.\n\
No argument or nil as argument means use the current buffer.")
  (buffer)
     register Lisp_Object buffer;
{
Jim Blandy's avatar
Jim Blandy committed
437
  if (NILP (buffer))
Roland McGrath's avatar
Roland McGrath committed
438 439 440 441 442 443 444 445
    return current_buffer->filename;
  CHECK_BUFFER (buffer, 0);
  return XBUFFER (buffer)->filename;
}

DEFUN ("buffer-local-variables", Fbuffer_local_variables,
  Sbuffer_local_variables, 0, 1, 0,
  "Return an alist of variables that are buffer-local in BUFFER.\n\
446 447
Most elements look like (SYMBOL . VALUE), describing one variable.\n\
For a symbol that is locally unbound, just the symbol appears in the value.\n\
Roland McGrath's avatar
Roland McGrath committed
448 449 450 451 452 453
Note that storing new VALUEs in these elements doesn't change the variables.\n\
No argument or nil as argument means use current buffer as BUFFER.")
  (buffer)
     register Lisp_Object buffer;
{
  register struct buffer *buf;
454
  register Lisp_Object result;
Roland McGrath's avatar
Roland McGrath committed
455

Jim Blandy's avatar
Jim Blandy committed
456
  if (NILP (buffer))
Roland McGrath's avatar
Roland McGrath committed
457 458 459 460 461 462 463
    buf = current_buffer;
  else
    {
      CHECK_BUFFER (buffer, 0);
      buf = XBUFFER (buffer);
    }

464 465
  result = Qnil;

Roland McGrath's avatar
Roland McGrath committed
466 467 468 469 470 471
  {
    /* Reference each variable in the alist in our current buffer.
       If inquiring about the current buffer, this gets the current values,
       so store them into the alist so the alist is up to date.
       If inquiring about some other buffer, this swaps out any values
       for that buffer, making the alist up to date automatically.  */
472 473
    register Lisp_Object tail;
    for (tail = buf->local_var_alist; CONSP (tail); tail = XCONS (tail)->cdr)
Roland McGrath's avatar
Roland McGrath committed
474
      {
475 476 477 478
	Lisp_Object val, elt;

	elt = XCONS (tail)->car;

Roland McGrath's avatar
Roland McGrath committed
479
	if (buf == current_buffer)
480 481 482 483 484 485 486 487 488 489
	  val = find_symbol_value (XCONS (elt)->car);
	else
	  val = XCONS (elt)->cdr;

	/* If symbol is unbound, put just the symbol in the list.  */
	if (EQ (val, Qunbound))
	  result = Fcons (XCONS (elt)->car, result);
	/* Otherwise, put (symbol . value) in the list.  */
	else
	  result = Fcons (Fcons (XCONS (elt)->car, val), result);
Roland McGrath's avatar
Roland McGrath committed
490 491 492 493 494 495 496 497 498
      }
  }

  /* Add on all the variables stored in special slots.  */
  {
    register int offset, mask;

    for (offset = (char *)&buffer_local_symbols.name - (char *)&buffer_local_symbols;
	 offset < sizeof (struct buffer);
499
	 offset += (sizeof (EMACS_INT))) /* sizeof EMACS_INT == sizeof Lisp_Object */
Roland McGrath's avatar
Roland McGrath committed
500
      {
501
	mask = XINT (*(Lisp_Object *)(offset + (char *)&buffer_local_flags));
Roland McGrath's avatar
Roland McGrath committed
502
	if (mask == -1 || (buf->local_var_flags & mask))
503 504 505 506
	  if (SYMBOLP (*(Lisp_Object *)(offset
					+ (char *)&buffer_local_symbols)))
	    result = Fcons (Fcons (*((Lisp_Object *)
				     (offset + (char *)&buffer_local_symbols)),
507 508
				   *(Lisp_Object *)(offset + (char *)buf)),
			    result);
Roland McGrath's avatar
Roland McGrath committed
509 510
      }
  }
511 512

  return result;
Roland McGrath's avatar
Roland McGrath committed
513 514 515 516 517 518 519 520 521 522 523
}


DEFUN ("buffer-modified-p", Fbuffer_modified_p, Sbuffer_modified_p,
  0, 1, 0,
  "Return t if BUFFER was modified since its file was last read or saved.\n\
No argument or nil as argument means use current buffer as BUFFER.")
  (buffer)
     register Lisp_Object buffer;
{
  register struct buffer *buf;
Jim Blandy's avatar
Jim Blandy committed
524
  if (NILP (buffer))
Roland McGrath's avatar
Roland McGrath committed
525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549
    buf = current_buffer;
  else
    {
      CHECK_BUFFER (buffer, 0);
      buf = XBUFFER (buffer);
    }

  return buf->save_modified < BUF_MODIFF (buf) ? Qt : Qnil;
}

DEFUN ("set-buffer-modified-p", Fset_buffer_modified_p, Sset_buffer_modified_p,
  1, 1, 0,
  "Mark current buffer as modified or unmodified according to FLAG.\n\
A non-nil FLAG means mark the buffer modified.")
  (flag)
     register Lisp_Object flag;
{
  register int already;
  register Lisp_Object fn;

#ifdef CLASH_DETECTION
  /* If buffer becoming modified, lock the file.
     If buffer becoming unmodified, unlock the file.  */

  fn = current_buffer->filename;
Jim Blandy's avatar
Jim Blandy committed
550
  if (!NILP (fn))
Roland McGrath's avatar
Roland McGrath committed
551 552
    {
      already = current_buffer->save_modified < MODIFF;
Jim Blandy's avatar
Jim Blandy committed
553
      if (!already && !NILP (flag))
Roland McGrath's avatar
Roland McGrath committed
554
	lock_file (fn);
Jim Blandy's avatar
Jim Blandy committed
555
      else if (already && NILP (flag))
Roland McGrath's avatar
Roland McGrath committed
556 557 558 559
	unlock_file (fn);
    }
#endif /* CLASH_DETECTION */

Jim Blandy's avatar
Jim Blandy committed
560
  current_buffer->save_modified = NILP (flag) ? MODIFF : 0;
Roland McGrath's avatar
Roland McGrath committed
561 562 563 564 565 566 567 568 569 570 571 572 573 574
  update_mode_lines++;
  return flag;
}

DEFUN ("buffer-modified-tick", Fbuffer_modified_tick, Sbuffer_modified_tick,
  0, 1, 0,
  "Return BUFFER's tick counter, incremented for each change in text.\n\
Each buffer has a tick counter which is incremented each time the text in\n\
that buffer is changed.  It wraps around occasionally.\n\
No argument or nil as argument means use current buffer as BUFFER.")
  (buffer)
     register Lisp_Object buffer;
{
  register struct buffer *buf;
Jim Blandy's avatar
Jim Blandy committed
575
  if (NILP (buffer))
Roland McGrath's avatar
Roland McGrath committed
576 577 578 579 580 581 582 583 584 585
    buf = current_buffer;
  else
    {
      CHECK_BUFFER (buffer, 0);
      buf = XBUFFER (buffer);
    }

  return make_number (BUF_MODIFF (buf));
}

Roland McGrath's avatar
Roland McGrath committed
586
DEFUN ("rename-buffer", Frename_buffer, Srename_buffer, 1, 2,
587
       "sRename buffer (to new name): \nP",
Roland McGrath's avatar
Roland McGrath committed
588
  "Change current buffer's name to NEWNAME (a string).\n\
589
If second arg UNIQUE is nil or omitted, it is an error if a\n\
Roland McGrath's avatar
Roland McGrath committed
590
buffer named NEWNAME already exists.\n\
591
If UNIQUE is non-nil, come up with a new name using\n\
Roland McGrath's avatar
Roland McGrath committed
592
`generate-new-buffer-name'.\n\
593 594
Interactively, you can set UNIQUE with a prefix argument.\n\
We return the name we actually gave the buffer.\n\
Roland McGrath's avatar
Roland McGrath committed
595
This does not change the name of the visited file (if any).")
596 597
  (newname, unique)
     register Lisp_Object newname, unique;
Roland McGrath's avatar
Roland McGrath committed
598 599 600
{
  register Lisp_Object tem, buf;

601
  CHECK_STRING (newname, 0);
602

603
  if (XSTRING (newname)->size == 0)
604 605
    error ("Empty string is invalid as a buffer name");

606
  tem = Fget_buffer (newname);
607 608 609
  /* Don't short-circuit if UNIQUE is t.  That is a useful way to rename
     the buffer automatically so you can create another with the original name.
     It makes UNIQUE equivalent to
610
     (rename-buffer (generate-new-buffer-name NEWNAME)).  */
611
  if (NILP (unique) && XBUFFER (tem) == current_buffer)
612
    return current_buffer->name;
Jim Blandy's avatar
Jim Blandy committed
613
  if (!NILP (tem))
Roland McGrath's avatar
Roland McGrath committed
614
    {
615
      if (!NILP (unique))
616
	newname = Fgenerate_new_buffer_name (newname, current_buffer->name);
Roland McGrath's avatar
Roland McGrath committed
617
      else
618
	error ("Buffer name `%s' is in use", XSTRING (newname)->data);
Roland McGrath's avatar
Roland McGrath committed
619
    }
Roland McGrath's avatar
Roland McGrath committed
620

621
  current_buffer->name = newname;
622 623 624 625 626

  /* Catch redisplay's attention.  Unless we do this, the mode lines for
     any windows displaying current_buffer will stay unchanged.  */
  update_mode_lines++;

627
  XSETBUFFER (buf, current_buffer);
628
  Fsetcar (Frassq (buf, Vbuffer_alist), newname);
629 630
  if (NILP (current_buffer->filename)
      && !NILP (current_buffer->auto_save_file_name))
Roland McGrath's avatar
Roland McGrath committed
631
    call0 (intern ("rename-auto-save-file"));
632 633
  /* Refetch since that last call may have done GC.  */
  return current_buffer->name;
Roland McGrath's avatar
Roland McGrath committed
634 635
}

636
DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 2, 0,
Roland McGrath's avatar
Roland McGrath committed
637
  "Return most recently selected buffer other than BUFFER.\n\
638 639
Buffers not visible in windows are preferred to visible buffers,\n\
unless optional second argument VISIBLE-OK is non-nil.\n\
Roland McGrath's avatar
Roland McGrath committed
640 641
If no other buffer exists, the buffer `*scratch*' is returned.\n\
If BUFFER is omitted or nil, some interesting buffer is returned.")
642 643
  (buffer, visible_ok)
     register Lisp_Object buffer, visible_ok;
Roland McGrath's avatar
Roland McGrath committed
644 645 646 647
{
  register Lisp_Object tail, buf, notsogood, tem;
  notsogood = Qnil;

Jim Blandy's avatar
Jim Blandy committed
648
  for (tail = Vbuffer_alist; !NILP (tail); tail = Fcdr (tail))
Roland McGrath's avatar
Roland McGrath committed
649 650 651 652 653 654
    {
      buf = Fcdr (Fcar (tail));
      if (EQ (buf, buffer))
	continue;
      if (XSTRING (XBUFFER (buf)->name)->data[0] == ' ')
	continue;
655 656 657 658 659 660 661 662 663 664 665 666
#ifdef MULTI_FRAME
      /* If the selected frame has a buffer_predicate,
	 disregard buffers that don't fit the predicate.  */
      tem = frame_buffer_predicate ();
      if (!NILP (tem))
	{
	  tem = call1 (tem, buf);
	  if (NILP (tem))
	    continue;
	}
#endif

667
      if (NILP (visible_ok))
668
	tem = Fget_buffer_window (buf, Qt);
669 670
      else
	tem = Qnil;
Jim Blandy's avatar
Jim Blandy committed
671
      if (NILP (tem))
Roland McGrath's avatar
Roland McGrath committed
672
	return buf;
Jim Blandy's avatar
Jim Blandy committed
673
      if (NILP (notsogood))
Roland McGrath's avatar
Roland McGrath committed
674 675
	notsogood = buf;
    }
Jim Blandy's avatar
Jim Blandy committed
676
  if (!NILP (notsogood))
Roland McGrath's avatar
Roland McGrath committed
677 678 679 680
    return notsogood;
  return Fget_buffer_create (build_string ("*scratch*"));
}

681
DEFUN ("buffer-disable-undo", Fbuffer_disable_undo, Sbuffer_disable_undo, 0, 1,
Roland McGrath's avatar
Roland McGrath committed
682
0,
683 684
  "Make BUFFER stop keeping undo information.\n\
No argument or nil as argument means do this for the current buffer.")
Jim Blandy's avatar
Jim Blandy committed
685 686
  (buffer)
     register Lisp_Object buffer;
Roland McGrath's avatar
Roland McGrath committed
687
{
Jim Blandy's avatar
Jim Blandy committed
688 689 690
  Lisp_Object real_buffer;

  if (NILP (buffer))
691
    XSETBUFFER (real_buffer, current_buffer);
Jim Blandy's avatar
Jim Blandy committed
692 693 694 695 696 697 698 699 700
  else
    {
      real_buffer = Fget_buffer (buffer);
      if (NILP (real_buffer))
	nsberror (buffer);
    }

  XBUFFER (real_buffer)->undo_list = Qt;

Roland McGrath's avatar
Roland McGrath committed
701 702 703 704 705 706 707
  return Qnil;
}

DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, Sbuffer_enable_undo,
       0, 1, "",
  "Start keeping undo information for buffer BUFFER.\n\
No argument or nil as argument means do this for the current buffer.")
Jim Blandy's avatar
Jim Blandy committed
708 709
  (buffer)
     register Lisp_Object buffer;
Roland McGrath's avatar
Roland McGrath committed
710
{
Jim Blandy's avatar
Jim Blandy committed
711
  Lisp_Object real_buffer;
Roland McGrath's avatar
Roland McGrath committed
712

Jim Blandy's avatar
Jim Blandy committed
713
  if (NILP (buffer))
714
    XSETBUFFER (real_buffer, current_buffer);
Roland McGrath's avatar
Roland McGrath committed
715 716
  else
    {
Jim Blandy's avatar
Jim Blandy committed
717 718 719
      real_buffer = Fget_buffer (buffer);
      if (NILP (real_buffer))
	nsberror (buffer);
Roland McGrath's avatar
Roland McGrath committed
720 721
    }

Jim Blandy's avatar
Jim Blandy committed
722 723
  if (EQ (XBUFFER (real_buffer)->undo_list, Qt))
    XBUFFER (real_buffer)->undo_list = Qnil;
Roland McGrath's avatar
Roland McGrath committed
724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753

  return Qnil;
}

/*
  DEFVAR_LISP ("kill-buffer-hook", no_cell, "\
Hook to be run (by `run-hooks', which see) when a buffer is killed.\n\
The buffer being killed will be current while the hook is running.\n\
See `kill-buffer'."
 */
DEFUN ("kill-buffer", Fkill_buffer, Skill_buffer, 1, 1, "bKill buffer: ",
  "Kill the buffer BUFFER.\n\
The argument may be a buffer or may be the name of a buffer.\n\
An argument of nil means kill the current buffer.\n\n\
Value is t if the buffer is actually killed, nil if user says no.\n\n\
The value of `kill-buffer-hook' (which may be local to that buffer),\n\
if not void, is a list of functions to be called, with no arguments,\n\
before the buffer is actually killed.  The buffer to be killed is current\n\
when the hook functions are called.\n\n\
Any processes that have this buffer as the `process-buffer' are killed\n\
with `delete-process'.")
  (bufname)
     Lisp_Object bufname;
{
  Lisp_Object buf;
  register struct buffer *b;
  register Lisp_Object tem;
  register struct Lisp_Marker *m;
  struct gcpro gcpro1, gcpro2;

Jim Blandy's avatar
Jim Blandy committed
754
  if (NILP (bufname))
Roland McGrath's avatar
Roland McGrath committed
755 756 757
    buf = Fcurrent_buffer ();
  else
    buf = Fget_buffer (bufname);
Jim Blandy's avatar
Jim Blandy committed
758
  if (NILP (buf))
Roland McGrath's avatar
Roland McGrath committed
759 760 761 762 763
    nsberror (bufname);

  b = XBUFFER (buf);

  /* Query if the buffer is still modified.  */
Jim Blandy's avatar
Jim Blandy committed
764
  if (INTERACTIVE && !NILP (b->filename)
Roland McGrath's avatar
Roland McGrath committed
765 766 767 768 769 770
      && BUF_MODIFF (b) > b->save_modified)
    {
      GCPRO2 (buf, bufname);
      tem = do_yes_or_no_p (format1 ("Buffer %s modified; kill anyway? ",
				     XSTRING (b->name)->data));
      UNGCPRO;
Jim Blandy's avatar
Jim Blandy committed
771
      if (NILP (tem))
Roland McGrath's avatar
Roland McGrath committed
772 773 774
	return Qnil;
    }

775
  /* Run hooks with the buffer to be killed the current buffer.  */
Roland McGrath's avatar
Roland McGrath committed
776 777 778
  {
    register Lisp_Object val;
    int count = specpdl_ptr - specpdl;
779
    Lisp_Object list;
Roland McGrath's avatar
Roland McGrath committed
780 781 782

    record_unwind_protect (save_excursion_restore, save_excursion_save ());
    set_buffer_internal (b);
783 784 785 786 787 788 789 790 791 792 793

    /* First run the query functions; if any query is answered no,
       don't kill the buffer.  */
    for (list = Vkill_buffer_query_functions; !NILP (list); list = Fcdr (list))
      {
	tem = call0 (Fcar (list));
	if (NILP (tem))
	  return unbind_to (count, Qnil);
      }

    /* Then run the hooks.  */
794 795
    if (!NILP (Vrun_hooks))
      call1 (Vrun_hooks, Qkill_buffer_hook);
Roland McGrath's avatar
Roland McGrath committed
796 797 798 799 800 801 802 803 804 805 806
    unbind_to (count, Qnil);
  }

  /* We have no more questions to ask.  Verify that it is valid
     to kill the buffer.  This must be done after the questions
     since anything can happen within do_yes_or_no_p.  */

  /* Don't kill the minibuffer now current.  */
  if (EQ (buf, XWINDOW (minibuf_window)->buffer))
    return Qnil;

Jim Blandy's avatar
Jim Blandy committed
807
  if (NILP (b->name))
Roland McGrath's avatar
Roland McGrath committed
808 809 810 811 812 813 814
    return Qnil;

  /* Make this buffer not be current.
     In the process, notice if this is the sole visible buffer
     and give up if so.  */
  if (b == current_buffer)
    {
815
      tem = Fother_buffer (buf, Qnil);
Roland McGrath's avatar
Roland McGrath committed
816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835
      Fset_buffer (tem);
      if (b == current_buffer)
	return Qnil;
    }

  /* Now there is no question: we can kill the buffer.  */

#ifdef CLASH_DETECTION
  /* Unlock this buffer's file, if it is locked.  */
  unlock_buffer (b);
#endif /* CLASH_DETECTION */

  kill_buffer_processes (buf);

  tem = Vinhibit_quit;
  Vinhibit_quit = Qt;
  Vbuffer_alist = Fdelq (Frassq (buf, Vbuffer_alist), Vbuffer_alist);
  Freplace_buffer_in_windows (buf);
  Vinhibit_quit = tem;

836
  /* Delete any auto-save file, if we saved it in this session.  */
837
  if (STRINGP (b->auto_save_file_name)
838
      && b->auto_save_modified != 0)
Roland McGrath's avatar
Roland McGrath committed
839 840 841
    {
      Lisp_Object tem;
      tem = Fsymbol_value (intern ("delete-auto-save-files"));
Jim Blandy's avatar
Jim Blandy committed
842
      if (! NILP (tem))
843
	internal_delete_file (b->auto_save_file_name);
Roland McGrath's avatar
Roland McGrath committed
844 845 846 847 848 849 850 851 852 853 854 855 856
    }

  /* Unchain all markers of this buffer
     and leave them pointing nowhere.  */
  for (tem = b->markers; !EQ (tem, Qnil); )
    {
      m = XMARKER (tem);
      m->buffer = 0;
      tem = m->chain;
      m->chain = Qnil;
    }
  b->markers = Qnil;

857 858 859 860
  /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
  INITIALIZE_INTERVAL (b, NULL_INTERVAL);
  /* Perhaps we should explicitly free the interval tree here... */

Roland McGrath's avatar
Roland McGrath committed
861
  b->name = Qnil;
862
  BLOCK_INPUT;
Roland McGrath's avatar
Roland McGrath committed
863
  BUFFER_FREE (BUF_BEG_ADDR (b));
864 865 866 867 868 869 870 871 872 873 874
  if (b->newline_cache)
    {
      free_region_cache (b->newline_cache);
      b->newline_cache = 0;
    }
  if (b->width_run_cache)
    {
      free_region_cache (b->width_run_cache);
      b->width_run_cache = 0;
    }
  b->width_table = Qnil;
875
  UNBLOCK_INPUT;
Roland McGrath's avatar
Roland McGrath committed
876 877 878 879 880
  b->undo_list = Qnil;

  return Qt;
}

Jim Blandy's avatar
Jim Blandy committed
881 882 883 884
/* Move the assoc for buffer BUF to the front of buffer-alist.  Since
   we do this each time BUF is selected visibly, the more recently
   selected buffers are always closer to the front of the list.  This
   means that other_buffer is more likely to choose a relevant buffer.  */
Roland McGrath's avatar
Roland McGrath committed
885 886 887 888 889 890 891 892 893 894 895 896 897 898

record_buffer (buf)
     Lisp_Object buf;
{
  register Lisp_Object link, prev;

  prev = Qnil;
  for (link = Vbuffer_alist; CONSP (link); link = XCONS (link)->cdr)
    {
      if (EQ (XCONS (XCONS (link)->car)->cdr, buf))
	break;
      prev = link;
    }

Jim Blandy's avatar
Jim Blandy committed
899 900
  /* Effectively do Vbuffer_alist = Fdelq (link, Vbuffer_alist);
     we cannot use Fdelq itself here because it allows quitting.  */
Roland McGrath's avatar
Roland McGrath committed
901

Jim Blandy's avatar
Jim Blandy committed
902
  if (NILP (prev))
Roland McGrath's avatar
Roland McGrath committed
903 904 905 906 907 908 909 910
    Vbuffer_alist = XCONS (Vbuffer_alist)->cdr;
  else
    XCONS (prev)->cdr = XCONS (XCONS (prev)->cdr)->cdr;
	
  XCONS(link)->cdr = Vbuffer_alist;
  Vbuffer_alist = link;
}

911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940
DEFUN ("set-buffer-major-mode", Fset_buffer_major_mode, Sset_buffer_major_mode, 1, 1, 0,
  "Set an appropriate major mode for BUFFER, according to `default-major-mode'.\n\
Use this function before selecting the buffer, since it may need to inspect\n\
the current buffer's major mode.")
  (buf)
     Lisp_Object buf;
{
  int count;
  Lisp_Object function;

  function = buffer_defaults.major_mode;
  if (NILP (function) && NILP (Fget (current_buffer->major_mode, Qmode_class)))
    function = current_buffer->major_mode;

  if (NILP (function) || EQ (function, Qfundamental_mode))
    return Qnil;

  count = specpdl_ptr - specpdl;

  /* To select a nonfundamental mode,
     select the buffer temporarily and then call the mode function. */

  record_unwind_protect (save_excursion_restore, save_excursion_save ());

  Fset_buffer (buf);
  call0 (function);

  return unbind_to (count, Qnil);
}

Roland McGrath's avatar
Roland McGrath committed
941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958
DEFUN ("switch-to-buffer", Fswitch_to_buffer, Sswitch_to_buffer, 1, 2, "BSwitch to buffer: ",
  "Select buffer BUFFER in the current window.\n\
BUFFER may be a buffer or a buffer name.\n\
Optional second arg NORECORD non-nil means\n\
do not put this buffer at the front of the list of recently selected ones.\n\
\n\
WARNING: This is NOT the way to work on another buffer temporarily\n\
within a Lisp program!  Use `set-buffer' instead.  That avoids messing with\n\
the window-buffer correspondences.")
  (bufname, norecord)
     Lisp_Object bufname, norecord;
{
  register Lisp_Object buf;
  Lisp_Object tem;

  if (EQ (minibuf_window, selected_window))
    error ("Cannot switch buffers in minibuffer window");
  tem = Fwindow_dedicated_p (selected_window);
Jim Blandy's avatar
Jim Blandy committed
959
  if (!NILP (tem))
Roland McGrath's avatar
Roland McGrath committed
960 961
    error ("Cannot switch buffers in a dedicated window");

Jim Blandy's avatar
Jim Blandy committed
962
  if (NILP (bufname))
963
    buf = Fother_buffer (Fcurrent_buffer (), Qnil);
Roland McGrath's avatar
Roland McGrath committed
964
  else
965 966 967 968 969 970 971 972
    {
      buf = Fget_buffer (bufname);
      if (NILP (buf))
	{
	  buf = Fget_buffer_create (bufname);
	  Fset_buffer_major_mode (buf);
	}
    }
Roland McGrath's avatar
Roland McGrath committed
973
  Fset_buffer (buf);
Jim Blandy's avatar
Jim Blandy committed
974
  if (NILP (norecord))
Roland McGrath's avatar
Roland McGrath committed
975 976 977
    record_buffer (buf);

  Fset_window_buffer (EQ (selected_window, minibuf_window)
978 979
		      ? Fnext_window (minibuf_window, Qnil, Qnil)
		      : selected_window,
Roland McGrath's avatar
Roland McGrath committed
980 981
		      buf);

982
  return buf;
Roland McGrath's avatar
Roland McGrath committed
983 984 985 986 987 988 989 990 991 992 993 994
}

DEFUN ("pop-to-buffer", Fpop_to_buffer, Spop_to_buffer, 1, 2, 0,
  "Select buffer BUFFER in some window, preferably a different one.\n\
If BUFFER is nil, then some other buffer is chosen.\n\
If `pop-up-windows' is non-nil, windows can be split to do this.\n\
If optional second arg OTHER-WINDOW is non-nil, insist on finding another\n\
window even if BUFFER is already visible in the selected window.")
  (bufname, other)
     Lisp_Object bufname, other;
{
  register Lisp_Object buf;
Jim Blandy's avatar
Jim Blandy committed
995
  if (NILP (bufname))
996
    buf = Fother_buffer (Fcurrent_buffer (), Qnil);
Roland McGrath's avatar
Roland McGrath committed
997 998 999 1000 1001
  else
    buf = Fget_buffer_create (bufname);
  Fset_buffer (buf);
  record_buffer (buf);
  Fselect_window (Fdisplay_buffer (buf, other));
1002
  return buf;
Roland McGrath's avatar
Roland McGrath committed
1003 1004 1005 1006 1007 1008 1009
}

DEFUN ("current-buffer", Fcurrent_buffer, Scurrent_buffer, 0, 0, 0,
  "Return the current buffer as a Lisp object.")
  ()
{
  register Lisp_Object buf;
1010
  XSETBUFFER (buf, current_buffer);
Roland McGrath's avatar
Roland McGrath committed
1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021
  return buf;
}

/* Set the current buffer to b */

void
set_buffer_internal (b)
     register struct buffer *b;
{
  register struct buffer *old_buf;
  register Lisp_Object tail, valcontents;
1022
  Lisp_Object tem;
Roland McGrath's avatar
Roland McGrath committed
1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034

  if (current_buffer == b)
    return;

  windows_or_buffers_changed = 1;
  old_buf = current_buffer;
  current_buffer = b;
  last_known_column_point = -1;   /* invalidate indentation cache */

  /* Look down buffer's list of local Lisp variables
     to find and update any that forward into C variables. */

Jim Blandy's avatar
Jim Blandy committed
1035
  for (tail = b->local_var_alist; !NILP (tail); tail = XCONS (tail)->cdr)
Roland McGrath's avatar
Roland McGrath committed
1036 1037
    {
      valcontents = XSYMBOL (XCONS (XCONS (tail)->car)->car)->value;
1038 1039
      if ((BUFFER_LOCAL_VALUEP (valcontents)
	   || SOME_BUFFER_LOCAL_VALUEP (valcontents))
1040
	  && (tem = XBUFFER_LOCAL_VALUE (valcontents)->car,
1041
	      (BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem))))
Roland McGrath's avatar
Roland McGrath committed
1042 1043 1044 1045 1046 1047 1048 1049
	/* Just reference the variable
	     to cause it to become set for this buffer.  */
	Fsymbol_value (XCONS (XCONS (tail)->car)->car);
    }

  /* Do the same with any others that were local to the previous buffer */

  if (old_buf)
Jim Blandy's avatar
Jim Blandy committed
1050
    for (tail = old_buf->local_var_alist; !NILP (tail); tail = XCONS (tail)->cdr)
Roland McGrath's avatar
Roland McGrath committed
1051 1052
      {
	valcontents = XSYMBOL (XCONS (XCONS (tail)->car)->car)->value;
1053 1054
	if ((BUFFER_LOCAL_VALUEP (valcontents)
	     || SOME_BUFFER_LOCAL_VALUEP (valcontents))
1055
	    && (tem = XBUFFER_LOCAL_VALUE (valcontents)->car,
1056
		(BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem))))
Roland McGrath's avatar
Roland McGrath committed
1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074
	  /* Just reference the variable
               to cause it to become set for this buffer.  */
	  Fsymbol_value (XCONS (XCONS (tail)->car)->car);
      }
}

DEFUN ("set-buffer", Fset_buffer, Sset_buffer, 1, 1, 0,
  "Make the buffer BUFFER current for editing operations.\n\
BUFFER may be a buffer or the name of an existing buffer.\n\
See also `save-excursion' when you want to make a buffer current temporarily.\n\
This function does not display the buffer, so its effect ends\n\
when the current command terminates.\n\
Use `switch-to-buffer' or `pop-to-buffer' to switch buffers permanently.")
  (bufname)
     register Lisp_Object bufname;
{
  register Lisp_Object buffer;
  buffer = Fget_buffer (bufname);
Jim Blandy's avatar
Jim Blandy committed
1075
  if (NILP (buffer))
Roland McGrath's avatar
Roland McGrath committed
1076
    nsberror (bufname);
Jim Blandy's avatar
Jim Blandy committed
1077
  if (NILP (XBUFFER (buffer)->name))
Roland McGrath's avatar
Roland McGrath committed
1078 1079 1080 1081 1082 1083 1084 1085 1086 1087
    error ("Selecting deleted buffer");
  set_buffer_internal (XBUFFER (buffer));
  return buffer;
}

DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only,
				   Sbarf_if_buffer_read_only, 0, 0, 0,
  "Signal a `buffer-read-only' error if the current buffer is read-only.")
  ()
{
1088 1089
  if (!NILP (current_buffer->read_only)
      && NILP (Vinhibit_read_only))
Roland McGrath's avatar
Roland McGrath committed
1090 1091 1092 1093 1094 1095 1096
    Fsignal (Qbuffer_read_only, (Fcons (Fcurrent_buffer (), Qnil)));
  return Qnil;
}

DEFUN ("bury-buffer", Fbury_buffer, Sbury_buffer, 0, 1, "",
  "Put BUFFER at the end of the list of all buffers.\n\
There it is the least likely candidate for `other-buffer' to return;\n\
1097
thus, the least likely buffer for \\[switch-to-buffer] to select by default.\n\
1098 1099 1100
If BUFFER is nil or omitted, bury the current buffer.\n\
Also, if BUFFER is nil or omitted, remove the current buffer from the\n\
selected window if it is displayed there.")
Roland McGrath's avatar
Roland McGrath committed
1101 1102 1103
  (buf)
     register Lisp_Object buf;
{
1104
  /* Figure out what buffer we're going to bury.  */
Jim Blandy's avatar
Jim Blandy committed
1105
  if (NILP (buf))
1106
    {
1107
      XSETBUFFER (buf, current_buffer);
1108 1109

      /* If we're burying the current buffer, unshow it.  */
1110
      Fswitch_to_buffer (Fother_buffer (buf, Qnil), Qnil);
1111
    }
Roland McGrath's avatar
Roland McGrath committed
1112 1113 1114 1115 1116
  else
    {
      Lisp_Object buf1;
      
      buf1 = Fget_buffer (buf);
Jim Blandy's avatar
Jim Blandy committed
1117
      if (NILP (buf1))
Roland McGrath's avatar
Roland McGrath committed
1118 1119
	nsberror (buf);
      buf = buf1;
1120 1121
    }

1122
  /* Move buf to the end of the buffer list.  */
1123 1124 1125 1126 1127 1128 1129 1130 1131
  {
    register Lisp_Object aelt, link;

    aelt = Frassq (buf, Vbuffer_alist);
    link = Fmemq (aelt, Vbuffer_alist);
    Vbuffer_alist = Fdelq (aelt, Vbuffer_alist);
    XCONS (link)->cdr = Qnil;
    Vbuffer_alist = nconc2 (Vbuffer_alist, link);
  }
Roland McGrath's avatar
<