]> code.delx.au - gnu-emacs/blobdiff - src/buffer.c
* cmds.c (overwrite_binary_mode): Deleted; this implements the
[gnu-emacs] / src / buffer.c
index 80d4ece06a1e4d43af40b396a0ea48c85bac3cf0..aec489eab564639a7ab99c428f57301658ec8333 100644 (file)
@@ -1,11 +1,12 @@
 /* Buffer manipulation primitives for GNU Emacs.
-   Copyright (C) 1985, 1986, 1987, 1988, 1989, 1992 Free Software Foundation, Inc.
+   Copyright (C) 1985, 1986, 1987, 1988, 1989, 1992, 1993
+       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)
+the Free Software Foundation; either version 2, or (at your option)
 any later version.
 
 GNU Emacs is distributed in the hope that it will be useful,
@@ -18,6 +19,8 @@ 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/types.h>
+#include <sys/stat.h>
 #include <sys/param.h>
 
 #ifndef MAXPATHLEN
@@ -27,6 +30,7 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
 
 #include "config.h"
 #include "lisp.h"
+#include "intervals.h"
 #include "window.h"
 #include "commands.h"
 #include "buffer.h"
@@ -93,10 +97,6 @@ static Lisp_Object Vbuffer_local_symbols;
    buffer_slot_type_mismatch will signal an error.  */
 struct buffer buffer_local_types;
 
-/* Nonzero means don't allow modification of protected fields.  */
-
-int check_protected_fields;
-
 Lisp_Object Fset_buffer ();
 void set_buffer_internal ();
 
@@ -109,8 +109,11 @@ Lisp_Object Vbuffer_alist;
 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 Vtransient_mark_mode;
+
+/* List of functions to call before changing an unmodified buffer.  */
+Lisp_Object Vfirst_change_hook;
+Lisp_Object Qfirst_change_hook;
 
 Lisp_Object Qfundamental_mode, Qmode_class, Qpermanent_local;
 
@@ -264,17 +267,21 @@ reset_buffer (b)
   b->directory = (current_buffer) ? current_buffer->directory : Qnil;
   b->modtime = 0;
   b->save_modified = 1;
-  b->save_length = 0;
+  XFASTINT (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;
+
+  /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
+  INITIALIZE_INTERVAL (b, NULL_INTERVAL);
+
   reset_buffer_local_variables(b);
 }
 
-reset_buffer_local_variables(b)
+reset_buffer_local_variables (b)
      register struct buffer *b;
 {
   register int offset;
@@ -292,6 +299,7 @@ reset_buffer_local_variables(b)
   b->upcase_table = Vascii_upcase_table;
   b->case_canon_table = Vascii_downcase_table;
   b->case_eqv_table = Vascii_upcase_table;
+  b->mark_active = Qnil;
 #if 0
   b->sort_table = XSTRING (Vascii_sort_table);
   b->folding_sort_table = XSTRING (Vascii_folding_sort_table);
@@ -502,16 +510,17 @@ No argument or nil as argument means use current buffer as BUFFER.")
 }
 \f
 DEFUN ("rename-buffer", Frename_buffer, Srename_buffer, 1, 2,
-       "sRename buffer (to new name): ",
+       "sRename buffer (to new name): \nP",
   "Change current buffer's name to NEWNAME (a string).\n\
-If second arg DISTINGUISH is nil or omitted, it is an error if a\n\
+If second arg UNIQUE is nil or omitted, it is an error if a\n\
 buffer named NEWNAME already exists.\n\
-If DISTINGUISH is non-nil, come up with a new name using\n\
+If UNIQUE is non-nil, come up with a new name using\n\
 `generate-new-buffer-name'.\n\
-Return the name we actually gave the buffer.\n\
+Interactively, you can set UNIQUE with a prefix argument.\n\
+We return the name we actually gave the buffer.\n\
 This does not change the name of the visited file (if any).")
-  (name, distinguish)
-     register Lisp_Object name, distinguish;
+  (name, unique)
+     register Lisp_Object name, unique;
 {
   register Lisp_Object tem, buf;
 
@@ -521,13 +530,18 @@ This does not change the name of the visited file (if any).")
     return current_buffer->name;
   if (!NILP (tem))
     {
-      if (!NILP (distinguish))
+      if (!NILP (unique))
        name = Fgenerate_new_buffer_name (name);
       else
        error ("Buffer name \"%s\" is in use", XSTRING (name)->data);
     }
 
   current_buffer->name = name;
+
+  /* Catch redisplay's attention.  Unless we do this, the mode lines for
+     any windows displaying current_buffer will stay unchanged.  */
+  update_mode_lines++;
+
   XSET (buf, Lisp_Buffer, current_buffer);
   Fsetcar (Frassq (buf, Vbuffer_alist), name);
   if (NILP (current_buffer->filename) && !NILP (current_buffer->auto_save_file_name))
@@ -535,13 +549,14 @@ This does not change the name of the visited file (if any).")
   return name;
 }
 
-DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 1, 0,
+DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 2, 0,
   "Return most recently selected buffer other than BUFFER.\n\
-Buffers not visible in windows are preferred to visible buffers.\n\
+Buffers not visible in windows are preferred to visible buffers,\n\
+unless optional second argument VISIBLE-OK is non-nil.\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;
+  (buffer, visible_ok)
+     register Lisp_Object buffer, visible_ok;
 {
   register Lisp_Object tail, buf, notsogood, tem;
   notsogood = Qnil;
@@ -553,7 +568,10 @@ If BUFFER is omitted or nil, some interesting buffer is returned.")
        continue;
       if (XSTRING (XBUFFER (buf)->name)->data[0] == ' ')
        continue;
-      tem = Fget_buffer_window (buf, Qnil);
+      if (NILP (visible_ok))
+       tem = Fget_buffer_window (buf, Qnil);
+      else
+       tem = Qnil;
       if (NILP (tem))
        return buf;
       if (NILP (notsogood))
@@ -684,7 +702,7 @@ with `delete-process'.")
      and give up if so.  */
   if (b == current_buffer)
     {
-      tem = Fother_buffer (buf);
+      tem = Fother_buffer (buf, Qnil);
       Fset_buffer (tem);
       if (b == current_buffer)
        return Qnil;
@@ -725,6 +743,10 @@ with `delete-process'.")
     }
   b->markers = Qnil;
 
+  /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
+  INITIALIZE_INTERVAL (b, NULL_INTERVAL);
+  /* Perhaps we should explicitly free the interval tree here... */
+
   b->name = Qnil;
   BUFFER_FREE (BUF_BEG_ADDR (b));
   b->undo_list = Qnil;
@@ -784,7 +806,7 @@ the window-buffer correspondences.")
     error ("Cannot switch buffers in a dedicated window");
 
   if (NILP (bufname))
-    buf = Fother_buffer (Fcurrent_buffer ());
+    buf = Fother_buffer (Fcurrent_buffer (), Qnil);
   else
     buf = Fget_buffer_create (bufname);
   Fset_buffer (buf);
@@ -792,7 +814,8 @@ the window-buffer correspondences.")
     record_buffer (buf);
 
   Fset_window_buffer (EQ (selected_window, minibuf_window)
-                     ? Fnext_window (minibuf_window, Qnil) : selected_window,
+                     ? Fnext_window (minibuf_window, Qnil, Qnil)
+                     : selected_window,
                      buf);
 
   return Qnil;
@@ -809,7 +832,7 @@ window even if BUFFER is already visible in the selected window.")
 {
   register Lisp_Object buf;
   if (NILP (bufname))
-    buf = Fother_buffer (Fcurrent_buffer ());
+    buf = Fother_buffer (Fcurrent_buffer (), Qnil);
   else
     buf = Fget_buffer_create (bufname);
   Fset_buffer (buf);
@@ -912,14 +935,20 @@ DEFUN ("bury-buffer", Fbury_buffer, Sbury_buffer, 0, 1, "",
   "Put BUFFER at the end of the list of all buffers.\n\
 There it is the least likely candidate for `other-buffer' to return;\n\
 thus, the least likely buffer for \\[switch-to-buffer] to select by default.\n\
-BUFFER is also removed from the selected window if it was displayed there.\n\
-If BUFFER is omitted, the current buffer is buried.")
+If BUFFER is nil or omitted, bury the current buffer.\n\
+Also, if BUFFER is nil or omitted, remove the current buffer from the\n\
+selected window if it is displayed there.")
   (buf)
      register Lisp_Object buf;
 {
   /* Figure out what buffer we're going to bury.  */
   if (NILP (buf))
-    XSET (buf, Lisp_Buffer, current_buffer);
+    {
+      XSET (buf, Lisp_Buffer, current_buffer);
+
+      /* If we're burying the current buffer, unshow it.  */
+      Fswitch_to_buffer (Fother_buffer (buf, Qnil), Qnil);
+    }
   else
     {
       Lisp_Object buf1;
@@ -930,11 +959,7 @@ If BUFFER is omitted, the current buffer is buried.")
       buf = buf1;
     }
 
-  /* Remove it from the screen.  */
-  if (EQ (buf, XWINDOW (selected_frame)->buffer))
-    Fswitch_to_buffer (Fother_buffer (buf), Qnil);
-
-  /* Move it to the end of the buffer list.  */
+  /* Move buf to the end of the buffer list.  */
   {
     register Lisp_Object aelt, link;
 
@@ -948,9 +973,9 @@ If BUFFER is omitted, the current buffer is buried.")
   return Qnil;
 }
 \f
-DEFUN ("erase-buffer", Ferase_buffer, Serase_buffer, 0, 0, 0,
+DEFUN ("erase-buffer", Ferase_buffer, Serase_buffer, 0, 0, "*",
   "Delete the entire contents of the current buffer.\n\
-Any clipping restriction in effect (see `narrow-to-buffer') is removed,\n\
+Any clipping restriction in effect (see `narrow-to-region') is removed,\n\
 so the buffer is truly empty after this.")
   ()
 {
@@ -1223,7 +1248,7 @@ buffer_slot_type_mismatch (valcontents, newval)
      Lisp_Object valcontents, newval;
 {
   unsigned int offset = XUINT (valcontents);
-  char *symbol_name =
+  unsigned char *symbol_name =
     (XSYMBOL (*(Lisp_Object *)(offset + (char *)&buffer_local_symbols))
      ->name->data);
   char *type_name;
@@ -1235,7 +1260,7 @@ buffer_slot_type_mismatch (valcontents, newval)
     case Lisp_Marker:  type_name = "markers";   break;
     case Lisp_Symbol:  type_name = "symbols";   break;
     case Lisp_Cons:    type_name = "lists";     break;
-    case Lisp_Vector:  type_name = "vector";    break;
+    case Lisp_Vector:  type_name = "vectors";   break;
     default:
       abort ();
     }
@@ -1272,6 +1297,7 @@ init_buffer_once ()
   buffer_defaults.display_table = Qnil;
   buffer_defaults.fieldlist = Qnil;
   buffer_defaults.undo_list = Qnil;
+  buffer_defaults.mark_active = Qnil;
 
   XFASTINT (buffer_defaults.tab_width) = 8;
   buffer_defaults.truncate_lines = Qnil;
@@ -1299,6 +1325,7 @@ init_buffer_once ()
   XFASTINT (buffer_local_flags.major_mode) = -1;
   XFASTINT (buffer_local_flags.mode_name) = -1;
   XFASTINT (buffer_local_flags.undo_list) = -1;
+  XFASTINT (buffer_local_flags.mark_active) = -1;
 
   XFASTINT (buffer_local_flags.mode_line_format) = 1;
   XFASTINT (buffer_local_flags.abbrev_mode) = 2;
@@ -1346,9 +1373,21 @@ init_buffer_once ()
 init_buffer ()
 {
   char buf[MAXPATHLEN+1];
+  char *pwd;
+  struct stat dotstat, pwdstat;
 
   Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
-  if (getwd (buf) == 0)
+
+  /* If PWD is accurate, use it instead of calling getwd.  This is faster
+     when PWD is right, and may avoid a fatal error.  */
+  if ((pwd = getenv ("PWD")) != 0 && *pwd == '/'
+      && stat (pwd, &pwdstat) == 0
+      && stat (".", &dotstat) == 0
+      && dotstat.st_ino == pwdstat.st_ino
+      && dotstat.st_dev == pwdstat.st_dev
+      && strlen (pwd) < MAXPATHLEN)
+    strcpy (buf, pwd);
+  else if (getwd (buf) == 0)
     fatal ("`getwd' failed: %s.\n", buf);
 
 #ifndef VMS
@@ -1363,6 +1402,8 @@ init_buffer ()
 /* initialize the buffer routines */
 syms_of_buffer ()
 {
+  extern Lisp_Object Qdisabled;
+
   staticpro (&Vbuffer_defaults);
   staticpro (&Vbuffer_local_symbols);
   staticpro (&Qfundamental_mode);
@@ -1378,6 +1419,8 @@ syms_of_buffer ()
   Fput (Qprotected_field, Qerror_message,
        build_string ("Attempt to modify a protected field"));
 
+  Fput (intern ("erase-buffer"), Qdisabled, Qt);
+
   /* All these use DEFVAR_LISP_NOPRO because the slots in
      buffer_defaults will all be marked via Vbuffer_defaults.  */
 
@@ -1427,6 +1470,7 @@ This is the same as (default-value 'case-fold-search).");
 /* This doc string is too long for cpp; cpp dies if it isn't in a comment.
    But make-docfile finds it!
   DEFVAR_PER_BUFFER ("mode-line-format", &current_buffer->mode_line_format,
+    Qnil,
     "Template for displaying mode line for current buffer.\n\
 Each buffer has its own value of this variable.\n\
 Value may be a string, a symbol or a list or cons cell.\n\
@@ -1566,6 +1610,10 @@ Automatically becomes buffer-local when set in any fashion.");
 
   DEFVAR_PER_BUFFER ("overwrite-mode", &current_buffer->overwrite_mode, Qnil,
     "Non-nil if self-insertion should replace existing text.\n\
+If non-nil and not `overwrite-mode-binary', self-insertion still\n\
+inserts at the end of a line, and inserts when point is before a tab,\n\
+unless that tab is displaying as only one space.\n\
+If `overwrite-mode-binary', self-insertion replaces newlines and tabs too.\n\
 Automatically becomes buffer-local when set in any fashion.");
 
   DEFVAR_PER_BUFFER ("buffer-display-table", &current_buffer->display_table,
@@ -1585,14 +1633,6 @@ The remaining five elements are ropes that control the display of\n\
 If this variable is nil, the value of `standard-display-table' is used.\n\
 Each window can have its own, overriding display table.");
 
-  DEFVAR_PER_BUFFER ("buffer-field-list", &current_buffer->fieldlist, Qnil,
-    "List of fields in the current buffer.  See `add-field'.");
-
-  DEFVAR_BOOL ("check-protected-fields", check_protected_fields,
-    "Non-nil means don't allow modification of a protected field.\n\
-See `add-field'.");
-  check_protected_fields = 0;
-
 /*DEFVAR_LISP ("debug-check-symbol", &Vcheck_symbol,
     "Don't ask.");
 */
@@ -1621,10 +1661,12 @@ While executing the `after-change-function', changes to buffers do not\n\
 cause calls to any `before-change-function' or `after-change-function'.");
   Vafter_change_function = Qnil;
 
-  DEFVAR_LISP ("first-change-function", &Vfirst_change_function,
-  "Function to call before changing a buffer which is unmodified.\n\
-The function is called, with no arguments, if it is non-nil.");
-  Vfirst_change_function = Qnil;
+  DEFVAR_LISP ("first-change-hook", &Vfirst_change_hook,
+  "A list of functions to call before changing a buffer which is unmodified.\n\
+The functions are run using the `run-hooks' function.");
+  Vfirst_change_hook = Qnil;
+  Qfirst_change_hook = intern ("first-change-hook");
+  staticpro (&Qfirst_change_hook);
 
   DEFVAR_PER_BUFFER ("buffer-undo-list", &current_buffer->undo_list, Qnil,
     "List of undo entries in current buffer.\n\
@@ -1643,11 +1685,26 @@ previously unmodified.  HIGHWORD and LOWWORD are the high and low\n\
 modification count of the most recent save is different, this entry is\n\
 obsolete.\n\
 \n\
+An entry (nil PROP VAL BEG . END) indicates that a text property\n\
+was modified between BEG and END.  PROP is the property name,\n\
+and VAL is the old value.\n\
+\n\
+An entry of the form POSITION indicates that point was at the buffer\n\
+location given by the integer.  Undoing an entry of this form places\n\
+point at POSITION.\n\
+\n\
 nil marks undo boundaries.  The undo command treats the changes\n\
 between two undo boundaries as a single step to be undone.\n\
 \n\
-If the value of the variable is t, undo information is not recorded.\n\
-");
+If the value of the variable is t, undo information is not recorded.");
+
+  DEFVAR_PER_BUFFER ("mark-active", &current_buffer->mark_active, Qnil, 
+    "Non-nil means the mark and region are currently active in this buffer.\n\
+Automatically local in all buffers.");
+
+  DEFVAR_LISP ("transient-mark-mode", &Vtransient_mark_mode,
+    "*Non-nil means deactivate the mark when the buffer contents change.");
+  Vtransient_mark_mode = Qnil;
 
   defsubr (&Sbuffer_list);
   defsubr (&Sget_buffer);