]> code.delx.au - gnu-emacs/blobdiff - src/buffer.c
(verify_overlay_modification): New function.
[gnu-emacs] / src / buffer.c
index 3a90154992d9961faadb8ac5cb6e1c26992174f8..ce07c2a21d3effab79e96c35aaf55c16ca7c22fd 100644 (file)
@@ -100,6 +100,7 @@ struct buffer buffer_local_types;
 
 Lisp_Object Fset_buffer ();
 void set_buffer_internal ();
+static void call_overlay_mod_hooks ();
 
 /* Alist of all buffer names vs the buffers. */
 /* This used to be a variable, but is no longer,
@@ -112,6 +113,11 @@ Lisp_Object Vafter_change_function;
 
 Lisp_Object Vtransient_mark_mode;
 
+/* t means ignore all read-only text properties.
+   A list means ignore such a property if its value is a member of the list.
+   Any non-nil value means ignore buffer-read-only.  */
+Lisp_Object Vinhibit_read_only;
+
 /* List of functions to call before changing an unmodified buffer.  */
 Lisp_Object Vfirst_change_hook;
 Lisp_Object Qfirst_change_hook;
@@ -279,6 +285,7 @@ reset_buffer (b)
   b->overlays_before = Qnil;
   b->overlays_after = Qnil;
   XFASTINT (b->overlay_center) = 1;
+  b->mark_active = Qnil;
 
   /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
   INITIALIZE_INTERVAL (b, NULL_INTERVAL);
@@ -304,7 +311,6 @@ 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);
@@ -331,13 +337,16 @@ reset_buffer_local_variables (b)
    rename the buffer properly.  */
 
 DEFUN ("generate-new-buffer-name", Fgenerate_new_buffer_name, Sgenerate_new_buffer_name,
-  1, 1, 0,
+  1, 2, 0,
   "Return a string that is the name of no existing buffer based on NAME.\n\
 If there is no live buffer named NAME, then return NAME.\n\
 Otherwise modify name by appending `<NUMBER>', incrementing NUMBER\n\
-until an unused name is found, and then return that name.")
- (name)
-     register Lisp_Object name;
+until an unused name is found, and then return that name.\n\
+Optional second argument IGNORE specifies a name that is okay to use\n\
+\(if it is in the sequence to be tried)\n\
+even if a buffer with that name exists.")
+ (name, ignore)
+     register Lisp_Object name, ignore;
 {
   register Lisp_Object gentemp, tem;
   int count;
@@ -354,6 +363,9 @@ until an unused name is found, and then return that name.")
     {
       sprintf (number, "<%d>", ++count);
       gentemp = concat2 (name, build_string (number));
+      tem = Fstring_equal (gentemp, ignore);
+      if (!NILP (tem))
+       return gentemp;
       tem = Fget_buffer (gentemp);
       if (NILP (tem))
        return gentemp;
@@ -536,7 +548,7 @@ This does not change the name of the visited file (if any).")
   if (!NILP (tem))
     {
       if (!NILP (unique))
-       name = Fgenerate_new_buffer_name (name);
+       name = Fgenerate_new_buffer_name (name, current_buffer->name);
       else
        error ("Buffer name \"%s\" is in use", XSTRING (name)->data);
     }
@@ -574,7 +586,7 @@ If BUFFER is omitted or nil, some interesting buffer is returned.")
       if (XSTRING (XBUFFER (buf)->name)->data[0] == ' ')
        continue;
       if (NILP (visible_ok))
-       tem = Fget_buffer_window (buf, Qnil);
+       tem = Fget_buffer_window (buf, Qt);
       else
        tem = Qnil;
       if (NILP (tem))
@@ -825,7 +837,7 @@ the window-buffer correspondences.")
                      : selected_window,
                      buf);
 
-  return Qnil;
+  return buf;
 }
 
 DEFUN ("pop-to-buffer", Fpop_to_buffer, Spop_to_buffer, 1, 2, 0,
@@ -845,7 +857,7 @@ window even if BUFFER is already visible in the selected window.")
   Fset_buffer (buf);
   record_buffer (buf);
   Fselect_window (Fdisplay_buffer (buf, other));
-  return Qnil;
+  return buf;
 }
 
 DEFUN ("current-buffer", Fcurrent_buffer, Scurrent_buffer, 0, 0, 0,
@@ -933,7 +945,8 @@ DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only,
   "Signal a `buffer-read-only' error if the current buffer is read-only.")
   ()
 {
-  while (!NILP (current_buffer->read_only))
+  if (!NILP (current_buffer->read_only)
+      && NILP (Vinhibit_read_only))
     Fsignal (Qbuffer_read_only, (Fcons (Fcurrent_buffer (), Qnil)));
   return Qnil;
 }
@@ -1023,9 +1036,10 @@ list_buffers_1 (files)
   register Lisp_Object tail, tem, buf;
   Lisp_Object col1, col2, col3, minspace;
   register struct buffer *old = current_buffer, *b;
-  int desired_point = 0;
+  Lisp_Object desired_point;
   Lisp_Object other_file_symbol;
 
+  desired_point = Qnil;
   other_file_symbol = intern ("list-buffers-directory");
 
   XFASTINT (col1) = 19;
@@ -1058,7 +1072,7 @@ list_buffers_1 (files)
        continue;
       /* Identify the current buffer. */
       if (b == old)
-       desired_point = point;
+       XFASTINT (desired_point) = point;
       write_string (b == old ? "." : " ", -1);
       /* Identify modified buffers */
       write_string (BUF_MODIFF (b) > b->save_modified ? "*" : " ", -1);
@@ -1094,11 +1108,7 @@ list_buffers_1 (files)
 
   current_buffer->read_only = Qt;
   set_buffer_internal (old);
-/* Foo.  This doesn't work since temp_output_buffer_show sets point to 1
-  if (desired_point)
-    XBUFFER (Vstandard_output)->text.pointloc = desired_point;
- */
-  return Qnil;
+  return desired_point;
 }
 
 DEFUN ("list-buffers", Flist_buffers, Slist_buffers, 0, 1, "P",
@@ -1112,9 +1122,20 @@ The R column contains a % for buffers that are read-only.")
   (files)
      Lisp_Object files;
 {
-  internal_with_output_to_temp_buffer ("*Buffer List*",
-                                      list_buffers_1, files);
-  return Qnil;
+  Lisp_Object desired_point;
+
+  desired_point =
+    internal_with_output_to_temp_buffer ("*Buffer List*",
+                                        list_buffers_1, files);
+
+  if (NUMBERP (desired_point))
+    {
+      int count = specpdl_ptr - specpdl;
+      record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+      Fset_buffer (build_string ("*Buffer List*"));
+      SET_PT (XINT (desired_point));
+      return unbind_to (count, Qnil);
+    }
 }
 
 DEFUN ("kill-all-local-variables", Fkill_all_local_variables, Skill_all_local_variables,
@@ -1489,28 +1510,28 @@ BEG and END may be integers or markers.")
 
   if (NILP (buffer))
     XSET (buffer, Lisp_Buffer, current_buffer);
-  CHECK_BUFFER (buffer, 2);
+  else
+    CHECK_BUFFER (buffer, 2);
+  if (MARKERP (beg)
+      && ! EQ (Fmarker_buffer (beg), buffer))
+    error ("Marker points into wrong buffer");
+  if (MARKERP (end)
+      && ! EQ (Fmarker_buffer (end), buffer))
+    error ("Marker points into wrong buffer");
 
-  b = XBUFFER (buffer);
+  CHECK_NUMBER_COERCE_MARKER (beg, 1);
+  CHECK_NUMBER_COERCE_MARKER (end, 1);
 
-  if (MARKERP (beg))
-    {
-      if (! EQ (Fmarker_buffer (beg), buffer))
-       error ("Marker points into wrong buffer");
-      else
-       beg = Fcopy_marker (beg);
-    }
-  else
-    beg = Fset_marker (Fmake_marker (), beg, buffer);
-  if (MARKERP (end))
+  if (XINT (beg) > XINT (end))
     {
-      if (! EQ (Fmarker_buffer (end), buffer))
-       error ("Marker points into wrong buffer");
-      else
-       end = Fcopy_marker (end);
+      Lisp_Object temp = beg;
+      beg = end; end = temp;
     }
-  else
-    end = Fset_marker (Fmake_marker (), end, buffer);
+
+  b = XBUFFER (buffer);
+
+  beg = Fset_marker (Fmake_marker (), beg, buffer);
+  end = Fset_marker (Fmake_marker (), end, buffer);
 
   overlay = Fcons (Fcons (beg, end), Qnil);
   XSETTYPE (overlay, Lisp_Overlay);
@@ -1539,7 +1560,9 @@ buffer.")
   (overlay, beg, end, buffer)
      Lisp_Object overlay, beg, end, buffer;
 {
-  struct buffer *b;
+  struct buffer *b, *ob;
+  Lisp_Object obuffer;
+  int count = specpdl_ptr - specpdl;
 
   CHECK_OVERLAY (overlay, 0);
   if (NILP (buffer))
@@ -1547,40 +1570,59 @@ buffer.")
   if (NILP (buffer))
     XSET (buffer, Lisp_Buffer, current_buffer);
   CHECK_BUFFER (buffer, 3);
+
+  if (MARKERP (beg)
+      && ! EQ (Fmarker_buffer (beg), buffer))
+    error ("Marker points into wrong buffer");
+  if (MARKERP (end)
+      && ! EQ (Fmarker_buffer (end), buffer))
+    error ("Marker points into wrong buffer");
+
   CHECK_NUMBER_COERCE_MARKER (beg, 1);
   CHECK_NUMBER_COERCE_MARKER (end, 1);
 
+  specbind (Qinhibit_quit, Qt);
+
   if (XINT (beg) > XINT (end))
     {
       Lisp_Object temp = beg;
       beg = end; end = temp;
     }
 
+  obuffer = Fmarker_buffer (OVERLAY_START (overlay));
   b = XBUFFER (buffer);
+  ob = XBUFFER (obuffer);
 
-  /* Redisplay the area the overlay has just left, or just enclosed.  */
-  {
-    Lisp_Object o_beg = OVERLAY_START (overlay);
-    Lisp_Object o_end = OVERLAY_END   (overlay);
-    int change_beg, change_end;
-
-    o_beg = OVERLAY_POSITION (o_beg);
-    o_end = OVERLAY_POSITION (o_end);
-
-    if (XINT (o_beg) == XINT (beg))
-      redisplay_region (b, XINT (o_end), XINT (end));
-    else if (XINT (o_end) == XINT (end))
-      redisplay_region (b, XINT (o_beg), XINT (beg));
-    else
-      {
-       if (XINT (beg) < XINT (o_beg)) o_beg = beg;
-       if (XINT (end) > XINT (o_end)) o_end = end;
-       redisplay_region (b, XINT (o_beg), XINT (o_end));
-      }
-  }
+  /* If the overlay has changed buffers, do a thorough redisplay.  */
+  if (!EQ (buffer, obuffer))
+    windows_or_buffers_changed = 1;
+  else
+    /* Redisplay the area the overlay has just left, or just enclosed.  */
+    {
+      Lisp_Object o_beg = OVERLAY_START (overlay);
+      Lisp_Object o_end = OVERLAY_END   (overlay);
+      int change_beg, change_end;
 
-  b->overlays_before = Fdelq (overlay, b->overlays_before);
-  b->overlays_after  = Fdelq (overlay, b->overlays_after);
+      o_beg = OVERLAY_POSITION (o_beg);
+      o_end = OVERLAY_POSITION (o_end);
+
+      if (XINT (o_beg) == XINT (beg))
+       redisplay_region (b, XINT (o_end), XINT (end));
+      else if (XINT (o_end) == XINT (end))
+       redisplay_region (b, XINT (o_beg), XINT (beg));
+      else
+       {
+         if (XINT (beg) < XINT (o_beg)) o_beg = beg;
+         if (XINT (end) > XINT (o_end)) o_end = end;
+         redisplay_region (b, XINT (o_beg), XINT (o_end));
+       }
+    }
+
+  if (!NILP (obuffer))
+    {
+      ob->overlays_before = Fdelq (overlay, ob->overlays_before);
+      ob->overlays_after  = Fdelq (overlay, ob->overlays_after);
+    }
 
   Fset_marker (OVERLAY_START (overlay), beg, buffer);
   Fset_marker (OVERLAY_END   (overlay), end, buffer);
@@ -1595,7 +1637,7 @@ buffer.")
   /* This puts it in the right list, and in the right order.  */
   recenter_overlay_lists (b, XINT (b->overlay_center));
 
-  return overlay;
+  return unbind_to (count, overlay);
 }
 
 DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0,
@@ -1603,11 +1645,19 @@ DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0,
   (overlay)
      Lisp_Object overlay;
 {
+  Lisp_Object buffer;
   struct buffer *b;
+  int count = specpdl_ptr - specpdl;
 
   CHECK_OVERLAY (overlay, 0);
 
-  b = XBUFFER (Fmarker_buffer (OVERLAY_START (overlay)));
+  buffer = Fmarker_buffer (OVERLAY_START (overlay));
+  if (NILP (buffer))
+    return Qnil;
+
+  b = XBUFFER (buffer);
+
+  specbind (Qinhibit_quit, Qt);
 
   b->overlays_before = Fdelq (overlay, b->overlays_before);
   b->overlays_after  = Fdelq (overlay, b->overlays_after);
@@ -1619,7 +1669,7 @@ DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0,
   Fset_marker (OVERLAY_START (overlay), Qnil, Qnil);
   Fset_marker (OVERLAY_END   (overlay), Qnil, Qnil);
 
-  return Qnil;
+  return unbind_to (count, Qnil);
 }
 \f
 /* Overlay dissection functions.  */
@@ -1668,7 +1718,7 @@ OVERLAY.")
 
 \f
 DEFUN ("overlays-at", Foverlays_at, Soverlays_at, 1, 1, 0,
-  "Return a list of the overays that contain position POS.")
+  "Return a list of the overlays that contain position POS.")
   (pos)
      Lisp_Object pos;
 {
@@ -1819,6 +1869,100 @@ DEFUN ("overlay-put", Foverlay_put, Soverlay_put, 3, 3, 0,
   return value;
 }
 \f
+/* Run the modification-hooks of overlays that include
+   any part of the text in START to END.
+   Run the insert-before-hooks of overlay starting at END,
+   and the insert-after-hooks of overlay ending at START.  */
+
+void
+verify_overlay_modification (start, end)
+     Lisp_Object start, end;
+{
+  Lisp_Object prop, overlay, tail;
+  int insertion = EQ (start, end);
+
+  for (tail = current_buffer->overlays_before;
+       CONSP (tail);
+       tail = XCONS (tail)->cdr)
+    {
+      int startpos, endpos;
+      int ostart, oend;
+
+      overlay = XCONS (tail)->car;
+
+      ostart = OVERLAY_START (overlay);
+      oend = OVERLAY_END (overlay);
+      endpos = OVERLAY_POSITION (oend);
+      if (XFASTINT (start) > endpos)
+       break;
+      startpos = OVERLAY_POSITION (ostart);
+      if (XFASTINT (end) == startpos && insertion)
+       {
+         prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
+         call_overlay_mod_hooks (prop, overlay, start, end);
+       }
+      if (XFASTINT (start) == endpos && insertion)
+       {
+         prop = Foverlay_get (overlay, Qinsert_behind_hooks);
+         call_overlay_mod_hooks (prop, overlay, start, end);
+       }
+      if (insertion
+         ? (XFASTINT (start) > startpos && XFASTINT (end) < endpos)
+         : (XFASTINT (start) >= startpos && XFASTINT (end) <= endpos))
+       {
+         prop = Foverlay_get (overlay, Qmodification_hooks);
+         call_overlay_mod_hooks (prop, overlay, start, end);
+       }
+    }
+
+  for (tail = current_buffer->overlays_after;
+       CONSP (tail);
+       tail = XCONS (tail)->cdr)
+    {
+      int startpos, endpos;
+      int ostart, oend;
+
+      overlay = XCONS (tail)->car;
+
+      ostart = OVERLAY_START (overlay);
+      oend = OVERLAY_END (overlay);
+      startpos = OVERLAY_POSITION (ostart);
+      if (XFASTINT (end) < startpos)
+       break;
+      if (XFASTINT (end) == startpos && insertion)
+       {
+         prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
+         call_overlay_mod_hooks (prop, overlay, start, end);
+       }
+      if (XFASTINT (start) == endpos && insertion)
+       {
+         prop = Foverlay_get (overlay, Qinsert_behind_hooks);
+         call_overlay_mod_hooks (prop, overlay, start, end);
+       }
+      if (insertion
+         ? (XFASTINT (start) > startpos && XFASTINT (end) < endpos)
+         : (XFASTINT (start) >= startpos && XFASTINT (end) <= endpos))
+       {
+         prop = Foverlay_get (overlay, Qmodification_hooks);
+         call_overlay_mod_hooks (prop, overlay, start, end);
+       }
+    }
+}
+
+static void
+call_overlay_mod_hooks (list, overlay, start, end)
+     Lisp_Object list, overlay, start, end;
+{
+  struct gcpro gcpro1;
+  GCPRO1 (list);
+  while (!NILP (list))
+    {
+      call3 (Fcar (list), overlay, start, end);
+      list = Fcdr (list);
+    }
+  UNGCPRO;
+}
+\f
 /* Somebody has tried to store NEWVAL into the buffer-local slot with
    offset XUINT (valcontents), and NEWVAL has an unacceptable type.  */
 void
@@ -1954,6 +2098,7 @@ init_buffer ()
   char buf[MAXPATHLEN+1];
   char *pwd;
   struct stat dotstat, pwdstat;
+  Lisp_Object temp;
 
   Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
 
@@ -1976,6 +2121,9 @@ init_buffer ()
     strcat (buf, "/");
 #endif /* not VMS */
   current_buffer->directory = build_string (buf);
+
+  temp = get_minibuffer (0);
+  XBUFFER (temp)->directory = current_buffer->directory;
 }
 
 /* initialize the buffer routines */
@@ -2291,6 +2439,14 @@ Automatically local in all buffers.");
     "*Non-nil means deactivate the mark when the buffer contents change.");
   Vtransient_mark_mode = Qnil;
 
+  DEFVAR_LISP ("inhibit-read-only", &Vinhibit_read_only,
+    "*Non-nil means disregard read-only status of buffers or characters.\n\
+If the value is t, disregard `buffer-read-only' and all `read-only'\n\
+text properties.  If the value is a list, disregard `buffer-read-only'\n\
+and disregard a `read-only' text property if the property value\n\
+is a member of the list.");
+  Vinhibit_read_only = Qnil;
+
   defsubr (&Sbuffer_list);
   defsubr (&Sget_buffer);
   defsubr (&Sget_file_buffer);