4.3BSD - /usr/src/new/emacs/src/buffer.c

   1: /* Buffer manipulation primitives for GNU Emacs.
   2:    Copyright (C) 1985 Richard M. Stallman.
   3: 
   4: This file is part of GNU Emacs.
   5: 
   6: GNU Emacs is distributed in the hope that it will be useful,
   7: but WITHOUT ANY WARRANTY.  No author or distributor
   8: accepts responsibility to anyone for the consequences of using it
   9: or for whether it serves any particular purpose or works at all,
  10: unless he says so in writing.  Refer to the GNU Emacs General Public
  11: License for full details.
  12: 
  13: Everyone is granted permission to copy, modify and redistribute
  14: GNU Emacs, but only under the conditions described in the
  15: GNU Emacs General Public License.   A copy of this license is
  16: supposed to have been given to you along with GNU Emacs so you
  17: can know your rights and responsibilities.  It should be in a
  18: file named COPYING.  Among other things, the copyright notice
  19: and this notice must be preserved on all copies.  */
  20: 
  21: 
  22: #include <sys/param.h>
  23: 
  24: #ifndef MAXPATHLEN
  25: /* in 4.1, param.h fails to define this. */
  26: #define MAXPATHLEN 1024
  27: #endif /* not MAXPATHLEN */
  28: 
  29: #undef NULL
  30: #include "config.h"
  31: #include "lisp.h"
  32: #include "window.h"
  33: #include "commands.h"
  34: #include "buffer.h"
  35: #include "syntax.h"
  36: 
  37: struct buffer *bf_cur;      /* the current buffer */
  38: 
  39: /* This structure contains data describing the text of the current buffer.
  40:  Switching buffers swaps their text data in and out of here */
  41: 
  42: struct buffer_text bf_text;
  43: 
  44: /* First buffer in chain of all buffers (in reverse order of creation).
  45:    Threaded through ->next.  */
  46: 
  47: struct buffer *all_buffers;
  48: 
  49: Lisp_Object Fset_buffer ();
  50: 
  51: /* Alist of all buffer names vs the buffers. */
  52: /* This used to be a variable, but is no longer,
  53:  to prevent lossage due to user rplac'ing this alist or its elements.  */
  54: Lisp_Object Vbuffer_alist;
  55: 
  56: /* Function to call to install major mode.
  57:   nil means use the major mode of the selected buffer.  */
  58: 
  59: Lisp_Object Vdefault_major_mode;
  60: 
  61: Lisp_Object Qfundamental_mode;
  62: 
  63: Lisp_Object QSFundamental;  /* A string "Fundamental" */
  64: 
  65: /* For debugging; temporary.  See SetBfp.  */
  66: Lisp_Object Qlisp_mode, Vcheck_symbol;
  67: 
  68: Lisp_Object Vdefault_mode_line_format;
  69: 
  70: int default_case_fold_search;
  71: 
  72: int default_tab_width;
  73: int default_ctl_arrow;
  74: int default_truncate_lines;
  75: 
  76: int default_fill_column;
  77: int default_left_margin;
  78: 
  79: Lisp_Object Vdefault_abbrev_mode;
  80: 
  81: nsberror (spec)
  82:      Lisp_Object spec;
  83: {
  84:   if (XTYPE (spec) == Lisp_String)
  85:     error ("No buffer named %s", XSTRING (spec)->data);
  86:   error ("Invalid buffer argument");
  87: }
  88: 
  89: DEFUN ("buffer-list", Fbuffer_list, Sbuffer_list, 0, 0, 0,
  90:   "Return a list of all buffers.")
  91:   ()
  92: {
  93:   return Fmapcar (Qcdr, Vbuffer_alist);
  94: }
  95: 
  96: DEFUN ("get-buffer", Fget_buffer, Sget_buffer, 1, 1, 0,
  97:   "Return the buffer named NAME (a string).\n\
  98: It is found by looking up NAME in  buffer-alist.\n\
  99: If there is no buffer named NAME, nil is returned.\n\
 100: NAME may also be a buffer; it is returned.")
 101:   (name)
 102:      Lisp_Object name;
 103: {
 104:   if (XTYPE (name) == Lisp_Buffer)
 105:     return name;
 106:   CHECK_STRING (name, 0);
 107: 
 108:   return Fcdr (Fassoc (name, Vbuffer_alist));
 109: }
 110: 
 111: DEFUN ("get-file-buffer", Fget_file_buffer, Sget_file_buffer, 1, 1, 0,
 112:   "Return the buffer visiting file FILENAME (a string).\n\
 113: If there is no such buffer, nil is returned.")
 114:   (filename)
 115:      Lisp_Object filename;
 116: {
 117:   register Lisp_Object tail, buf, tem;
 118:   CHECK_STRING (filename, 0);
 119:   filename = Fexpand_file_name (filename, Qnil);
 120: 
 121:   for (tail = Vbuffer_alist; LISTP (tail); tail = XCONS (tail)->cdr)
 122:     {
 123:       buf = Fcdr (XCONS (tail)->car);
 124:       if (XTYPE (buf) != Lisp_Buffer) continue;
 125:       if (XTYPE (XBUFFER (buf)->filename) != Lisp_String) continue;
 126:       tem = Fstring_equal (XBUFFER (buf)->filename, filename);
 127:       if (!NULL (tem))
 128:     return buf;
 129:     }
 130:   return Qnil;
 131: }
 132: 
 133: /* Incremented for each buffer created, to assign the buffer number. */
 134: int buffer_count;
 135: 
 136: DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 1, 0,
 137:   "Like get-buffer but creates a buffer named NAME and returns it if none already exists.")
 138:   (name)
 139:      Lisp_Object name;
 140: {
 141:   Lisp_Object buf, function;
 142:   int count = specpdl_ptr - specpdl;
 143:   register struct buffer *b;
 144:   struct buffer *bx;
 145:   unsigned char *data;
 146: 
 147:   buf = Fget_buffer (name);
 148:   if (!NULL (buf)) return buf;
 149: 
 150:   b = (struct buffer *) malloc (sizeof (struct buffer));
 151:   if (!b) memory_full ();
 152: 
 153:   data = (unsigned char *) malloc (b->text.gap = 20);
 154:   if (!data) memory_full ();
 155:   b->text.p1 = data - 1;
 156:   b->text.p2 = data - 1 + b->text.gap;
 157:   b->text.size1 = b->text.size2 = 0;
 158:   b->text.modified = 1;
 159:   b->text.pointloc = 1;
 160:   b->text.head_clip = 1;
 161:   b->text.tail_clip = 0;
 162: 
 163:   b->next = all_buffers;
 164:   all_buffers = b;
 165: 
 166:   b->save_length = make_number (0);
 167:   b->last_window_start = 1;
 168:   b->markers = Qnil;
 169:   b->mark = Qnil;
 170:   b->number = make_number (++buffer_count);
 171:   b->name = name;
 172:   if (XSTRING (name)->data[0] != ' ')
 173:     make_undo_records (b);
 174:   else
 175:     b->undodata = 0;
 176: 
 177:   reset_buffer (b);
 178: 
 179:   XSETTYPE (buf, Lisp_Buffer);
 180:   bx = b;           /* Use of bx avoids compiler bug on Sun */
 181:   XSETBUFFER (buf, bx);
 182:   Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));
 183: 
 184:   function = Vdefault_major_mode;
 185:   if (NULL (function))
 186:     function = bf_cur->major_mode;
 187: 
 188:   if (NULL (function) || EQ (function, Qfundamental_mode))
 189:     return buf;
 190: 
 191:   /* To select a nonfundamental mode,
 192:      select the buffer temporarily and then call the mode function. */
 193: 
 194:   record_unwind_protect (save_excursion_restore, save_excursion_save ());
 195: 
 196:   Fset_buffer (buf);
 197:   Fapply (function, Qnil);
 198: 
 199:   unbind_to (count);
 200:   return buf;
 201: }
 202: 
 203: void
 204: reset_buffer (b)
 205:      register struct buffer *b;
 206: {
 207:   b->filename = Qnil;
 208:   b->directory = (bf_cur) ? bf_cur->directory : Qnil;
 209:   b->modtime = 0;
 210:   b->save_modified = 1;
 211:   b->backed_up = *(int*) &Qnil;
 212:   b->auto_save_modified = 0;
 213:   b->auto_save_file_name = Qnil;
 214:   b->read_only = Qnil;
 215:   reset_buffer_local_variables(b);
 216: }
 217: 
 218: reset_buffer_local_variables(b)
 219:      register struct buffer *b;
 220: {
 221:   b->keymap = Qnil;
 222:   b->abbrev_table = Vfundamental_mode_abbrev_table;
 223:   b->tab_width = make_number (default_tab_width);
 224:   b->fill_column = make_number (default_fill_column);
 225:   b->left_margin = make_number (default_left_margin);
 226:   b->case_fold_search = default_case_fold_search ? Qt : Qnil;
 227: 
 228:   b->syntax_table_v = XVECTOR (Vstandard_syntax_table);
 229:   b->mode_line_format = Vdefault_mode_line_format;
 230:   b->auto_fill_hook = Qnil;
 231:   b->local_var_alist = Qnil;
 232:   b->ctl_arrow = default_ctl_arrow ? Qt : Qnil;
 233:   b->truncate_lines = default_truncate_lines ? Qt : Qnil;
 234:   b->selective_display = Qnil;
 235:   b->overwrite_mode = Qnil;
 236:   b->abbrev_mode = Vdefault_abbrev_mode;
 237: 
 238:   b->major_mode = Qfundamental_mode;
 239:   b->mode_name = QSFundamental;
 240:   b->minor_modes = Qnil;
 241: }
 242: 
 243: /* create-file-buffer moved into lisp code in lisp/files.el */
 244: 
 245: DEFUN ("generate-new-buffer", Fgenerate_new_buffer, Sgenerate_new_buffer,
 246:   1, 1, 0,
 247:   "Creates and returns a buffer named NAME if one does not already exist,\n\
 248: else tries adding successive suffixes to NAME until a new buffer-name is\n\
 249: formed, then creates and returns a new buffer with that new name.")
 250:  (name)
 251:      Lisp_Object name;
 252: {
 253:   Lisp_Object gentemp, tem;
 254:   int count;
 255:   char number[10];
 256: 
 257:   CHECK_STRING (name, 0);
 258: 
 259:   tem = Fget_buffer (name);
 260:   if (NULL (tem))
 261:     return Fget_buffer_create (name);
 262: 
 263:   count = 1;
 264:   while (1)
 265:     {
 266:       sprintf (number, "<%d>", ++count);
 267:       gentemp = concat2 (name, build_string (number));
 268:       tem = Fget_buffer (gentemp);
 269:       if (NULL (tem))
 270:     return Fget_buffer_create (gentemp);
 271:     }
 272: }
 273: 
 274: 
 275: DEFUN ("buffer-name", Fbuffer_name, Sbuffer_name, 0, 1, 0,
 276:   "Return the name of BUFFER, as a string.\n\
 277: No arg means return name of current buffer.")
 278:   (buffer)
 279:      Lisp_Object buffer;
 280: {
 281:   if (NULL (buffer))
 282:     return bf_cur->name;
 283:   CHECK_BUFFER (buffer, 0);
 284:   return XBUFFER (buffer)->name;
 285: }
 286: 
 287: DEFUN ("buffer-number", Fbuffer_number, Sbuffer_number, 0, 1, 0,
 288:   "Return the number of BUFFER.\n\
 289: No arg means return number of current buffer.")
 290:   (buffer)
 291:      Lisp_Object buffer;
 292: {
 293:   if (NULL (buffer))
 294:     return bf_cur->number;
 295:   CHECK_BUFFER (buffer, 0);
 296:   return XBUFFER (buffer)->number;
 297: }
 298: 
 299: DEFUN ("buffer-file-name", Fbuffer_file_name, Sbuffer_file_name, 0, 1, 0,
 300:   "Return name of file BUFFER is visiting, or NIL if none.\n\
 301: No argument means use current buffer as BUFFER.")
 302:   (buffer)
 303:      Lisp_Object buffer;
 304: {
 305:   if (NULL (buffer))
 306:     return bf_cur->filename;
 307:   CHECK_BUFFER (buffer, 0);
 308:   return XBUFFER (buffer)->filename;
 309: }
 310: 
 311: DEFUN ("buffer-local-variables", Fbuffer_local_variables,
 312:   Sbuffer_local_variables,
 313:   0, 1, 0,
 314:   "Return alist of buffer-local variables of BUFFER.\n\
 315: Each element looks like (SYMBOL . VALUE).\n\
 316: No argument means use current buffer as BUFFER.")
 317:   (buffer)
 318:      Lisp_Object buffer;
 319: {
 320:   if (NULL (buffer))
 321:     return bf_cur->local_var_alist;
 322:   CHECK_BUFFER (buffer, 0);
 323:   return XBUFFER (buffer)->local_var_alist;
 324: }
 325: 
 326: DEFUN ("buffer-modified-p", Fbuffer_modified_p, Sbuffer_modified_p,
 327:   0, 1, 0,
 328:   "Return t if BUFFER is modified since file last read in or saved.\n\
 329: No argument means use current buffer as BUFFER.")
 330:   (buffer)
 331:      Lisp_Object buffer;
 332: {
 333:   register struct buffer *buf;
 334:   if (NULL (buffer))
 335:     buf = bf_cur;
 336:   else
 337:     {
 338:       CHECK_BUFFER (buffer, 0);
 339:       buf = XBUFFER (buffer);
 340:     }
 341: 
 342:   bf_cur->text.modified = bf_modified;
 343:   return buf->save_modified < buf->text.modified ? Qt : Qnil;
 344: }
 345: 
 346: DEFUN ("set-buffer-modified-p", Fset_buffer_modified_p, Sset_buffer_modified_p,
 347:   1, 1, 0,
 348:   "Mark current buffer as modified or unmodified according to FLAG.")
 349:   (flag)
 350:      Lisp_Object flag;
 351: {
 352:   register int already;
 353:   register Lisp_Object fn;
 354: 
 355: #ifdef CLASH_DETECTION
 356:   /* If buffer becoming modified, lock the file.
 357:      If buffer becoming unmodified, unlock the file.  */
 358: 
 359:   fn = bf_cur->filename;
 360:   if (!NULL (fn))
 361:     {
 362:       already = bf_cur->save_modified < bf_modified;
 363:       if (!already && !NULL (flag))
 364:     lock_file (fn);
 365:       else if (already && NULL (flag))
 366:     unlock_file (fn);
 367:     }
 368: #endif /* CLASH_DETECTION */
 369: 
 370:   bf_cur->save_modified = NULL (flag) ? bf_modified : 0;
 371:   RedoModes++;
 372:   return flag;
 373: }
 374: 
 375: /* Return number of modified buffers that exist now. */
 376: 
 377: int
 378: ModExist ()
 379: {
 380:   register Lisp_Object tail, buf;
 381:   register struct buffer *b;
 382:   register int modcount = 0;
 383: 
 384:   bf_cur->text.modified = bf_modified;
 385: 
 386:   for (tail = Vbuffer_alist; !NULL (tail); tail = Fcdr (tail))
 387:     {
 388:       buf = Fcdr (Fcar (tail));
 389:       b = XBUFFER (buf);
 390:       if (!NULL (b->filename) && b->save_modified < b->text.modified)
 391:     modcount++;
 392:     }
 393: 
 394:   return modcount;
 395: }
 396: 
 397: DEFUN ("rename-buffer", Frename_buffer, Srename_buffer, 1, 1,
 398:   "sRename buffer (to new name): ",
 399:   "Change current buffer's name to NEWNAME (a string).")
 400:   (name)
 401:      Lisp_Object name;
 402: {
 403:   register Lisp_Object tem, buf;
 404: 
 405:   CHECK_STRING (name, 0);
 406:   tem = Fget_buffer (name);
 407:   if (!NULL (tem))
 408:     error("Buffer \"%s\" already exists", XSTRING (name)->data);
 409: 
 410:   bf_cur->name = name;
 411:   XSET (buf, Lisp_Buffer, bf_cur);
 412:   return Fsetcar (Frassq (buf, Vbuffer_alist), name);
 413: }
 414: 
 415: DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 1, 0,
 416:   "Return most recently selected buffer other than BUFFER.\n\
 417: Buffers not visible in windows are preferred to visible buffers.\n\
 418: If no other exists, the buffer *scratch* is returned.\n\
 419: If BUFFER is omitted or nil, some interesting buffer is returned.")
 420:   (buffer)
 421:      Lisp_Object buffer;
 422: {
 423:   register Lisp_Object tail, buf, notsogood, tem;
 424:   notsogood = Qnil;
 425: 
 426:   for (tail = Vbuffer_alist; !NULL (tail); tail = Fcdr (tail))
 427:     {
 428:       buf = Fcdr (Fcar (tail));
 429:       if (EQ (buf, buffer))
 430:     continue;
 431:       if (XSTRING (XBUFFER (buf)->name)->data[0] == ' ')
 432:     continue;
 433:       tem = Fget_buffer_window (buf);
 434:       if (NULL (tem))
 435:     return buf;
 436:       if (!NULL (notsogood))
 437:     notsogood = buf;
 438:     }
 439:   if (!NULL (notsogood))
 440:     return notsogood;
 441:   return Fget_buffer_create (build_string ("*scratch*"));
 442: }
 443: 
 444: DEFUN ("buffer-flush-undo", Fbuffer_flush_undo, Sbuffer_flush_undo, 1, 1, 0,
 445:   "Make BUFFER stop keeping undo information.")
 446:   (buf)
 447:      Lisp_Object buf;
 448: {
 449:   CHECK_BUFFER (buf, 0);
 450:   if (XBUFFER (buf)->undodata)
 451:     free_undo_records (XBUFFER (buf));
 452:   XBUFFER (buf)->undodata = 0;
 453:   return Qnil;
 454: }
 455: 
 456: Lisp_Object
 457: Fdelete_buffer_internal (buf)
 458:      Lisp_Object buf;
 459: {
 460:   register struct buffer *b = XBUFFER (buf);
 461:   register Lisp_Object tem;
 462:   register struct Lisp_Marker *m;
 463: 
 464:   if (NULL (b->name))
 465:     return Qnil;
 466: 
 467: #ifdef CLASH_DETECTION
 468:   /* Unlock this buffer's file, if it is locked.  */
 469:   Funlock_buffer ();
 470: #endif /* CLASH_DETECTION */
 471: 
 472:   /* make this buffer not be current */
 473:   if (b == bf_cur)
 474:     {
 475:       tem = Fother_buffer (buf);
 476:       if (NULL (tem))
 477:     tem = Fget_buffer_create (build_string ("*scratch*"));
 478:       Fset_buffer (tem);
 479:     }
 480: 
 481: #ifdef subprocesses
 482:   kill_buffer_processes (buf);
 483: #endif subprocesses
 484: 
 485:   Vbuffer_alist = Fdelq (Frassq (buf, Vbuffer_alist), Vbuffer_alist);
 486:   Freplace_buffer_in_windows (buf);
 487: 
 488:   /* Unchain all markers of this buffer
 489:      and leave them pointing nowhere.  */
 490:   for (tem = b->markers; !EQ (tem, Qnil); )
 491:     {
 492:       m = XMARKER (tem);
 493:       m->buffer = 0;
 494:       tem = m->chain;
 495:       m->chain = Qnil;
 496:     }
 497: 
 498:   b->name = Qnil;
 499:   free (b->text.p1 + 1);
 500:   if (b->undodata)
 501:     free_undo_records (b);
 502: 
 503:   return Qnil;
 504: }
 505: 
 506: DEFUN ("kill-buffer", Fkill_buffer, Skill_buffer, 1, 1, "bKill buffer: ",
 507:   "One arg, a string or a buffer.  Get rid of the specified buffer.")
 508:   (bufname)
 509:      Lisp_Object bufname;
 510: {
 511:   register Lisp_Object buf, answer;
 512: 
 513:   if (NULL (bufname))
 514:     buf = Fcurrent_buffer ();
 515:   else
 516:     buf = Fget_buffer (bufname);
 517:   if (NULL (buf))
 518:     nsberror (bufname);
 519:   bufname = XBUFFER (buf)->name;
 520: 
 521:   bf_cur->text.modified = bf_modified;
 522: 
 523:   if (INTERACTIVE && !NULL (XBUFFER (buf)->filename)
 524:       && XBUFFER (buf)->text.modified > XBUFFER (buf)->save_modified)
 525:     {
 526:       answer = Fyes_or_no_p (format1 ("Buffer %s modified; kill anyway? ",
 527:                       XSTRING (bufname)->data));
 528:       if (NULL (answer))
 529:     return Qnil;
 530:     }
 531:   Fdelete_buffer_internal (buf);
 532:   return Qnil;
 533: }
 534: 
 535: /* Put the element for buffer `buf' at the front of buffer-alist.
 536:  This is done when a buffer is selected "visibly".
 537:  It keeps buffer-alist in the order of recency of selection
 538:  so that other_buffer will return something nice.  */
 539: 
 540: record_buffer (buf)
 541:      Lisp_Object buf;
 542: {
 543:   register Lisp_Object aelt, link;
 544:   aelt = Frassq (buf, Vbuffer_alist);
 545:   link = Fmemq (aelt, Vbuffer_alist);
 546:   XCONS(link)->cdr = Fdelq (aelt, Vbuffer_alist);
 547:   Vbuffer_alist = link;
 548: }
 549: 
 550: DEFUN ("switch-to-buffer", Fswitch_to_buffer, Sswitch_to_buffer, 1, 2, "BSwitch to buffer: ",
 551:   "One arg, a string or buffer.  Select the specified buffer\n\
 552: in the current window.  Optional arg NORECORD non-nil means\n\
 553: do not put this buffer at the front of the list of recently selected ones.")
 554:   (bufname, norecord)
 555:      Lisp_Object bufname, norecord;
 556: {
 557:   register Lisp_Object buf;
 558:   if (NULL (bufname))
 559:     buf = Fother_buffer (Fcurrent_buffer ());
 560:   else
 561:     buf = Fget_buffer_create (bufname);
 562:   Fset_buffer (buf);
 563:   if (NULL (norecord))
 564:     record_buffer (buf);
 565: 
 566:   Fshow_buffer (EQ (selected_window, minibuf_window)
 567:           ? Fnext_window (minibuf_window, Qnil) : selected_window,
 568:         buf);
 569: 
 570:   return Qnil;
 571: }
 572: 
 573: DEFUN ("pop-to-buffer", Fpop_to_buffer, Spop_to_buffer, 1, 2, 0,
 574:   "Select buffer BUFFER in some window, preferably a different one.\n\
 575: If  pop-up-windows  is non-nil, windows can be split to do this.\n\
 576: If second arg  OTHER-WINDOW is non-nil, insist on finding another\n\
 577: window even if BUFFER is already visible in the selected window.")
 578:   (bufname, other)
 579:      Lisp_Object bufname, other;
 580: {
 581:   register Lisp_Object buf;
 582:   if (NULL (bufname))
 583:     buf = Fother_buffer (Fcurrent_buffer ());
 584:   else
 585:     buf = Fget_buffer_create (bufname);
 586:   Fset_buffer (buf);
 587:   record_buffer (buf);
 588:   Fselect_window (Fdisplay_buffer (buf, other));
 589:   return Qnil;
 590: }
 591: 
 592: DEFUN ("current-buffer", Fcurrent_buffer, Scurrent_buffer, 0, 0, 0,
 593:   "Return the current buffer as a Lisp buffer object.")
 594:   ()
 595: {
 596:   register Lisp_Object buf;
 597:   XSET (buf, Lisp_Buffer, bf_cur);
 598:   return buf;
 599: }
 600: 
 601: DEFUN ("set-buffer", Fset_buffer, Sset_buffer, 1, 1, 0,
 602:   "Set the current buffer to the buffer or buffer name supplied as argument.\n\
 603: That buffer will then be the default for editing operations and printing.\n\
 604: This function's effect can't last past end of current command\n\
 605: because returning to command level\n\
 606: selects the chosen buffer of the current window,\n\
 607: and this function has no effect on what buffer that is.\n\
 608: Use  switch-to-buffer  or  pop-to-buffer  for interactive buffer selection.")
 609:   (bufname)
 610:      Lisp_Object bufname;
 611: {
 612:   register Lisp_Object buffer;
 613:   buffer = Fget_buffer (bufname);
 614:   if (NULL (buffer))
 615:     nsberror (bufname);
 616:   SetBfp (XBUFFER (buffer));
 617:   return buffer;
 618: }
 619: 
 620: DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only,
 621:                    Sbarf_if_buffer_read_only, 0, 0, 0,
 622:   "Signal a  buffer-read-only  error if the current buffer is read-only.")
 623:   ()
 624: {
 625:   if (!NULL (bf_cur->read_only))
 626:     Fsignal (Qbuffer_read_only, Qnil);
 627:   return Qnil;
 628: }
 629: 
 630: DEFUN ("bury-buffer", Fbury_buffer, Sbury_buffer, 1, 1, 0,
 631:   "Put BUFFER at the end of the list of all buffers.\n\
 632: There it is the least likely candidate for other-buffer to return;\n\
 633: thus, the least likely buffer for \\[switch-to-buffer] to select by default.")
 634:   (buf)
 635:      Lisp_Object buf;
 636: {
 637:   register Lisp_Object aelt, link;
 638: 
 639:   buf = Fget_buffer (buf);
 640: 
 641:   aelt = Frassq (buf, Vbuffer_alist);
 642:   link = Fmemq (aelt, Vbuffer_alist);
 643:   Vbuffer_alist = Fdelq (aelt, Vbuffer_alist);
 644:   XCONS (link)->cdr = Qnil;
 645:   Vbuffer_alist = nconc2 (Vbuffer_alist, link);
 646:   return Qnil;
 647: }
 648: 
 649: extern int last_known_column_point;
 650: 
 651: /* set the current buffer to p */
 652: SetBfp (p)
 653:      register struct buffer *p;
 654: {
 655:   register struct buffer *c = bf_cur;
 656:   register struct window *w = XWINDOW (selected_window);
 657:   register struct buffer *swb;
 658:   Lisp_Object tail, valcontents;
 659:   enum Lisp_Type tem;
 660: 
 661:   if (c == p)
 662:     return;
 663: 
 664:   if (w)
 665:     swb = NULL (selected_window) ? 0 : XBUFFER (w->buffer);
 666: 
 667:   if (p && NULL (p->name))
 668:     error ("Selecting deleted buffer");
 669:   windows_or_buffers_changed = 1;
 670: 
 671:   if (c)
 672:     {
 673:       if (c == swb)
 674:     Fset_marker (w->pointm, make_number (point), w->buffer);
 675: 
 676:       if (point < FirstCharacter || point > NumCharacters + 1)
 677:     abort ();
 678: 
 679:       c->text = bf_text;
 680:     }
 681:   bf_cur = p;
 682:   bf_text = p->text;
 683:   if (p == swb)
 684:     {
 685:       SetPoint (marker_position (w->pointm));
 686:       if (point < FirstCharacter)
 687:     point = FirstCharacter;
 688:       if (point > NumCharacters + 1)
 689:     point = NumCharacters + 1;
 690:     }
 691:   last_known_column_point = -1;   /* invalidate indentation cache */
 692: 
 693:   /* Vcheck_symbol is set up to the symbol paragraph-start
 694:      in order to check for the bug that clobbers it.  */
 695:   if (c && EQ (c->major_mode, Qlisp_mode)
 696:       && XFASTINT (Vcheck_symbol) != 0
 697:       && !NULL (Vcheck_symbol))
 698:     {
 699:       valcontents = XSYMBOL (Vcheck_symbol)->value;
 700:       if (XTYPE (valcontents) != Lisp_Some_Buffer_Local_Value)
 701:     abort ();
 702:       if (c == XBUFFER (XCONS (XCONS (valcontents)->cdr)->car)
 703:       && (XTYPE (XCONS (valcontents)->car) != Lisp_String
 704:           || XSTRING (XCONS (valcontents)->car)->size != 6))
 705:     abort ();
 706:     }
 707: 
 708:   /* Look down buffer's list of local Lisp variables
 709:      to find and update any that forward into C variables. */
 710: 
 711:   for (tail = p->local_var_alist; !NULL (tail); tail = XCONS (tail)->cdr)
 712:     {
 713:       valcontents = XSYMBOL (XCONS (XCONS (tail)->car)->car)->value;
 714:       if ((XTYPE (valcontents) == Lisp_Buffer_Local_Value
 715:        || XTYPE (valcontents) == Lisp_Some_Buffer_Local_Value)
 716:       && (tem = XTYPE (XCONS (valcontents)->car),
 717:           (tem == Lisp_Boolfwd || tem == Lisp_Intfwd
 718:            || tem == Lisp_Objfwd)))
 719:     /* Just reference the variable
 720: 	     to cause it to become set for this buffer.  */
 721:     Fsymbol_value (XCONS (XCONS (tail)->car)->car);
 722:     }
 723: 
 724:   /* Do the same with any others that were local to the previous buffer */
 725: 
 726:   if (c)
 727:     for (tail = c->local_var_alist; !NULL (tail); tail = XCONS (tail)->cdr)
 728:       {
 729:     valcontents = XSYMBOL (XCONS (XCONS (tail)->car)->car)->value;
 730:     if ((XTYPE (valcontents) == Lisp_Buffer_Local_Value
 731:          || XTYPE (valcontents) == Lisp_Some_Buffer_Local_Value)
 732:         && (tem = XTYPE (XCONS (valcontents)->car),
 733:         (tem == Lisp_Boolfwd || tem == Lisp_Intfwd
 734:          || tem == Lisp_Objfwd)))
 735:       /* Just reference the variable
 736:                to cause it to become set for this buffer.  */
 737:       Fsymbol_value (XCONS (XCONS (tail)->car)->car);
 738:       }
 739:   /* Vcheck_symbol is set up to the symbol paragraph-start
 740:      in order to check for the bug that clobbers it.  */
 741:   if (EQ (p->major_mode, Qlisp_mode)
 742:       && Vcheck_symbol
 743:       && !NULL (Vcheck_symbol))
 744:     {
 745:       valcontents = XSYMBOL (Vcheck_symbol)->value;
 746:       if (XTYPE (valcontents) != Lisp_Some_Buffer_Local_Value)
 747:     abort ();
 748:       if (p == XBUFFER (XCONS (XCONS (valcontents)->cdr)->car)
 749:       && (XTYPE (XCONS (valcontents)->car) != Lisp_String
 750:           || XSTRING (XCONS (valcontents)->car)->size != 6))
 751:     abort ();
 752:       Fsymbol_value (Vcheck_symbol);
 753:       valcontents = XSYMBOL (Vcheck_symbol)->value;
 754:       if (p != XBUFFER (XCONS (XCONS (valcontents)->cdr)->car)
 755:       || XTYPE (XCONS (valcontents)->car) != Lisp_String
 756:       || XSTRING (XCONS (valcontents)->car)->size != 6)
 757:     abort ();
 758:     }
 759: }
 760: 
 761: /* set the current buffer to p "just for redisplay" */
 762: SetBfx (p)
 763:      register struct buffer *p;
 764: {
 765:   if (bf_cur == p)
 766:     return;
 767: 
 768:   bf_cur->text = bf_text;
 769:   bf_cur = p;
 770:   bf_text = p->text;
 771: }
 772: 
 773: DEFUN ("erase-buffer", Ferase_buffer, Serase_buffer, 0, 0, 0,
 774:   "Delete the entire contents of the current buffer.")
 775:   ()
 776: {
 777:   Fwiden ();
 778:   del_range (1, NumCharacters + 1);
 779:   bf_cur->last_window_start = 1;
 780:   return Qnil;
 781: }
 782: 
 783: validate_region (b, e)
 784:      register Lisp_Object *b, *e;
 785: {
 786:   register int i;
 787: 
 788:   CHECK_NUMBER_COERCE_MARKER (*b, 0);
 789:   CHECK_NUMBER_COERCE_MARKER (*e, 1);
 790: 
 791:   if (XINT (*b) > XINT (*e))
 792:     {
 793:       i = XFASTINT (*b);    /* This is legit even if *b is < 0 */
 794:       *b = *e;
 795:       XFASTINT (*e) = i;    /* because this is all we do with i.  */
 796:     }
 797: 
 798:   if (!(FirstCharacter <= XINT (*b) && XINT (*b) <= XINT (*e)
 799:         && XINT (*e) <= 1 + NumCharacters))
 800:     args_out_of_range (*b, *e);
 801: }
 802: 
 803: Lisp_Object
 804: list_buffers_1 (files)
 805:      Lisp_Object files;
 806: {
 807:   Lisp_Object tail, buf, col1, col2, col3, minspace, tem, mode;
 808:   register struct buffer *old = bf_cur, *b;
 809:   int desired_point = 0;
 810: 
 811:   bf_cur->text.modified = bf_modified;
 812: 
 813:   XFASTINT (col1) = 19;
 814:   XFASTINT (col2) = 25;
 815:   XFASTINT (col3) = 40;
 816:   XFASTINT (minspace) = 1;
 817: 
 818:   SetBfp (XBUFFER (Vstandard_output));
 819: 
 820:   mode = intern ("Buffer-menu-mode");
 821:   if (!EQ (mode, bf_cur->major_mode)
 822:       && (tem = Ffboundp (mode), !NULL (tem)))
 823:     Fapply (mode, Qnil);
 824:   Fbuffer_flush_undo (Vstandard_output);
 825:   bf_cur->read_only = Qnil;
 826: 
 827:   write_string ("\
 828:  MR Buffer         Size  Mode           File\n\
 829:  -- ------         ----  ----           ----\n", -1);
 830: 
 831:   for (tail = Vbuffer_alist; !NULL (tail); tail = Fcdr (tail))
 832:     {
 833:       buf = Fcdr (Fcar (tail));
 834:       b = XBUFFER (buf);
 835:       /* Don't mention the minibuffers. */
 836:       if (XSTRING (b->name)->data[0] == ' ')
 837:     continue;
 838:       /* Optionally don't mention buffers that lack files. */
 839:       if (!NULL (files) && NULL (b->filename))
 840:     continue;
 841:       /* Identify the current buffer. */
 842:       if (b == old)
 843:     desired_point = point;
 844:       write_string (b == old ? "." : " ", -1);
 845:       /* Identify modified buffers */
 846:       write_string (b->text.modified > b->save_modified ? "*" : " ", -1);
 847:       write_string (NULL (b->read_only) ? "  " : "% ", -1);
 848:       Fprinc (b->name, Qnil);
 849:       Findent_to (col1, make_number (2));
 850:       XFASTINT (tem) = b->text.size1 + b->text.size2;
 851:       Fprin1 (tem, Qnil);
 852:       Findent_to (col2, minspace);
 853:       Fprinc (b->mode_name, Qnil);
 854:       Findent_to (col3, minspace);
 855:       if (!NULL (b->filename))
 856:     Fprinc (b->filename, Qnil);
 857:       write_string ("\n", -1);
 858:     }
 859: 
 860:   bf_cur->read_only = Qt;
 861:   SetBfp (old);
 862:   /* Foo.  This doesn't work since temp_output_buffer_show sets point to 1 */
 863:   if (desired_point)
 864:     XBUFFER (Vstandard_output)->text.pointloc = desired_point;
 865:   return Qnil;
 866: }
 867: 
 868: DEFUN ("list-buffers", Flist_buffers, Slist_buffers, 0, 1, "",
 869:   "Display a list of names of existing buffers.\n\
 870: Inserts it in buffer *Buffer List* and displays that.\n\
 871: Note that buffers with names starting with spaces are omitted.\n\
 872: Non-null optional arg FILES-ONLY means mention only file buffers.")
 873:   (files)
 874:      Lisp_Object files;
 875: {
 876:   internal_with_output_to_temp_buffer ("*Buffer List*",
 877:                        list_buffers_1, files);
 878:   return Qnil;
 879: }
 880: 
 881: /* note: this leaves us in fundamental-mode, not default-major-mode
 882:    should anything be done about this?
 883: */
 884: DEFUN ("kill-all-local-variables", Fkill_all_local_variables, Skill_all_local_variables,
 885:   0, 0, 0,
 886:   "Eliminate all the buffer-local variable values of the current buffer.\n\
 887: This buffer will then see the default values of all variables.")
 888:   ()
 889: {
 890:   register Lisp_Object alist, sym, tem;
 891: 
 892:   for (alist = bf_cur->local_var_alist; !NULL (alist); alist = XCONS (alist)->cdr)
 893:     {
 894:       sym = XCONS (XCONS (alist)->car)->car;
 895: 
 896:       /* Need not do anything if some other buffer's binding is now encached.  */
 897:       tem = XCONS (XCONS (XSYMBOL (sym)->value)->cdr)->car;
 898:       if (XBUFFER (tem) == bf_cur)
 899:     {
 900:       /* Symbol is set up for this buffer's old local value.
 901: 	     Set it up for the current buffer with the default value.  */
 902: 
 903:       tem = XCONS (XCONS (XSYMBOL (sym)->value)->cdr)->cdr;
 904:       XCONS (tem)->car = tem;
 905:       XCONS (XCONS (XSYMBOL (sym)->value)->cdr)->car = Fcurrent_buffer ();
 906:       store_symval_forwarding (sym, XCONS (XSYMBOL (sym)->value)->car,
 907:                    XCONS (tem)->cdr);
 908:     }
 909:     }
 910: 
 911:   reset_buffer_local_variables (bf_cur);
 912:   return Qnil;
 913: }
 914: 
 915: extern Lisp_Object Vprin1_to_string_buffer; /* in print.c */
 916: init_buffer_once ()
 917: {
 918:   register Lisp_Object tem;
 919: 
 920:   /* Must do these before making the first buffer! */
 921: 
 922:   Vdefault_mode_line_format
 923:     = build_string ("--%1*%1*-Emacs: %17b   %M   %[(%m)%]----%3p-%-");
 924:   Vdefault_abbrev_mode = Qnil;
 925:   default_case_fold_search = 1;
 926: 
 927:   default_tab_width = 8;
 928:   default_truncate_lines = 0;
 929:   default_ctl_arrow = 1;
 930: 
 931:   default_fill_column = 70;
 932:   default_left_margin = 0;
 933: 
 934:   Vbuffer_alist = Qnil;
 935:   bf_cur = 0;
 936:   all_buffers = 0;
 937: 
 938:   QSFundamental = build_string ("Fundamental");
 939: 
 940:   Qfundamental_mode = intern ("fundamental-mode");
 941:   Vdefault_major_mode = Qfundamental_mode;
 942: 
 943:   Vprin1_to_string_buffer = Fget_buffer_create (build_string (" prin1"));
 944:   /* super-magic invisible buffer */
 945:   Vbuffer_alist = Qnil;
 946: 
 947:   tem = Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
 948:   /* Want no undo records for *scratch*
 949:      until after Emacs is dumped */
 950:   Fbuffer_flush_undo (tem);
 951: }
 952: 
 953: init_buffer ()
 954: {
 955:   char buf[MAXPATHLEN+1];
 956: 
 957:   Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
 958:   getwd (buf);
 959:   if (buf[strlen (buf) - 1] != '/')
 960:     strcat (buf, "/");
 961:   bf_cur->directory = build_string (buf);
 962:   if (NULL (Vpurify_flag))
 963:     make_undo_records (bf_cur);
 964: }
 965: 
 966: /* initialize the buffer routines */
 967: syms_of_buffer ()
 968: {
 969:   staticpro (&Qfundamental_mode);
 970:   staticpro (&QSFundamental);
 971:   staticpro (&Vbuffer_alist);
 972: 
 973:   staticpro (&Qlisp_mode);
 974:   Qlisp_mode = intern ("lisp-mode");
 975: 
 976:   DefLispVar ("default-mode-line-format", &Vdefault_mode_line_format,
 977:     "Default value of mode-line-format for new buffers.");
 978: 
 979:   DefBufferLispVar ("mode-line-format", &bf_cur->mode_line_format,
 980:     "Template string for displaying mode line for current buffer.\n\
 981: Each buffer has its own value of this variable.\n\
 982: The string is printed verbatim in the mode line\n\
 983: except for %-constructs:\n\
 984:   %b -- print buffer name.   %f -- print visited file name.\n\
 985:   %* -- print *, % or hyphen.   %m -- print value of mode-name.\n\
 986:   %s -- print process status.   %M -- print value of global-mode-string.\n\
 987:   %p -- print percent of buffer above top of window, or top, bot or all.\n\
 988:   %[ -- print one [ for each recursive editing level.  %] similar.\n\
 989:   %% -- print %.   %- -- print infinitely many dashes.\n\
 990: Decimal digits after the % specify field width to pad or truncate to.");
 991: 
 992:   DefLispVar ("default-abbrev-mode", &Vdefault_abbrev_mode,
 993:     "Default value of abbrev-mode for new buffers.");
 994: 
 995:   DefBufferLispVar ("abbrev-mode", &bf_cur->abbrev_mode,
 996:     "*Non-nil turns on automatic expansion of abbrevs when inserted.");
 997: 
 998:   DefBoolVar ("default-case-fold-search", &default_case_fold_search,
 999:     "*Default value of case-fold-search for new buffers.");
1000:   DefBufferLispVar ("case-fold-search", &bf_cur->case_fold_search,
1001:     "*Non-nil if searches should ignore case.\n\
1002: Separate value in each buffer.");
1003: 
1004:   DefBufferLispVar ("mode-name", &bf_cur->mode_name,
1005:     "Pretty name of current buffer's major mode (a string).");
1006: 
1007:   DefBufferLispVar ("minor-modes", &bf_cur->minor_modes,
1008:     "List of minor modes enabled in current buffer.\n\
1009: Each element is (FUNCTION-SYMBOL . PRETTY-STRING).");
1010: 
1011:   DefIntVar ("default-fill-column", &default_fill_column,
1012:     "*Default value of fill-column for new buffers.");
1013:   DefBufferLispVar ("fill-column", &bf_cur->fill_column,
1014:     "*Column beyond which automatic line-wrapping should happen.\n\
1015: Separate value in each buffer.");
1016: 
1017:   DefIntVar ("default-left-margin", &default_left_margin,
1018:     "*Default value of left-margin for buffers that don't override it.");
1019:   DefBufferLispVar ("left-margin", &bf_cur->left_margin,
1020:     "*Column for the default indent-line-function to indent to.\n\
1021: Linefeed indents to this column in Fundamental mode.");
1022: 
1023:   DefIntVar ("default-tab-width", &default_tab_width,
1024:     "*Default value of tab-width for new buffers.");
1025:   DefBufferLispVar ("tab-width", &bf_cur->tab_width,
1026:     "*Distance between tab stops (for display of tab characters), in columns.\n\
1027: Separate value in each buffer.");
1028: 
1029:   DefBoolVar ("default-ctl-arrow", &default_ctl_arrow,
1030:     "*Default value of ctl-arrow for new buffers.");
1031:   DefBufferLispVar ("ctl-arrow", &bf_cur->ctl_arrow,
1032:     "*Non-nil means display control chars with uparrow.\n\
1033: Nil means use backslash and octal digits.\n\
1034: Separate value in each buffer.");
1035: 
1036:   DefBoolVar ("default-truncate-lines", &default_truncate_lines,
1037:     "*Default value of truncate-lines for new buffers.");
1038:   DefBufferLispVar ("truncate-lines", &bf_cur->truncate_lines,
1039:     "*Non-nil means do not display continuation lines;\n\
1040: give each line of text one screen line.\n\
1041: Separate value in each buffer.");
1042: 
1043:   DefBufferLispVar ("default-directory", &bf_cur->directory,
1044:     "*Name of default directory of current buffer.  Should end with slash.");
1045: 
1046:   DefBufferLispVar ("auto-fill-hook", &bf_cur->auto_fill_hook,
1047:     "Function called (if non-nil) after self-inserting a space at column beyond fill-column");
1048: 
1049:   DefBufferLispVar ("buffer-file-name", &bf_cur->filename,
1050:     "Name of file visited in current buffer, or nil if not visiting a file.");
1051: 
1052:   DefBufferLispVar ("buffer-auto-save-file-name",
1053:             &bf_cur->auto_save_file_name,
1054:     "Name of file for auto-saving current buffer,\n\
1055: or nil if buffer should not be auto-saved.");
1056: 
1057:   DefBufferLispVar ("buffer-read-only", &bf_cur->read_only,
1058:     "*Non-nil if this buffer is read-only.");
1059: 
1060: /* LMCL: Second arg should really be a Lisp_Object but it needs this address.
1061:  * A Lisp_Object had better take up only one word! */
1062:   DefBufferLispVar ("buffer-backed-up", &bf_cur->backed_up,
1063:     "Non-nil if this buffer's file has been backed up.\n\
1064: Backing up is done before the first time the file is saved.");
1065: 
1066:   DefBufferLispVar ("buffer-saved-size", &bf_cur->save_length,
1067:     "Length of current buffer when last read in, saved or auto-saved.\n\
1068: 0 initially.");
1069: 
1070:   DefBufferLispVar ("selective-display", &bf_cur->selective_display,
1071:     "t enables selective display:\n\
1072:  after a ^M, all the rest of the line is invisible.\n\
1073:  ^M's in the file are written into files as newlines.\n\
1074: Integer n as value means display only lines\n\
1075:  that start with less than n columns of space.");
1076: 
1077:   DefBufferLispVar ("overwrite-mode", &bf_cur->overwrite_mode,
1078:     "*Non-nil if self-insertion should replace existing text.");
1079: 
1080:   DefLispVar ("default-major-mode", &Vdefault_major_mode,
1081:     "*Major mode for new buffers.  Defaults to fundamental-mode.\n\
1082: nil here means use current buffer's major mode.");
1083: 
1084:   DefBufferLispVar ("major-mode", &bf_cur->major_mode,
1085:     "Symbol for buffer's major mode.");
1086: 
1087:   DefLispVar ("debug-check-symbol", &Vcheck_symbol,
1088:     "Don't ask.");
1089: 
1090:   defsubr (&Sbuffer_list);
1091:   defsubr (&Sget_buffer);
1092:   defsubr (&Sget_file_buffer);
1093:   defsubr (&Sget_buffer_create);
1094:   defsubr (&Sgenerate_new_buffer);
1095:   defsubr (&Sbuffer_name);
1096:   defsubr (&Sbuffer_number);
1097:   defsubr (&Sbuffer_file_name);
1098:   defsubr (&Sbuffer_local_variables);
1099:   defsubr (&Sbuffer_modified_p);
1100:   defsubr (&Sset_buffer_modified_p);
1101:   defsubr (&Srename_buffer);
1102:   defsubr (&Sother_buffer);
1103:   defsubr (&Sbuffer_flush_undo);
1104:   defsubr (&Skill_buffer);
1105:   defsubr (&Serase_buffer);
1106:   defsubr (&Sswitch_to_buffer);
1107:   defsubr (&Spop_to_buffer);
1108:   defsubr (&Scurrent_buffer);
1109:   defsubr (&Sset_buffer);
1110:   defsubr (&Sbarf_if_buffer_read_only);
1111:   defsubr (&Sbury_buffer);
1112:   defsubr (&Slist_buffers);
1113:   defsubr (&Skill_all_local_variables);
1114: }
1115: 
1116: keys_of_buffer ()
1117: {
1118:   defkey (CtlXmap, 'b', "switch-to-buffer");
1119:   defkey (CtlXmap, 'k', "kill-buffer");
1120:   defkey (CtlXmap, Ctl ('B'), "list-buffers");
1121: }

Defined functions

Defined variables

Defined macros