]> code.delx.au - gnu-emacs/blobdiff - src/minibuf.c
Remove now-inaccurate bytecode comments
[gnu-emacs] / src / minibuf.c
index c03316965d376612e2aa814a464dfbdead701580..57eea05b0fc897a6b17eb6d394da570104d97109 100644 (file)
@@ -1,13 +1,13 @@
 /* Minibuffer input and completion.
 
-Copyright (C) 1985-1986, 1993-2015 Free Software Foundation, Inc.
+Copyright (C) 1985-1986, 1993-2016 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 3 of the License, or
-(at your option) any later version.
+the Free Software Foundation, either version 3 of the License, 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
@@ -25,17 +25,12 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include <binary-io.h>
 
 #include "lisp.h"
-#include "commands.h"
 #include "character.h"
 #include "buffer.h"
-#include "dispextern.h"
 #include "keyboard.h"
 #include "frame.h"
 #include "window.h"
-#include "syntax.h"
-#include "intervals.h"
 #include "keymap.h"
-#include "termhooks.h"
 #include "systty.h"
 
 /* List of buffers for use as minibuffers.
@@ -150,12 +145,9 @@ static void run_exit_minibuf_hook (void);
 static Lisp_Object
 string_to_object (Lisp_Object val, Lisp_Object defalt)
 {
-  struct gcpro gcpro1, gcpro2;
   Lisp_Object expr_and_pos;
   ptrdiff_t pos;
 
-  GCPRO2 (val, defalt);
-
   if (STRINGP (val) && SCHARS (val) == 0)
     {
       if (STRINGP (defalt))
@@ -181,7 +173,7 @@ string_to_object (Lisp_Object val, Lisp_Object defalt)
     }
 
   val = Fcar (expr_and_pos);
-  RETURN_UNGCPRO (val);
+  return val;
 }
 
 
@@ -202,7 +194,7 @@ read_minibuf_noninteractive (Lisp_Object map, Lisp_Object initial,
   int c;
   unsigned char hide_char = 0;
   struct emacs_tty etty;
-  bool etty_valid;
+  bool etty_valid UNINIT;
 
   /* Check, whether we need to suppress echoing.  */
   if (CHARACTERP (Vread_hide_char))
@@ -211,10 +203,10 @@ read_minibuf_noninteractive (Lisp_Object map, Lisp_Object initial,
   /* Manipulate tty.  */
   if (hide_char)
     {
-      etty_valid = emacs_get_tty (fileno (stdin), &etty) == 0;
+      etty_valid = emacs_get_tty (STDIN_FILENO, &etty) == 0;
       if (etty_valid)
-       set_binary_mode (fileno (stdin), O_BINARY);
-      suppress_echo_on_tty (fileno (stdin));
+       set_binary_mode (STDIN_FILENO, O_BINARY);
+      suppress_echo_on_tty (STDIN_FILENO);
     }
 
   fwrite (SDATA (prompt), 1, SBYTES (prompt), stdout);
@@ -237,12 +229,7 @@ read_minibuf_noninteractive (Lisp_Object map, Lisp_Object initial,
          if (hide_char)
            fprintf (stdout, "%c", hide_char);
          if (len == size)
-           {
-             if (STRING_BYTES_BOUND / 2 < size)
-               memory_full (SIZE_MAX);
-             size *= 2;
-             line = xrealloc (line, size);
-           }
+           line = xpalloc (line, &size, 1, -1, sizeof *line);
          line[len++] = c;
        }
     }
@@ -253,8 +240,8 @@ read_minibuf_noninteractive (Lisp_Object map, Lisp_Object initial,
       fprintf (stdout, "\n");
       if (etty_valid)
        {
-         emacs_set_tty (fileno (stdin), &etty, 0);
-         set_binary_mode (fileno (stdin), O_TEXT);
+         emacs_set_tty (STDIN_FILENO, &etty, 0);
+         set_binary_mode (STDIN_FILENO, O_TEXT);
        }
     }
 
@@ -384,7 +371,6 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
   Lisp_Object val;
   ptrdiff_t count = SPECPDL_INDEX ();
   Lisp_Object mini_frame, ambient_dir, minibuffer, input_method;
-  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
   Lisp_Object enable_multibyte;
   EMACS_INT pos = 0;
   /* String to add to the history.  */
@@ -437,11 +423,6 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
   input_method = Qnil;
   enable_multibyte = Qnil;
 
-  /* Don't need to protect PROMPT, HISTVAR, and HISTPOS because we
-     store them away before we can GC.  Don't need to protect
-     BACKUP_N because we use the value only if it is an integer.  */
-  GCPRO5 (map, initial, val, ambient_dir, input_method);
-
   if (!STRINGP (prompt))
     prompt = empty_unibyte_string;
 
@@ -466,7 +447,6 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
                                         make_number (pos),
                                         expflag, histvar, histpos, defalt,
                                         allow_props, inherit_input_method);
-      UNGCPRO;
       return unbind_to (count, val);
     }
 
@@ -650,8 +630,31 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
                            Qrear_nonsticky, Qt, Qnil);
        Fput_text_property (make_number (BEG), make_number (PT),
                            Qfield, Qt, Qnil);
-       Fadd_text_properties (make_number (BEG), make_number (PT),
-                             Vminibuffer_prompt_properties, Qnil);
+       if (CONSP (Vminibuffer_prompt_properties))
+         {
+           /* We want to apply all properties from
+              `minibuffer-prompt-properties' to the region normally,
+              but if the `face' property is present, add that
+              property to the end of the face properties to avoid
+              overwriting faces. */
+           Lisp_Object list = Vminibuffer_prompt_properties;
+           while (CONSP (list))
+             {
+               Lisp_Object key = XCAR (list);
+               list = XCDR (list);
+               if (CONSP (list))
+                 {
+                   Lisp_Object val = XCAR (list);
+                   list = XCDR (list);
+                   if (EQ (key, Qface))
+                     Fadd_face_text_property (make_number (BEG),
+                                              make_number (PT), val, Qt, Qnil);
+                   else
+                     Fput_text_property (make_number (BEG), make_number (PT),
+                                         key, val, Qnil);
+                 }
+             }
+         }
       }
     unbind_to (count1, Qnil);
   }
@@ -758,32 +761,29 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
 
   /* The appropriate frame will get selected
      in set-window-configuration.  */
-  UNGCPRO;
   return unbind_to (count, val);
 }
 
 /* Return a buffer to be used as the minibuffer at depth `depth'.
- depth = 0 is the lowest allowed argument, and that is the value
- used for nonrecursive minibuffer invocations.  */
  depth = 0 is the lowest allowed argument, and that is the value
  used for nonrecursive minibuffer invocations.  */
 
 Lisp_Object
 get_minibuffer (EMACS_INT depth)
 {
-  Lisp_Object tail, num, buf;
-  char name[sizeof " *Minibuf-*" + INT_STRLEN_BOUND (EMACS_INT)];
-
-  XSETFASTINT (num, depth);
-  tail = Fnthcdr (num, Vminibuffer_list);
+  Lisp_Object tail = Fnthcdr (make_number (depth), Vminibuffer_list);
   if (NILP (tail))
     {
       tail = list1 (Qnil);
       Vminibuffer_list = nconc2 (Vminibuffer_list, tail);
     }
-  buf = Fcar (tail);
+  Lisp_Object buf = Fcar (tail);
   if (NILP (buf) || !BUFFER_LIVE_P (XBUFFER (buf)))
     {
-      buf = Fget_buffer_create
-       (make_formatted_string (name, " *Minibuf-%"pI"d*", depth));
+      static char const name_fmt[] = " *Minibuf-%"pI"d*";
+      char name[sizeof name_fmt + INT_STRLEN_BOUND (EMACS_INT)];
+      AUTO_STRING_WITH_LEN (lname, name, sprintf (name, name_fmt, depth));
+      buf = Fget_buffer_create (lname);
 
       /* Although the buffer's name starts with a space, undo should be
         enabled in it.  */
@@ -927,7 +927,7 @@ INITIAL-CONTENTS argument in more detail.  It is only relevant when
 studying existing code, or when HIST is a cons.  If non-nil,
 INITIAL-CONTENTS is a string to be inserted into the minibuffer before
 reading input.  Normally, point is put at the end of that string.
-However, if INITIAL-CONTENTS is \(STRING . POSITION), the initial
+However, if INITIAL-CONTENTS is (STRING . POSITION), the initial
 input is STRING, but point is placed at _one-indexed_ position
 POSITION in the minibuffer.  Any integer value less than or equal to
 one puts point at the beginning of the string.  *Note* that this
@@ -936,7 +936,6 @@ and some related functions, which use zero-indexing for POSITION.  */)
   (Lisp_Object prompt, Lisp_Object initial_contents, Lisp_Object keymap, Lisp_Object read, Lisp_Object hist, Lisp_Object default_value, Lisp_Object inherit_input_method)
 {
   Lisp_Object histvar, histpos, val;
-  struct gcpro gcpro1;
 
   CHECK_STRING (prompt);
   if (NILP (keymap))
@@ -959,13 +958,11 @@ and some related functions, which use zero-indexing for POSITION.  */)
   if (NILP (histpos))
     XSETFASTINT (histpos, 0);
 
-  GCPRO1 (default_value);
   val = read_minibuf (keymap, initial_contents, prompt,
                      !NILP (read),
                      histvar, histpos, default_value,
                      minibuffer_allow_text_properties,
                      !NILP (inherit_input_method));
-  UNGCPRO;
   return val;
 }
 
@@ -1212,7 +1209,6 @@ is used to further constrain the set of candidates.  */)
   int matchcount = 0;
   ptrdiff_t bindcount = -1;
   Lisp_Object bucket, zero, end, tem;
-  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 
   CHECK_STRING (string);
   if (type == function_table)
@@ -1325,13 +1321,11 @@ is used to further constrain the set of candidates.  */)
                      unbind_to (bindcount, Qnil);
                      bindcount = -1;
                    }
-                 GCPRO4 (tail, string, eltstring, bestmatch);
                  tem = (type == hash_table
                         ? call2 (predicate, elt,
                                  HASH_VALUE (XHASH_TABLE (collection),
                                              idx - 1))
                         : call1 (predicate, elt));
-                 UNGCPRO;
                }
              if (NILP (tem)) continue;
            }
@@ -1469,7 +1463,6 @@ with a space are ignored unless STRING itself starts with a space.  */)
   ptrdiff_t idx = 0, obsize = 0;
   ptrdiff_t bindcount = -1;
   Lisp_Object bucket, tem, zero;
-  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 
   CHECK_STRING (string);
   if (type == 0)
@@ -1587,12 +1580,10 @@ with a space are ignored unless STRING itself starts with a space.  */)
                    unbind_to (bindcount, Qnil);
                    bindcount = -1;
                  }
-                 GCPRO4 (tail, eltstring, allmatches, string);
                  tem = type == 3
                    ? call2 (predicate, elt,
                             HASH_VALUE (XHASH_TABLE (collection), idx - 1))
                    : call1 (predicate, elt);
-                 UNGCPRO;
                }
              if (NILP (tem)) continue;
            }
@@ -1615,8 +1606,11 @@ PROMPT is a string to prompt with; normally it ends in a colon and a space.
 COLLECTION can be a list of strings, an alist, an obarray or a hash table.
 COLLECTION can also be a function to do the completion itself.
 PREDICATE limits completion to a subset of COLLECTION.
-See `try-completion' and `all-completions' for more details
- on completion, COLLECTION, and PREDICATE.
+See `try-completion', `all-completions', `test-completion',
+and `completion-boundaries', for more details on completion,
+COLLECTION, and PREDICATE.  See also Info nodes `(elisp)Basic Completion'
+for the details about completion, and `(elisp)Programmed Completion' for
+expectations from COLLECTION when it's a function.
 
 REQUIRE-MATCH can take the following values:
 - t means that the user is not allowed to exit unless
@@ -1692,6 +1686,8 @@ the values STRING, PREDICATE and `lambda'.  */)
       tem = Fassoc_string (string, collection, completion_ignore_case ? Qt : Qnil);
       if (NILP (tem))
        return Qnil;
+      else if (CONSP (tem))
+        tem = XCAR (tem);
     }
   else if (VECTORP (collection))
     {
@@ -1844,8 +1840,8 @@ DEFUN ("assoc-string", Fassoc_string, Sassoc_string, 2, 3, 0,
 This returns the first element of LIST whose car matches the string or
 symbol KEY, or nil if no match exists.  When performing the
 comparison, symbols are first converted to strings, and unibyte
-strings to multibyte.  If the optional arg CASE-FOLD is non-nil, case
-is ignored.
+strings to multibyte.  If the optional arg CASE-FOLD is non-nil, both
+KEY and the elements of LIST are upcased for comparison.
 
 Unlike `assoc', KEY can also match an entry in LIST consisting of a
 single string, rather than a cons cell whose car is a string.  */)
@@ -1910,13 +1906,10 @@ syms_of_minibuf (void)
   staticpro (&minibuf_save_list);
 
   DEFSYM (Qcompletion_ignore_case, "completion-ignore-case");
-  DEFSYM (Qread_file_name_internal, "read-file-name-internal");
   DEFSYM (Qminibuffer_default, "minibuffer-default");
   Fset (Qminibuffer_default, Qnil);
 
   DEFSYM (Qminibuffer_completion_table, "minibuffer-completion-table");
-  DEFSYM (Qminibuffer_completion_confirm, "minibuffer-completion-confirm");
-  DEFSYM (Qminibuffer_completion_predicate, "minibuffer-completion-predicate");
 
   staticpro (&last_minibuf_string);
   last_minibuf_string = Qnil;
@@ -1944,8 +1937,6 @@ syms_of_minibuf (void)
 For example, `eval-expression' uses this.  */);
   Vread_expression_history = Qnil;
 
-  DEFSYM (Qread_expression_history, "read-expression-history");
-
   DEFVAR_LISP ("read-buffer-function", Vread_buffer_function,
               doc: /* If this is non-nil, `read-buffer' does its work by calling this function.
 The function is called with the arguments passed to `read-buffer'.  */);
@@ -1998,7 +1989,9 @@ controls the behavior, rather than this variable.  */);
 
   DEFVAR_BOOL ("enable-recursive-minibuffers", enable_recursive_minibuffers,
               doc: /* Non-nil means to allow minibuffer commands while in the minibuffer.
-This variable makes a difference whenever the minibuffer window is active. */);
+This variable makes a difference whenever the minibuffer window is active.
+Also see `minibuffer-depth-indicator-mode', which may be handy if this
+variable is non-nil. */);
   enable_recursive_minibuffers = 0;
 
   DEFVAR_LISP ("minibuffer-completion-table", Vminibuffer_completion_table,