|
|
1.1 ! root 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: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.