(parse_single_submenu): Use individual keymap's prompt
[bpt/emacs.git] / src / buffer.c
index 27ad623..9836ecc 100644 (file)
@@ -157,6 +157,7 @@ Lisp_Object Vfirst_change_hook;
 Lisp_Object Qfirst_change_hook;
 Lisp_Object Qbefore_change_functions;
 Lisp_Object Qafter_change_functions;
+Lisp_Object Qucs_set_table_for_input;
 
 /* If nonzero, all modification hooks are suppressed.  */
 int inhibit_modification_hooks;
@@ -193,7 +194,7 @@ nsberror (spec)
      Lisp_Object spec;
 {
   if (STRINGP (spec))
-    error ("No buffer named %s", XSTRING (spec)->data);
+    error ("No buffer named %s", SDATA (spec));
   error ("Invalid buffer argument");
 }
 \f
@@ -209,7 +210,9 @@ Value is nil if OBJECT is not a buffer or if it has been killed.  */)
 
 DEFUN ("buffer-list", Fbuffer_list, Sbuffer_list, 0, 1, 0,
        doc: /* Return a list of all existing live buffers.
-If the optional arg FRAME is a frame, we return that frame's buffer list.  */)
+If the optional arg FRAME is a frame, we return the buffer list
+in the proper order for that frame: the buffers in FRAME's `buffer-list'
+frame parameter come first, followed by the rest of the buffers.  */)
      (frame)
      Lisp_Object frame;
 {
@@ -247,10 +250,10 @@ assoc_ignore_text_properties (key, list)
      Lisp_Object list;
 {
   register Lisp_Object tail;
-  for (tail = list; !NILP (tail); tail = Fcdr (tail))
+  for (tail = list; CONSP (tail); tail = XCDR (tail))
     {
       register Lisp_Object elt, tem;
-      elt = Fcar (tail);
+      elt = XCAR (tail);
       tem = Fstring_equal (Fcar (elt), key);
       if (!NILP (tem))
        return elt;
@@ -341,7 +344,7 @@ The value is never nil.  */)
   if (!NILP (buf))
     return buf;
 
-  if (XSTRING (name)->size == 0)
+  if (SCHARS (name) == 0)
     error ("Empty string for buffer name is not allowed");
 
   b = (struct buffer *) allocate_buffer ();
@@ -361,16 +364,16 @@ The value is never nil.  */)
   if (! BUF_BEG_ADDR (b))
     buffer_memory_full ();
 
-  BUF_PT (b) = 1;
-  BUF_GPT (b) = 1;
-  BUF_BEGV (b) = 1;
-  BUF_ZV (b) = 1;
-  BUF_Z (b) = 1;
-  BUF_PT_BYTE (b) = 1;
-  BUF_GPT_BYTE (b) = 1;
-  BUF_BEGV_BYTE (b) = 1;
-  BUF_ZV_BYTE (b) = 1;
-  BUF_Z_BYTE (b) = 1;
+  BUF_PT (b) = BEG;
+  BUF_GPT (b) = BEG;
+  BUF_BEGV (b) = BEG;
+  BUF_ZV (b) = BEG;
+  BUF_Z (b) = BEG;
+  BUF_PT_BYTE (b) = BEG_BYTE;
+  BUF_GPT_BYTE (b) = BEG_BYTE;
+  BUF_BEGV_BYTE (b) = BEG_BYTE;
+  BUF_ZV_BYTE (b) = BEG_BYTE;
+  BUF_Z_BYTE (b) = BEG_BYTE;
   BUF_MODIFF (b) = 1;
   BUF_OVERLAY_MODIFF (b) = 1;
   BUF_SAVE_MODIFF (b) = 1;
@@ -397,10 +400,10 @@ The value is never nil.  */)
   b->zv_marker = Qnil;
 
   name = Fcopy_sequence (name);
-  XSTRING (name)->intervals = NULL_INTERVAL;
+  STRING_SET_INTERVALS (name, NULL_INTERVAL);
   b->name = name;
 
-  if (XSTRING (name)->data[0] != ' ')
+  if (SREF (name, 0) != ' ')
     b->undo_list = Qnil;
   else
     b->undo_list = Qt;
@@ -408,13 +411,20 @@ The value is never nil.  */)
   reset_buffer (b);
   reset_buffer_local_variables (b, 1);
 
+  b->mark = Fmake_marker ();
+  BUF_MARKERS (b) = Qnil;
+  b->name = name;
+
   /* Put this in the alist of all live buffers.  */
   XSETBUFFER (buf, b);
   Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));
 
-  b->mark = Fmake_marker ();
-  BUF_MARKERS (b) = Qnil;
-  b->name = name;
+  /* Fixme:  Protect against errors, which would trigger infinite
+     regress?  */
+  if (!NILP (Ffboundp (Qucs_set_table_for_input)))
+    /* buff is on buffer-alist, so no gcpro */
+    call1 (Qucs_set_table_for_input, buf);
+
   return buf;
 }
 
@@ -520,13 +530,13 @@ CLONE nil means the indirect buffer's state is reset to default values.  */)
 
   buf = Fget_buffer (name);
   if (!NILP (buf))
-    error ("Buffer name `%s' is in use", XSTRING (name)->data);
+    error ("Buffer name `%s' is in use", SDATA (name));
 
   base_buffer = Fget_buffer (base_buffer);
   if (NILP (base_buffer))
-    error ("No such buffer: `%s'", XSTRING (name)->data);
+    error ("No such buffer: `%s'", SDATA (name));
 
-  if (XSTRING (name)->size == 0)
+  if (SCHARS (name) == 0)
     error ("Empty string for buffer name is not allowed");
 
   b = (struct buffer *) allocate_buffer ();
@@ -556,7 +566,7 @@ CLONE nil means the indirect buffer's state is reset to default values.  */)
   all_buffers = b;
 
   name = Fcopy_sequence (name);
-  XSTRING (name)->intervals = NULL_INTERVAL;
+  STRING_SET_INTERVALS (name, NULL_INTERVAL);
   b->name = name;
 
   reset_buffer (b);
@@ -693,11 +703,6 @@ reset_buffer_local_variables (b, permanent_too)
   b->buffer_file_type = Qnil;
 #endif
 
-#if 0
-  b->sort_table = XSTRING (Vascii_sort_table);
-  b->folding_sort_table = XSTRING (Vascii_folding_sort_table);
-#endif /* 0 */
-
   /* Reset all (or most) per-buffer variables to their defaults.  */
   b->local_var_alist = Qnil;
   for (i = 0; i < last_per_buffer_idx; ++i)
@@ -854,7 +859,26 @@ is the default binding of variable. */)
        result = Fdefault_value (symbol);
     }
   else
-    result = XCDR (result);
+    {
+      Lisp_Object valcontents;
+      Lisp_Object current_alist_element;
+
+      /* What binding is loaded right now?  */
+      valcontents = SYMBOL_VALUE (symbol);
+      current_alist_element
+       = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr);
+
+      /* The value of the currently loaded binding is not
+        stored in it, but rather in the realvalue slot.
+        Store that value into the binding it belongs to
+        in case that is the one we are about to use.  */
+
+      Fsetcdr (current_alist_element,
+              do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue));
+
+      /* Now get the (perhaps updated) value out of the binding.  */
+      result = XCDR (result);
+    }
 
   if (EQ (result, Qunbound))
     return Fsignal (Qvoid_variable, Fcons (symbol, Qnil));
@@ -1072,7 +1096,7 @@ This does not change the name of the visited file (if any).  */)
 
   CHECK_STRING (newname);
 
-  if (XSTRING (newname)->size == 0)
+  if (SCHARS (newname) == 0)
     error ("Empty string is invalid as a buffer name");
 
   tem = Fget_buffer (newname);
@@ -1087,7 +1111,7 @@ This does not change the name of the visited file (if any).  */)
       if (!NILP (unique))
        newname = Fgenerate_new_buffer_name (newname, current_buffer->name);
       else
-       error ("Buffer name `%s' is in use", XSTRING (newname)->data);
+       error ("Buffer name `%s' is in use", SDATA (newname));
     }
 
   current_buffer->name = newname;
@@ -1139,12 +1163,12 @@ If BUFFER is omitted or nil, some interesting buffer is returned.  */)
     }
   tail = nconc2 (Fnreverse (add_ons), tail);
 
-  for (; !NILP (tail); tail = Fcdr (tail))
+  for (; CONSP (tail); tail = XCDR (tail))
     {
-      buf = Fcdr (Fcar (tail));
+      buf = Fcdr (XCAR (tail));
       if (EQ (buf, buffer))
        continue;
-      if (XSTRING (XBUFFER (buf)->name)->data[0] == ' ')
+      if (SREF (XBUFFER (buf)->name, 0) == ' ')
        continue;
       /* If the selected frame has a buffer_predicate,
         disregard buffers that don't fit the predicate.  */
@@ -1270,7 +1294,7 @@ with SIGHUP.  */)
     {
       GCPRO1 (buf);
       tem = do_yes_or_no_p (format1 ("Buffer %s modified; kill anyway? ",
-                                    XSTRING (b->name)->data));
+                                    SDATA (b->name)));
       UNGCPRO;
       if (NILP (tem))
        return Qnil;
@@ -1278,7 +1302,7 @@ with SIGHUP.  */)
 
   /* Run hooks with the buffer to be killed the current buffer.  */
   {
-    int count = specpdl_ptr - specpdl;
+    int count = SPECPDL_INDEX ();
     Lisp_Object list;
 
     record_unwind_protect (save_excursion_restore, save_excursion_save ());
@@ -1286,9 +1310,9 @@ with SIGHUP.  */)
 
     /* First run the query functions; if any query is answered no,
        don't kill the buffer.  */
-    for (list = Vkill_buffer_query_functions; !NILP (list); list = Fcdr (list))
+    for (list = Vkill_buffer_query_functions; CONSP (list); list = XCDR (list))
       {
-       tem = call0 (Fcar (list));
+       tem = call0 (XCAR (list));
        if (NILP (tem))
          return unbind_to (count, Qnil);
       }
@@ -1516,7 +1540,7 @@ the current buffer's major mode.  */)
   Lisp_Object function;
 
   if (STRINGP (XBUFFER (buffer)->name)
-      && strcmp (XSTRING (XBUFFER (buffer)->name)->data, "*scratch*") == 0)
+      && strcmp (SDATA (XBUFFER (buffer)->name), "*scratch*") == 0)
     function = find_symbol_value (intern ("initial-major-mode"));
   else
     {
@@ -1529,7 +1553,7 @@ the current buffer's major mode.  */)
   if (NILP (function) || EQ (function, Qfundamental_mode))
     return Qnil;
 
-  count = specpdl_ptr - specpdl;
+  count = SPECPDL_INDEX ();
 
   /* To select a nonfundamental mode,
      select the buffer temporarily and then call the mode function. */
@@ -1932,7 +1956,10 @@ selected window if it is displayed there.  */)
       XSETCDR (link, Qnil);
       Vbuffer_alist = nconc2 (Vbuffer_alist, link);
 
-      frames_bury_buffer (buffer);
+      /* Removing BUFFER from frame-specific lists
+        has the effect of putting BUFFER at the end
+        of the combined list in each frame.  */
+      frames_discard_buffer (buffer);
     }
 
   return Qnil;
@@ -1985,7 +2012,7 @@ advance_to_char_boundary (byte_pos)
 
   if (byte_pos == BEG)
     /* Beginning of buffer is always a character boundary.  */
-    return 1;
+    return BEG;
 
   c = FETCH_BYTE (byte_pos);
   if (! CHAR_HEAD_P (c))
@@ -2479,9 +2506,11 @@ overlays_at (pos, extend, vec_ptr, len_ptr, next_ptr, prev_ptr, change_req)
            {
              if (extend)
                {
-                 *len_ptr = len *= 2;
+                 /* Make it work with an initial len == 0.  */
+                 len *= 2;
                  if (len == 0)
-                   len = *len_ptr = 4;
+                   len = 4;
+                 *len_ptr = len;
                  vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
                  *vec_ptr = vec;
                }
@@ -2575,7 +2604,11 @@ overlays_in (beg, end, extend, vec_ptr, len_ptr, next_ptr, prev_ptr)
                 Either make it bigger, or don't store any more in it.  */
              if (extend)
                {
-                 *len_ptr = len *= 2;
+                 /* Make it work with an initial len == 0.  */
+                 len *= 2;
+                 if (len == 0)
+                   len = 4;
+                 *len_ptr = len;
                  vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
                  *vec_ptr = vec;
                }
@@ -2619,7 +2652,11 @@ overlays_in (beg, end, extend, vec_ptr, len_ptr, next_ptr, prev_ptr)
            {
              if (extend)
                {
-                 *len_ptr = len *= 2;
+                 /* Make it work with an initial len == 0.  */
+                 len *= 2;
+                 if (len == 0)
+                   len = 4;
+                 *len_ptr = len;
                  vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
                  *vec_ptr = vec;
                }
@@ -2861,24 +2898,24 @@ record_overlay_string (ssl, str, str2, pri, size)
   ssl->used++;
 
   if (NILP (current_buffer->enable_multibyte_characters))
-    nbytes = XSTRING (str)->size;
+    nbytes = SCHARS (str);
   else if (! STRING_MULTIBYTE (str))
-    nbytes = count_size_as_multibyte (XSTRING (str)->data,
-                                     STRING_BYTES (XSTRING (str)));
+    nbytes = count_size_as_multibyte (SDATA (str),
+                                     SBYTES (str));
   else
-    nbytes = STRING_BYTES (XSTRING (str));
+    nbytes = SBYTES (str);
 
   ssl->bytes += nbytes;
 
   if (STRINGP (str2))
     {
       if (NILP (current_buffer->enable_multibyte_characters))
-       nbytes = XSTRING (str2)->size;
+       nbytes = SCHARS (str2);
       else if (! STRING_MULTIBYTE (str2))
-       nbytes = count_size_as_multibyte (XSTRING (str2)->data,
-                                         STRING_BYTES (XSTRING (str2)));
+       nbytes = count_size_as_multibyte (SDATA (str2),
+                                         SBYTES (str2));
       else
-       nbytes = STRING_BYTES (XSTRING (str2));
+       nbytes = SBYTES (str2);
 
       ssl->bytes += nbytes;
     }
@@ -2990,8 +3027,8 @@ overlay_strings (pos, w, pstr)
        {
          int nbytes;
          tem = overlay_tails.buf[i].string;
-         nbytes = copy_text (XSTRING (tem)->data, p,
-                             STRING_BYTES (XSTRING (tem)),
+         nbytes = copy_text (SDATA (tem), p,
+                             SBYTES (tem),
                              STRING_MULTIBYTE (tem), multibyte);
          p += nbytes;
        }
@@ -2999,15 +3036,15 @@ overlay_strings (pos, w, pstr)
        {
          int nbytes;
          tem = overlay_heads.buf[i].string;
-         nbytes = copy_text (XSTRING (tem)->data, p,
-                             STRING_BYTES (XSTRING (tem)),
+         nbytes = copy_text (SDATA (tem), p,
+                             SBYTES (tem),
                              STRING_MULTIBYTE (tem), multibyte);
          p += nbytes;
          tem = overlay_heads.buf[i].string2;
          if (STRINGP (tem))
            {
-             nbytes = copy_text (XSTRING (tem)->data, p,
-                                 STRING_BYTES (XSTRING (tem)),
+             nbytes = copy_text (SDATA (tem), p,
+                                 SBYTES (tem),
                                  STRING_MULTIBYTE (tem), multibyte);
              p += nbytes;
            }
@@ -3424,7 +3461,8 @@ fix_overlays_before (bp, prev, pos)
          Lisp_Object found = tail;
 
          /* Unlink the found overlay.  */
-         XSETCDR (parent, XCDR (found));
+         tail = XCDR (found);
+         XSETCDR (parent, tail);
          /* Move an overlay at RIGHT_PLACE to the next of the found one,
             and link it into the right place.  */
          if (NILP (right_pair))
@@ -3563,7 +3601,7 @@ buffer.  */)
 {
   struct buffer *b, *ob;
   Lisp_Object obuffer;
-  int count = specpdl_ptr - specpdl;
+  int count = SPECPDL_INDEX ();
 
   CHECK_OVERLAY (overlay);
   if (NILP (buffer))
@@ -3664,7 +3702,7 @@ DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0,
 {
   Lisp_Object buffer;
   struct buffer *b;
-  int count = specpdl_ptr - specpdl;
+  int count = SPECPDL_INDEX ();
 
   CHECK_OVERLAY (overlay);
 
@@ -3911,28 +3949,8 @@ DEFUN ("overlay-get", Foverlay_get, Soverlay_get, 2, 2, 0,
      (overlay, prop)
      Lisp_Object overlay, prop;
 {
-  Lisp_Object plist, fallback;
-
   CHECK_OVERLAY (overlay);
-
-  fallback = Qnil;
-
-  for (plist = XOVERLAY (overlay)->plist;
-       CONSP (plist) && CONSP (XCDR (plist));
-       plist = XCDR (XCDR (plist)))
-    {
-      if (EQ (XCAR (plist), prop))
-       return XCAR (XCDR (plist));
-      else if (EQ (XCAR (plist), Qcategory))
-       {
-         Lisp_Object tem;
-         tem = Fcar (Fcdr (plist));
-         if (SYMBOLP (tem))
-           fallback = Fget (tem, prop);
-       }
-    }
-
-  return fallback;
+  return lookup_char_property (XOVERLAY (overlay)->plist, prop, 0);
 }
 
 DEFUN ("overlay-put", Foverlay_put, Soverlay_put, 3, 3, 0,
@@ -4199,13 +4217,13 @@ call_overlay_mod_hooks (list, overlay, after, arg1, arg2, arg3)
   if (! after)
     add_overlay_mod_hooklist (list, overlay);
 
-  while (!NILP (list))
+  while (CONSP (list))
     {
       if (NILP (arg3))
-       call4 (Fcar (list), overlay, after ? Qt : Qnil, arg1, arg2);
+       call4 (XCAR (list), overlay, after ? Qt : Qnil, arg1, arg2);
       else
-       call5 (Fcar (list), overlay, after ? Qt : Qnil, arg1, arg2, arg3);
-      list = Fcdr (list);
+       call5 (XCAR (list), overlay, after ? Qt : Qnil, arg1, arg2, arg3);
+      list = XCDR (list);
     }
   UNGCPRO;
 }
@@ -4279,7 +4297,7 @@ buffer_slot_type_mismatch (offset)
 
   sym = PER_BUFFER_SYMBOL (offset);
   error ("Only %s should be stored in the buffer-local variable %s",
-        type_name, XSTRING (SYMBOL_NAME (sym))->data);
+        type_name, SDATA (SYMBOL_NAME (sym)));
 }
 
 \f
@@ -4393,8 +4411,8 @@ static int mmap_initialized_p;
 
 #define MEM_ALIGN      sizeof (double)
 
-/* Predicate returning true if part of the address range [START ..
-   END[ is currently mapped.  Used to prevent overwriting an existing
+/* Predicate returning true if part of the address range [START .. END]
+   is currently mapped.  Used to prevent overwriting an existing
    memory mapping.
 
    Default is to conservativly assume the address range is occupied by
@@ -4671,8 +4689,12 @@ mmap_realloc (var, nbytes)
       else if (room - nbytes >= mmap_page_size)
        {
          /* Shrinking by at least a page.  Let's give some
-            memory back to the system.  */
-         mmap_enlarge (r, - (room - nbytes) / mmap_page_size);
+            memory back to the system.
+
+            The extra parens are to make the division happens first,
+            on positive values, so we know it will round towards
+            zero.  */
+         mmap_enlarge (r, - ((room - nbytes) / mmap_page_size));
          result = *var;
          r->nbytes_specified = nbytes;
        }
@@ -4987,6 +5009,8 @@ init_buffer_once ()
 
   Qkill_buffer_hook = intern ("kill-buffer-hook");
 
+  Qucs_set_table_for_input = intern ("ucs-set-table-for-input");
+
   Vprin1_to_string_buffer = Fget_buffer_create (build_string (" prin1"));
 
   /* super-magic invisible buffer */
@@ -5063,7 +5087,7 @@ init_buffer ()
         because of the ange-ftp completion handler.
         However, it is not necessary to turn / into /:/.
         So avoid doing that.  */
-      && strcmp ("/", XSTRING (current_buffer->directory)->data))
+      && strcmp ("/", SDATA (current_buffer->directory)))
     current_buffer->directory
       = concat2 (build_string ("/:"), current_buffer->directory);
 
@@ -5114,6 +5138,7 @@ syms_of_buffer ()
   staticpro (&Qbefore_change_functions);
   Qafter_change_functions = intern ("after-change-functions");
   staticpro (&Qafter_change_functions);
+  staticpro (&Qucs_set_table_for_input);
 
   Fput (Qprotected_field, Qerror_conditions,
        Fcons (Qprotected_field, Fcons (Qerror, Qnil)));
@@ -5243,8 +5268,14 @@ A value of nil means don't display a mode line.
 For a symbol, its value is used (but it is ignored if t or nil).
  A string appearing directly as the value of a symbol is processed verbatim
  in that the %-constructs below are not recognized.
+ Note that unless the symbol is marked as a `risky-local-variable', all
+ properties in any strings, as well as all :eval and :propertize forms 
+ in the value of that symbol will be ignored.
 For a list of the form `(:eval FORM)', FORM is evaluated and the result
- is used as a mode line element.
+ is used as a mode line element.  Be careful--FORM should not load any files,
+ because that can cause an infinite recursion.
+For a list of the form `(:propertize ELT PROPS...)', ELT is displayed
+ with the specified properties PROPS applied.
 For a list whose car is a symbol, the symbol's value is taken,
  and if that is non-nil, the cadr of the list is processed recursively.
  Otherwise, the caddr of the list (if there is one) is processed.
@@ -5298,7 +5329,8 @@ nil here means use current buffer's major mode.  */);
 
   DEFVAR_PER_BUFFER ("fill-column", &current_buffer->fill_column,
                     make_number (Lisp_Int),
-                    doc: /* *Column beyond which automatic line-wrapping should happen.  */);
+                    doc: /* *Column beyond which automatic line-wrapping should happen.
+Interactively, you can set this using \\[set-fill-column].  */);
 
   DEFVAR_PER_BUFFER ("left-margin", &current_buffer->left_margin,
                     make_number (Lisp_Int),
@@ -5660,14 +5692,17 @@ is a member of the list.  */);
   Vinhibit_read_only = Qnil;
 
   DEFVAR_PER_BUFFER ("cursor-type", &current_buffer->cursor_type, Qnil,
-                    doc: /* Cursor to use in window displaying this buffer.
+     doc: /* Cursor to use when this buffer is in the selected window.
 Values are interpreted as follows:
 
-  t            use the cursor specified for the frame
-  nil          don't display a cursor
-  `bar'                display a bar cursor with default width
-  (bar . WIDTH)        display a bar cursor with width WIDTH
-  others       display a box cursor.  */);
+  t             use the cursor specified for the frame
+  nil           don't display a cursor
+  bar           display a bar cursor with default width
+  (bar . WIDTH)         display a bar cursor with width WIDTH
+  ANYTHING ELSE         display a box cursor.
+
+When the buffer is displayed in a nonselected window,
+this variable has no effect; the cursor appears as a hollow box.  */);
 
   DEFVAR_PER_BUFFER ("line-spacing",
                     &current_buffer->extra_line_spacing, Qnil,