(enlarge_buffer_text): Fix int -> EMACS_INT.
[bpt/emacs.git] / src / buffer.c
index 77af23a..021867c 100644 (file)
@@ -1,7 +1,8 @@
 /* Buffer manipulation primitives for GNU Emacs.
    Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994,
                  1995, 1997, 1998, 1999, 2000, 2001, 2002,
-                 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+                 2003, 2004, 2005, 2006, 2007, 2008
+                 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -107,12 +108,14 @@ static char buffer_permanent_local_flags[MAX_PER_BUFFER_VARS];
 
 int last_per_buffer_idx;
 
-Lisp_Object Fset_buffer ();
-void set_buffer_internal ();
-void set_buffer_internal_1 ();
-static void call_overlay_mod_hooks ();
-static void swap_out_buffer_local_variables ();
-static void reset_buffer_local_variables ();
+EXFUN (Fset_buffer, 1);
+void set_buffer_internal P_ ((struct buffer *b));
+void set_buffer_internal_1 P_ ((struct buffer *b));
+static void call_overlay_mod_hooks P_ ((Lisp_Object list, Lisp_Object overlay,
+                                       int after, Lisp_Object arg1,
+                                       Lisp_Object arg2, Lisp_Object arg3));
+static void swap_out_buffer_local_variables P_ ((struct buffer *b));
+static void reset_buffer_local_variables P_ ((struct buffer *b, int permanent_too));
 
 /* Alist of all buffer names vs the buffers. */
 /* This used to be a variable, but is no longer,
@@ -150,6 +153,7 @@ Lisp_Object Qucs_set_table_for_input;
 int inhibit_modification_hooks;
 
 Lisp_Object Qfundamental_mode, Qmode_class, Qpermanent_local;
+Lisp_Object Qpermanent_local_hook;
 
 Lisp_Object Qprotected_field;
 
@@ -492,7 +496,9 @@ clone_per_buffer_values (from, to)
 
   XSETBUFFER (to_buffer, to);
 
-  for (offset = PER_BUFFER_VAR_OFFSET (name) + sizeof (Lisp_Object);
+  /* buffer-local Lisp variables start at `undo_list',
+     tho only the ones from `name' on are GC'd normally.  */
+  for (offset = PER_BUFFER_VAR_OFFSET (undo_list) + sizeof (Lisp_Object);
        offset < sizeof *to;
        offset += sizeof (Lisp_Object))
     {
@@ -717,7 +723,7 @@ reset_buffer (b)
    it does not treat permanent locals consistently.
    Instead, use Fkill_all_local_variables.
 
-   If PERMANENT_TOO is 1, then we reset permanent built-in
+   If PERMANENT_TOO is 1, then we reset permanent
    buffer-local variables.  If PERMANENT_TOO is 0,
    we preserve those.  */
 
@@ -755,7 +761,48 @@ reset_buffer_local_variables (b, permanent_too)
 #endif
 
   /* Reset all (or most) per-buffer variables to their defaults.  */
-  b->local_var_alist = Qnil;
+  if (permanent_too)
+    b->local_var_alist = Qnil;
+  else
+    {
+      Lisp_Object tmp, prop, last = Qnil;
+      for (tmp = b->local_var_alist; CONSP (tmp); tmp = XCDR (tmp))
+       if (CONSP (XCAR (tmp))
+           && SYMBOLP (XCAR (XCAR (tmp)))
+           && !NILP (prop = Fget (XCAR (XCAR (tmp)), Qpermanent_local)))
+         {
+           /* If permanent-local, keep it.  */
+           last = tmp;
+           if (EQ (prop, Qpermanent_local_hook))
+             {
+               /* This is a partially permanent hook variable.
+                  Preserve only the elements that want to be preserved.  */
+               Lisp_Object list, newlist;
+               list = XCDR (XCAR (tmp));
+               if (!CONSP (list))
+                 newlist = list;
+               else
+                 for (newlist = Qnil; CONSP (list); list = XCDR (list))
+                   {
+                     Lisp_Object elt = XCAR (list);
+                     /* Preserve element ELT if it's t,
+                        if it is a function with a `permanent-local-hook' property,
+                        or if it's not a symbol.  */
+                     if (! SYMBOLP (elt)
+                         || EQ (elt, Qt)
+                         || !NILP (Fget (elt, Qpermanent_local_hook)))
+                       newlist = Fcons (elt, newlist);
+                   }
+               XSETCDR (XCAR (tmp), Fnreverse (newlist));
+             }
+         }
+       /* Delete this local variable.  */
+       else if (NILP (last))
+         b->local_var_alist = XCDR (tmp);
+       else
+         XSETCDR (last, XCDR (tmp));
+    }
+
   for (i = 0; i < last_per_buffer_idx; ++i)
     if (permanent_too || buffer_permanent_local_flags[i] == 0)
       SET_PER_BUFFER_VALUE_P (b, i, 0);
@@ -763,7 +810,9 @@ reset_buffer_local_variables (b, permanent_too)
   /* For each slot that has a default value,
      copy that into the slot.  */
 
-  for (offset = PER_BUFFER_VAR_OFFSET (name);
+  /* buffer-local Lisp variables start at `undo_list',
+     tho only the ones from `name' on are GC'd normally.  */
+  for (offset = PER_BUFFER_VAR_OFFSET (undo_list);
        offset < sizeof *b;
        offset += sizeof (Lisp_Object))
     {
@@ -895,7 +944,9 @@ is the default binding of the variable. */)
       int found = 0;
 
       /* Look in special slots */
-      for (offset = PER_BUFFER_VAR_OFFSET (name);
+      /* buffer-local Lisp variables start at `undo_list',
+        tho only the ones from `name' on are GC'd normally.  */
+      for (offset = PER_BUFFER_VAR_OFFSET (undo_list);
           offset < sizeof (struct buffer);
           /* sizeof EMACS_INT == sizeof Lisp_Object */
           offset += (sizeof (EMACS_INT)))
@@ -1006,7 +1057,9 @@ No argument or nil as argument means use current buffer as BUFFER.  */)
   {
     int offset, idx;
 
-    for (offset = PER_BUFFER_VAR_OFFSET (name);
+    /* buffer-local Lisp variables start at `undo_list',
+       tho only the ones from `name' on are GC'd normally.  */
+    for (offset = PER_BUFFER_VAR_OFFSET (undo_list);
         offset < sizeof (struct buffer);
         /* sizeof EMACS_INT == sizeof Lisp_Object */
         offset += (sizeof (EMACS_INT)))
@@ -1170,7 +1223,9 @@ buffer as BUFFER.  */)
 }
 \f
 DEFUN ("rename-buffer", Frename_buffer, Srename_buffer, 1, 2,
-       "sRename buffer (to new name): \nP",
+       "(list (read-string \"Rename buffer (to new name): \" \
+             nil 'buffer-name-history (buffer-name (current-buffer))) \
+             current-prefix-arg)",
        doc: /* Change current buffer's name to NEWNAME (a string).
 If second arg UNIQUE is nil or omitted, it is an error if a
 buffer named NEWNAME already exists.
@@ -1579,7 +1634,7 @@ record_buffer (buf)
   Vbuffer_alist = link;
 
   /* Effectively do a delq on buried_buffer_list.  */
-  
+
   prev = Qnil;
   for (link = XFRAME (frame)->buried_buffer_list; CONSP (link);
        link = XCDR (link))
@@ -1747,7 +1802,10 @@ the window-buffer correspondences.  */)
     }
 
   err = no_switch_window (selected_window);
-  if (err) error (err);
+  if (err)
+    /* If can't display in current window, let pop-to-buffer
+       try some other window. */
+    return call3 (intern ("pop-to-buffer"), buffer, Qnil, norecord);
 
   return switch_to_buffer_1 (buffer, norecord);
 }
@@ -2157,6 +2215,101 @@ advance_to_char_boundary (byte_pos)
   return byte_pos;
 }
 
+DEFUN ("buffer-swap-text", Fbuffer_swap_text, Sbuffer_swap_text,
+       1, 1, 0,
+       doc: /* Swap the text between current buffer and BUFFER.  */)
+     (buffer)
+     Lisp_Object buffer;
+{
+  struct buffer *other_buffer;
+  CHECK_BUFFER (buffer);
+  other_buffer = XBUFFER (buffer);
+
+  /* Actually, it probably works just fine.
+   * if (other_buffer == current_buffer)
+   *   error ("Cannot swap a buffer's text with itself"); */
+
+  /* Actually, this may be workable as well, tho probably only if they're
+     *both* indirect.  */
+  if (other_buffer->base_buffer
+      || current_buffer->base_buffer)
+    error ("Cannot swap indirect buffers's text");
+
+  { /* This is probably harder to make work.  */
+    struct buffer *other;
+    for (other = all_buffers; other; other = other->next)
+      if (other->base_buffer == other_buffer
+         || other->base_buffer == current_buffer)
+       error ("One of the buffers to swap has indirect buffers");
+  }
+
+#define swapfield(field, type) \
+  do {                                                 \
+    type tmp##field = other_buffer->field;             \
+    other_buffer->field = current_buffer->field;       \
+    current_buffer->field = tmp##field;                        \
+  } while (0)
+
+  swapfield (own_text, struct buffer_text);
+  eassert (current_buffer->text == &current_buffer->own_text);
+  eassert (other_buffer->text == &other_buffer->own_text);
+  swapfield (pt, EMACS_INT);
+  swapfield (pt_byte, EMACS_INT);
+  swapfield (begv, EMACS_INT);
+  swapfield (begv_byte, EMACS_INT);
+  swapfield (zv, EMACS_INT);
+  swapfield (zv_byte, EMACS_INT);
+  eassert (!current_buffer->base_buffer);
+  eassert (!other_buffer->base_buffer);
+  current_buffer->clip_changed = 1;    other_buffer->clip_changed = 1;
+  swapfield (newline_cache, struct region_cache *);
+  swapfield (width_run_cache, struct region_cache *);
+  current_buffer->prevent_redisplay_optimizations_p = 1;
+  other_buffer->prevent_redisplay_optimizations_p = 1;
+  swapfield (overlays_before, struct Lisp_Overlay *);
+  swapfield (overlays_after, struct Lisp_Overlay *);
+  swapfield (overlay_center, EMACS_INT);
+  swapfield (undo_list, Lisp_Object);
+  swapfield (mark, Lisp_Object);
+  if (MARKERP (current_buffer->mark) && XMARKER (current_buffer->mark)->buffer)
+    XMARKER (current_buffer->mark)->buffer = current_buffer;
+  if (MARKERP (other_buffer->mark) && XMARKER (other_buffer->mark)->buffer)
+    XMARKER (other_buffer->mark)->buffer = other_buffer;
+  swapfield (enable_multibyte_characters, Lisp_Object);
+  /* FIXME: Not sure what we should do with these *_marker fields.
+     Hopefully they're just nil anyway.  */
+  swapfield (pt_marker, Lisp_Object);
+  swapfield (begv_marker, Lisp_Object);
+  swapfield (zv_marker, Lisp_Object);
+  current_buffer->point_before_scroll = Qnil;
+  other_buffer->point_before_scroll = Qnil;
+
+  current_buffer->text->modiff++;        other_buffer->text->modiff++;
+  current_buffer->text->chars_modiff++;          other_buffer->text->chars_modiff++;
+  current_buffer->text->overlay_modiff++; other_buffer->text->overlay_modiff++;
+  current_buffer->text->beg_unchanged = current_buffer->text->gpt;
+  current_buffer->text->end_unchanged = current_buffer->text->gpt;
+  other_buffer->text->beg_unchanged = current_buffer->text->gpt;
+  other_buffer->text->end_unchanged = current_buffer->text->gpt;
+  {
+    struct Lisp_Marker *m;
+    for (m = BUF_MARKERS (current_buffer); m; m = m->next)
+      if (m->buffer == other_buffer)
+       m->buffer = current_buffer;
+    for (m = BUF_MARKERS (other_buffer); m; m = m->next)
+      if (m->buffer == current_buffer)
+       m->buffer = other_buffer;
+  }
+  if (current_buffer->text->intervals)
+    (eassert (EQ (current_buffer->text->intervals->up.obj, buffer)),
+     XSETBUFFER (current_buffer->text->intervals->up.obj, current_buffer));
+  if (other_buffer->text->intervals)
+    (eassert (EQ (other_buffer->text->intervals->up.obj, Fcurrent_buffer ())),
+     XSETBUFFER (other_buffer->text->intervals->up.obj, other_buffer));
+
+  return Qnil;
+}
+
 DEFUN ("set-buffer-multibyte", Fset_buffer_multibyte, Sset_buffer_multibyte,
        1, 1, 0,
        doc: /* Set the multibyte flag of the current buffer to FLAG.
@@ -2467,14 +2620,10 @@ The first thing this function does is run
 the normal hook `change-major-mode-hook'.  */)
      ()
 {
-  register Lisp_Object alist, sym, tem;
-  Lisp_Object oalist;
-
   if (!NILP (Vrun_hooks))
     call1 (Vrun_hooks, Qchange_major_mode_hook);
-  oalist = current_buffer->local_var_alist;
 
-  /* Make sure none of the bindings in oalist
+  /* Make sure none of the bindings in local_var_alist
      remain swapped in, in their symbols.  */
 
   swap_out_buffer_local_variables (current_buffer);
@@ -2483,20 +2632,6 @@ the normal hook `change-major-mode-hook'.  */)
 
   reset_buffer_local_variables (current_buffer, 0);
 
-  /* Any which are supposed to be permanent,
-     make local again, with the same values they had.  */
-
-  for (alist = oalist; CONSP (alist); alist = XCDR (alist))
-    {
-      sym = XCAR (XCAR (alist));
-      tem = Fget (sym, Qpermanent_local);
-      if (! NILP (tem))
-       {
-         Fmake_local_variable (sym);
-         Fset (sym, XCDR (XCAR (alist)));
-       }
-    }
-
   /* Force mode-line redisplay.  Useful here because all major mode
      commands call this function.  */
   update_mode_lines++;
@@ -2559,8 +2694,8 @@ overlays_at (pos, extend, vec_ptr, len_ptr, next_ptr, prev_ptr, change_req)
      int extend;
      Lisp_Object **vec_ptr;
      int *len_ptr;
-     int *next_ptr;
-     int *prev_ptr;
+     EMACS_INT *next_ptr;
+     EMACS_INT *prev_ptr;
      int change_req;
 {
   Lisp_Object overlay, start, end;
@@ -2678,8 +2813,9 @@ overlays_at (pos, extend, vec_ptr, len_ptr, next_ptr, prev_ptr, change_req)
   return idx;
 }
 \f
-/* Find all the overlays in the current buffer that overlap the range BEG-END
-   or are empty at BEG.
+/* Find all the overlays in the current buffer that overlap the range
+   BEG-END, or are empty at BEG, or are empty at END provided END
+   denotes the position at the end of the current buffer.
 
    Return the number found, and store them in a vector in *VEC_PTR.
    Store in *LEN_PTR the size allocated for the vector.
@@ -2714,6 +2850,7 @@ overlays_in (beg, end, extend, vec_ptr, len_ptr, next_ptr, prev_ptr)
   int next = ZV;
   int prev = BEGV;
   int inhibit_storing = 0;
+  int end_is_Z = end == Z;
 
   for (tail = current_buffer->overlays_before; tail; tail = tail->next)
     {
@@ -2731,10 +2868,12 @@ overlays_in (beg, end, extend, vec_ptr, len_ptr, next_ptr, prev_ptr)
          break;
        }
       startpos = OVERLAY_POSITION (ostart);
-      /* Count an interval if it either overlaps the range
-        or is empty at the start of the range.  */
+      /* Count an interval if it overlaps the range, is empty at the
+        start of the range, or is empty at END provided END denotes the
+        end of the buffer.  */
       if ((beg < endpos && startpos < end)
-         || (startpos == endpos && beg == endpos))
+         || (startpos == endpos
+             && (beg == endpos || (end_is_Z && endpos == end))))
        {
          if (idx == len)
            {
@@ -2779,10 +2918,12 @@ overlays_in (beg, end, extend, vec_ptr, len_ptr, next_ptr, prev_ptr)
          break;
        }
       endpos = OVERLAY_POSITION (oend);
-      /* Count an interval if it either overlaps the range
-        or is empty at the start of the range.  */
+      /* Count an interval if it overlaps the range, is empty at the
+        start of the range, or is empty at END provided END denotes the
+        end of the buffer.  */
       if ((beg < endpos && startpos < end)
-         || (startpos == endpos && beg == endpos))
+         || (startpos == endpos
+             && (beg == endpos || (end_is_Z && endpos == end))))
        {
          if (idx == len)
            {
@@ -3965,7 +4106,7 @@ DEFUN ("overlays-at", Foverlays_at, Soverlays_at, 1, 1, 0,
   /* Put all the overlays we want in a vector in overlay_vec.
      Store the length in len.  */
   noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
-                          (int *) 0, (int *) 0, 0);
+                          (EMACS_INT *) 0, (EMACS_INT *) 0, 0);
 
   /* Make a list of them all.  */
   result = Flist (noverlays, overlay_vec);
@@ -3978,8 +4119,9 @@ DEFUN ("overlays-in", Foverlays_in, Soverlays_in, 2, 2, 0,
        doc: /* Return a list of the overlays that overlap the region BEG ... END.
 Overlap means that at least one character is contained within the overlay
 and also contained within the specified region.
-Empty overlays are included in the result if they are located at BEG
-or between BEG and END.  */)
+Empty overlays are included in the result if they are located at BEG,
+between BEG and END, or at END provided END denotes the position at the
+end of the buffer.  */)
      (beg, end)
      Lisp_Object beg, end;
 {
@@ -4015,7 +4157,7 @@ the value is (point-max).  */)
      Lisp_Object pos;
 {
   int noverlays;
-  int endpos;
+  EMACS_INT endpos;
   Lisp_Object *overlay_vec;
   int len;
   int i;
@@ -4029,14 +4171,14 @@ the value is (point-max).  */)
      Store the length in len.
      endpos gets the position where the next overlay starts.  */
   noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
-                          &endpos, (int *) 0, 1);
+                          &endpos, (EMACS_INT *) 0, 1);
 
   /* If any of these overlays ends before endpos,
      use its ending point instead.  */
   for (i = 0; i < noverlays; i++)
     {
       Lisp_Object oend;
-      int oendpos;
+      EMACS_INT oendpos;
 
       oend = OVERLAY_END (overlay_vec[i]);
       oendpos = OVERLAY_POSITION (oend);
@@ -4057,7 +4199,7 @@ the value is (point-min).  */)
      Lisp_Object pos;
 {
   int noverlays;
-  int prevpos;
+  EMACS_INT prevpos;
   Lisp_Object *overlay_vec;
   int len;
 
@@ -4075,7 +4217,7 @@ the value is (point-min).  */)
      Store the length in len.
      prevpos gets the position of the previous change.  */
   noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
-                          (int *) 0, &prevpos, 1);
+                          (EMACS_INT *) 0, &prevpos, 1);
 
   xfree (overlay_vec);
   return make_number (prevpos);
@@ -4198,8 +4340,10 @@ add_overlay_mod_hooklist (functionlist, overlay)
   if (last_overlay_modification_hooks_used == oldsize)
     last_overlay_modification_hooks = larger_vector 
       (last_overlay_modification_hooks, oldsize * 2, Qnil);
-  AREF (last_overlay_modification_hooks, last_overlay_modification_hooks_used++) = functionlist;
-  AREF (last_overlay_modification_hooks, last_overlay_modification_hooks_used++) = overlay;
+  ASET (last_overlay_modification_hooks, last_overlay_modification_hooks_used,
+       functionlist); last_overlay_modification_hooks_used++;
+  ASET (last_overlay_modification_hooks, last_overlay_modification_hooks_used,
+       overlay);      last_overlay_modification_hooks_used++;
 }
 \f
 /* Run the modification-hooks of overlays that include
@@ -4937,9 +5081,7 @@ alloc_buffer_text (b, nbytes)
    shrink it.  */
 
 void
-enlarge_buffer_text (b, delta)
-     struct buffer *b;
-     int delta;
+enlarge_buffer_text (struct buffer *b, EMACS_INT delta)
 {
   POINTER_TYPE *p;
   size_t nbytes = (BUF_Z_BYTE (b) - BUF_BEG_BYTE (b) + BUF_GAP_SIZE (b) + 1
@@ -5305,6 +5447,8 @@ syms_of_buffer ()
   staticpro (&Vbuffer_alist);
   staticpro (&Qprotected_field);
   staticpro (&Qpermanent_local);
+  Qpermanent_local_hook = intern ("permanent-local-hook");
+  staticpro (&Qpermanent_local_hook);
   staticpro (&Qkill_buffer_hook);
   Qoverlayp = intern ("overlayp");
   staticpro (&Qoverlayp);
@@ -5332,6 +5476,7 @@ syms_of_buffer ()
   staticpro (&Qbefore_change_functions);
   Qafter_change_functions = intern ("after-change-functions");
   staticpro (&Qafter_change_functions);
+  /* The next one is initialized in init_buffer_once.  */
   staticpro (&Qucs_set_table_for_input);
 
   Qkill_buffer_query_functions = intern ("kill-buffer-query-functions");
@@ -5572,7 +5717,9 @@ its hooks should not expect certain variables such as
 
   DEFVAR_PER_BUFFER ("mode-name", &current_buffer->mode_name,
                      Qnil,
-                    doc: /* Pretty name of current buffer's major mode (a string).  */);
+                    doc: /* Pretty name of current buffer's major mode.
+Usually a string.  See `mode-line-format' for other possible forms.
+Use the function `format-mode-line' to get the value as a string.  */);
 
   DEFVAR_PER_BUFFER ("local-abbrev-table", &current_buffer->abbrev_table, Qnil,
                     doc: /* Local (mode-specific) abbrev table of current buffer.  */);
@@ -6145,6 +6292,7 @@ The function `kill-all-local-variables' runs this before doing anything else.  *
   defsubr (&Sbarf_if_buffer_read_only);
   defsubr (&Sbury_buffer);
   defsubr (&Serase_buffer);
+  defsubr (&Sbuffer_swap_text);
   defsubr (&Sset_buffer_multibyte);
   defsubr (&Skill_all_local_variables);