Commit 1ab256cb authored by Roland McGrath's avatar Roland McGrath
Browse files

Initial revision

parent 3dd63760
/* Buffer manipulation primitives for GNU Emacs.
Copyright (C) 1985, 1986, 1987, 1988, 1989 Free Software Foundation, Inc.
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
the Free Software Foundation; either version 1, or (at your option)
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. */
#include <sys/param.h>
#ifndef MAXPATHLEN
/* in 4.1, param.h fails to define this. */
#define MAXPATHLEN 1024
#endif /* not MAXPATHLEN */
#ifdef NULL
#undef NULL
#endif
#include "config.h"
#include "lisp.h"
#include "window.h"
#include "commands.h"
#include "buffer.h"
#include "syntax.h"
#include "indent.h"
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;
/* Nonzero means don't allow modification of protected fields. */
int check_protected_fields;
Lisp_Object Fset_buffer ();
/* 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;
/* Function to call before changing an unmodified buffer. */
Lisp_Object Vfirst_change_function;
Lisp_Object Qfundamental_mode, Qmode_class, Qpermanent_local;
Lisp_Object Qprotected_field;
Lisp_Object QSFundamental; /* A string "Fundamental" */
Lisp_Object Qkill_buffer_hook;
/* For debugging; temporary. See set_buffer_internal. */
/* Lisp_Object Qlisp_mode, Vcheck_symbol; */
nsberror (spec)
Lisp_Object spec;
{
if (XTYPE (spec) == Lisp_String)
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);
}
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;
{
if (XTYPE (name) == Lisp_Buffer)
return name;
CHECK_STRING (name, 0);
return Fcdr (Fassoc (name, Vbuffer_alist));
}
DEFUN ("get-file-buffer", Fget_file_buffer, Sget_file_buffer, 1, 1, 0,
"Return the buffer visiting file FILENAME (a string).\n\
If there is no such live buffer, return nil.")
(filename)
register Lisp_Object filename;
{
register Lisp_Object tail, buf, tem;
CHECK_STRING (filename, 0);
filename = Fexpand_file_name (filename, Qnil);
for (tail = Vbuffer_alist; CONSP (tail); tail = XCONS (tail)->cdr)
{
buf = Fcdr (XCONS (tail)->car);
if (XTYPE (buf) != Lisp_Buffer) continue;
if (XTYPE (XBUFFER (buf)->filename) != Lisp_String) continue;
tem = Fstring_equal (XBUFFER (buf)->filename, filename);
if (!NULL (tem))
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\
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;
{
register Lisp_Object buf, function, tem;
int count = specpdl_ptr - specpdl;
register struct buffer *b;
buf = Fget_buffer (name);
if (!NULL (buf))
return buf;
b = (struct buffer *) malloc (sizeof (struct buffer));
if (!b)
memory_full ();
BUF_GAP_SIZE (b) = 20;
BUFFER_ALLOC (BUF_BEG_ADDR (b), BUF_GAP_SIZE (b));
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;
/* 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);*/
b->name = name;
if (XSTRING (name)->data[0] != ' ')
b->undo_list = Qnil;
else
b->undo_list = Qt;
reset_buffer (b);
/* Put this in the alist of all live buffers. */
XSET (buf, Lisp_Buffer, b);
Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));
b->mark = Fmake_marker ();
b->markers = Qnil;
b->name = name;
function = buffer_defaults.major_mode;
if (NULL (function))
{
tem = Fget (current_buffer->major_mode, Qmode_class);
if (EQ (tem, Qnil))
function = current_buffer->major_mode;
}
if (NULL (function) || EQ (function, Qfundamental_mode))
return buf;
/* 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, buf);
}
/* Reinitialize everything about a buffer except its name and contents. */
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;
b->save_length = 0;
b->last_window_start = 1;
b->backed_up = Qnil;
b->auto_save_modified = 0;
b->auto_save_file_name = Qnil;
b->read_only = Qnil;
b->fieldlist = Qnil;
reset_buffer_local_variables(b);
}
reset_buffer_local_variables(b)
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;
b->case_canon_table = Vascii_downcase_table;
b->case_eqv_table = Vascii_upcase_table;
#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);
offset += sizeof (Lisp_Object)) /* sizeof int == sizeof Lisp_Object */
if (*(int *)(offset + (char *) &buffer_local_flags) > 0
|| *(int *)(offset + (char *) &buffer_local_flags) == -2)
*(Lisp_Object *)(offset + (char *)b) =
*(Lisp_Object *)(offset + (char *)&buffer_defaults);
}
DEFUN ("generate-new-buffer", Fgenerate_new_buffer, Sgenerate_new_buffer,
1, 1, 0,
"Create and return a buffer with a name based on NAME.\n\
If there is no live buffer named NAME, then one is created.\n\
Otherwise modify name by appending `<NUMBER>', incrementing NUMBER\n\
until an unused name is found, and then create a buffer.")
(name)
register Lisp_Object name;
{
register Lisp_Object gentemp, tem;
int count;
char number[10];
CHECK_STRING (name, 0);
tem = Fget_buffer (name);
if (NULL (tem))
return Fget_buffer_create (name);
count = 1;
while (1)
{
sprintf (number, "<%d>", ++count);
gentemp = concat2 (name, build_string (number));
tem = Fget_buffer (gentemp);
if (NULL (tem))
return Fget_buffer_create (gentemp);
}
}
DEFUN ("buffer-name", Fbuffer_name, Sbuffer_name, 0, 1, 0,
"Return the name of BUFFER, as a string.\n\
Wyth no argument or nil as argument, return the name of the current buffer.")
(buffer)
register Lisp_Object buffer;
{
if (NULL (buffer))
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;
{
if (NULL (buffer))
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\
Each element looks like (SYMBOL . VALUE) and describes one variable.\n\
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;
register Lisp_Object val;
if (NULL (buffer))
buf = current_buffer;
else
{
CHECK_BUFFER (buffer, 0);
buf = XBUFFER (buffer);
}
{
/* 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. */
register Lisp_Object tem;
for (tem = buf->local_var_alist; CONSP (tem); tem = XCONS (tem)->cdr)
{
Lisp_Object v1 = Fsymbol_value (XCONS (XCONS (tem)->car)->car);
if (buf == current_buffer)
XCONS (XCONS (tem)->car)->cdr = v1;
}
}
/* Make a copy of the alist, to return it. */
val = Fcopy_alist (buf->local_var_alist);
/* 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);
offset += (sizeof (int))) /* sizeof int == sizeof Lisp_Object */
{
mask = *(int *)(offset + (char *) &buffer_local_flags);
if (mask == -1 || (buf->local_var_flags & mask))
if (XTYPE (*(Lisp_Object *)(offset + (char *)&buffer_local_symbols))
== Lisp_Symbol)
val = Fcons (Fcons (*(Lisp_Object *)(offset + (char *)&buffer_local_symbols),
*(Lisp_Object *)(offset + (char *)buf)),
val);
}
}
return (val);
}
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;
if (NULL (buffer))
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;
if (!NULL (fn))
{
already = current_buffer->save_modified < MODIFF;
if (!already && !NULL (flag))
lock_file (fn);
else if (already && NULL (flag))
unlock_file (fn);
}
#endif /* CLASH_DETECTION */
current_buffer->save_modified = NULL (flag) ? MODIFF : 0;
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;
if (NULL (buffer))
buf = current_buffer;
else
{
CHECK_BUFFER (buffer, 0);
buf = XBUFFER (buffer);
}
return make_number (BUF_MODIFF (buf));
}
DEFUN ("rename-buffer", Frename_buffer, Srename_buffer, 1, 1,
"sRename buffer (to new name): ",
"Change current buffer's name to NEWNAME (a string).\n\
It is an error if a buffer named NEWNAME already exists.\n\
This does not change the name of the visited file (if any).")
(name)
register Lisp_Object name;
{
register Lisp_Object tem, buf;
CHECK_STRING (name, 0);
tem = Fget_buffer (name);
if (!NULL (tem))
error ("Buffer name \"%s\" is in use", XSTRING (name)->data);
current_buffer->name = name;
XSET (buf, Lisp_Buffer, current_buffer);
Fsetcar (Frassq (buf, Vbuffer_alist), name);
if (NULL (current_buffer->filename) && !NULL (current_buffer->auto_save_file_name))
call0 (intern ("rename-auto-save-file"));
return Qnil;
}
DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 1, 0,
"Return most recently selected buffer other than BUFFER.\n\
Buffers not visible in windows are preferred to visible buffers.\n\
If no other buffer exists, the buffer `*scratch*' is returned.\n\
If BUFFER is omitted or nil, some interesting buffer is returned.")
(buffer)
register Lisp_Object buffer;
{
register Lisp_Object tail, buf, notsogood, tem;
notsogood = Qnil;
for (tail = Vbuffer_alist; !NULL (tail); tail = Fcdr (tail))
{
buf = Fcdr (Fcar (tail));
if (EQ (buf, buffer))
continue;
if (XSTRING (XBUFFER (buf)->name)->data[0] == ' ')
continue;
tem = Fget_buffer_window (buf, Qnil);
if (NULL (tem))
return buf;
if (NULL (notsogood))
notsogood = buf;
}
if (!NULL (notsogood))
return notsogood;
return Fget_buffer_create (build_string ("*scratch*"));
}
DEFUN ("buffer-disable-undo", Fbuffer_disable_undo, Sbuffer_disable_undo, 1,1,
0,
"Make BUFFER stop keeping undo information.")
(buf)
register Lisp_Object buf;
{
CHECK_BUFFER (buf, 0);
XBUFFER (buf)->undo_list = Qt;
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.")
(buf)
register Lisp_Object buf;
{
register struct buffer *b;
register Lisp_Object buf1;
if (NULL (buf))
b = current_buffer;
else
{
buf1 = Fget_buffer (buf);
if (NULL (buf1)) nsberror (buf);
b = XBUFFER (buf1);
}
if (EQ (b->undo_list, Qt))
b->undo_list = Qnil;
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;
if (NULL (bufname))
buf = Fcurrent_buffer ();
else
buf = Fget_buffer (bufname);
if (NULL (buf))
nsberror (bufname);
b = XBUFFER (buf);
/* Query if the buffer is still modified. */
if (INTERACTIVE && !NULL (b->filename)
&& 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;
if (NULL (tem))
return Qnil;
}
/* Run kill-buffer hook with the buffer to be killed the current buffer. */
{
register Lisp_Object val;
int count = specpdl_ptr - specpdl;
record_unwind_protect (save_excursion_restore, save_excursion_save ());
set_buffer_internal (b);
call1 (Vrun_hooks, Qkill_buffer_hook);
unbind_to (count, Qnil);
}