Use SYMBOL_VALUE/SET_SYMBOL_VALUE macros instead of accessing
[bpt/emacs.git] / src / minibuf.c
index a098c68..da681c3 100644 (file)
@@ -1,6 +1,6 @@
 /* Minibuffer input and completion.
-   Copyright (C) 1985, 1986, 1993, 1994, 1995, 1996, 1997, 1998, 1999
-         Free Software Foundation, Inc.
+   Copyright (C) 1985, 1986, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+   2000, 2001 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -27,10 +27,11 @@ Boston, MA 02111-1307, USA.  */
 #include "buffer.h"
 #include "charset.h"
 #include "dispextern.h"
+#include "keyboard.h"
 #include "frame.h"
 #include "window.h"
 #include "syntax.h"
-#include "keyboard.h"
+#include "intervals.h"
 
 #define min(a, b) ((a) < (b) ? (a) : (b))
 
@@ -54,7 +55,7 @@ int minibuf_level;
 
 /* Nonzero means display completion help for invalid input.  */
 
-int auto_help;
+Lisp_Object Vcompletion_auto_help;
 
 /* The maximum length of a minibuffer history.  */
 
@@ -86,6 +87,12 @@ Lisp_Object Vminibuffer_history_variable;
 
 Lisp_Object Vminibuffer_history_position;
 
+/* Text properties that are added to minibuffer prompts.
+   These are in addition to the basic `field' property, and stickiness
+   properties.  */
+
+Lisp_Object Vminibuffer_prompt_properties;
+
 Lisp_Object Qminibuffer_history, Qbuffer_name_history;
 
 Lisp_Object Qread_file_name_internal;
@@ -276,12 +283,12 @@ read_minibuf_noninteractive (map, initial, prompt, backup_n, expflag,
 {
   int size, len;
   char *line, *s;
-  struct gcpro gcpro1, gcpro2;
   Lisp_Object val;
 
   fprintf (stdout, "%s", XSTRING (prompt)->data);
   fflush (stdout);
 
+  val = Qnil;
   size = 100;
   len = 0;
   line = (char *) xmalloc (size * sizeof *line);
@@ -360,6 +367,10 @@ read_minibuf (map, initial, prompt, backup_n, expflag,
   specbind (Qminibuffer_default, defalt);
 
   single_kboard_state ();
+#ifdef HAVE_X_WINDOWS
+  if (display_hourglass_p)
+    cancel_hourglass ();
+#endif
 
   val = Qnil;
   ambient_dir = current_buffer->directory;
@@ -386,9 +397,12 @@ read_minibuf (map, initial, prompt, backup_n, expflag,
     }
 
   if (noninteractive)
-    return read_minibuf_noninteractive (map, initial, prompt, backup_n,
-                                       expflag, histvar, histpos, defalt,
-                                       allow_props, inherit_input_method);
+    {
+      val = read_minibuf_noninteractive (map, initial, prompt, backup_n,
+                                        expflag, histvar, histpos, defalt,
+                                        allow_props, inherit_input_method);
+      return unbind_to (count, val);
+    }
 
   /* Choose the minibuffer window and frame, and take action on them.  */
 
@@ -497,8 +511,9 @@ read_minibuf (map, initial, prompt, backup_n, expflag,
 
   /* Erase the buffer.  */
   {
-    int count1 = specpdl_ptr - specpdl;
+    int count1 = BINDING_STACK_SIZE ();
     specbind (Qinhibit_read_only, Qt);
+    specbind (Qinhibit_modification_hooks, Qt);
     Ferase_buffer ();
     unbind_to (count1, Qnil);
   }
@@ -517,8 +532,8 @@ read_minibuf (map, initial, prompt, backup_n, expflag,
                          Qrear_nonsticky, Qt, Qnil);
       Fput_text_property (make_number (BEG), make_number (PT),
                          Qfield, Qt, Qnil);
-      Fput_text_property (make_number (BEG), make_number (PT),
-                         Qread_only, Qt, Qnil);
+      Fadd_text_properties (make_number (BEG), make_number (PT),
+                           Vminibuffer_prompt_properties, Qnil);
     }
   
   minibuf_prompt_width = current_column ();
@@ -549,6 +564,9 @@ read_minibuf (map, initial, prompt, backup_n, expflag,
       && !NILP (Vrun_hooks))
     call1 (Vrun_hooks, Qminibuffer_setup_hook);
 
+  /* Don't allow the user to undo past this point.  */
+  current_buffer->undo_list = Qnil;
+
   recursive_edit_1 ();
 
   /* If cursor is on the minibuffer line,
@@ -566,7 +584,10 @@ read_minibuf (map, initial, prompt, backup_n, expflag,
 
   /* Make minibuffer contents into a string.  */
   Fset_buffer (minibuffer);
-  val = Ffield_string (make_number (ZV), allow_props ? Qt : Qnil);
+  if (allow_props)
+    val = Ffield_string (make_number (ZV));
+  else
+    val = Ffield_string_no_properties (make_number (ZV));
 
   /* VAL is the string of minibuffer text.  */
 
@@ -581,7 +602,7 @@ read_minibuf (map, initial, prompt, backup_n, expflag,
       Lisp_Object histval;
 
       /* If variable is unbound, make it nil.  */
-      if (EQ (XSYMBOL (Vminibuffer_history_variable)->value, Qunbound))
+      if (EQ (SYMBOL_VALUE (Vminibuffer_history_variable), Qunbound))
        Fset (Vminibuffer_history_variable, Qnil);
 
       histval = Fsymbol_value (Vminibuffer_history_variable);
@@ -721,6 +742,7 @@ read_minibuf_unwind (data)
     int count = specpdl_ptr - specpdl;
     /* Prevent error in erase-buffer.  */
     specbind (Qinhibit_read_only, Qt);
+    specbind (Qinhibit_modification_hooks, Qt);
     old_deactivate_mark = Vdeactivate_mark;
     Ferase_buffer ();
     Vdeactivate_mark = old_deactivate_mark;
@@ -810,7 +832,7 @@ DEFUN ("read-from-minibuffer", Fread_from_minibuffer, Sread_from_minibuffer, 1,
   if (NILP (keymap))
     keymap = Vminibuffer_local_map;
   else
-    keymap = get_keymap (keymap);
+    keymap = get_keymap (keymap, 1, 0);
 
   if (SYMBOLP (hist))
     {
@@ -1032,17 +1054,19 @@ If optional third argument PREDICATE is non-nil,\n\
 it is used to test each possible match.\n\
 The match is a candidate only if PREDICATE returns non-nil.\n\
 The argument given to PREDICATE is the alist element\n\
-or the symbol from the obarray.")
+or the symbol from the obarray.\n\
+Additionally to this predicate, `completion-regexp-list'\n\
+is used to further constrain the set of candidates.")
   (string, alist, predicate)
      Lisp_Object string, alist, predicate;
 {
   Lisp_Object bestmatch, tail, elt, eltstring;
   /* Size in bytes of BESTMATCH.  */
-  int bestmatchsize;
+  int bestmatchsize = 0;
   /* These are in bytes, too.  */
   int compare, matchsize;
   int list = CONSP (alist) || NILP (alist);
-  int index, obsize;
+  int index = 0, obsize = 0;
   int matchcount = 0;
   Lisp_Object bucket, zero, end, tem;
   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
@@ -1051,7 +1075,7 @@ or the symbol from the obarray.")
   if (!list && !VECTORP (alist))
     return call3 (alist, string, predicate, Qnil);
 
-  bestmatch = Qnil;
+  bestmatch = bucket = Qnil;
 
   /* If ALIST is not a list, set TAIL just for gc pro.  */
   tail = alist;
@@ -1279,6 +1303,8 @@ it is used to test each possible match.\n\
 The match is a candidate only if PREDICATE returns non-nil.\n\
 The argument given to PREDICATE is the alist element\n\
 or the symbol from the obarray.\n\
+Additionally to this predicate, `completion-regexp-list'\n\
+is used to further constrain the set of candidates.\n\
 \n\
 If the optional fourth argument HIDE-SPACES is non-nil,\n\
 strings in ALIST that start with a space\n\
@@ -1289,7 +1315,7 @@ are ignored unless STRING itself starts with a space.")
   Lisp_Object tail, elt, eltstring;
   Lisp_Object allmatches;
   int list = CONSP (alist) || NILP (alist);
-  int index, obsize;
+  int index = 0, obsize = 0;
   Lisp_Object bucket, tem;
   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 
@@ -1298,7 +1324,7 @@ are ignored unless STRING itself starts with a space.")
     {
       return call3 (alist, string, predicate, Qt);
     }
-  allmatches = Qnil;
+  allmatches = bucket = Qnil;
 
   /* If ALIST is not a list, set TAIL just for gc pro.  */
   tail = alist;
@@ -1427,6 +1453,7 @@ If the input is null, `completing-read' returns an empty string,\n\
 If INITIAL-INPUT is non-nil, insert it in the minibuffer initially.\n\
   If it is (STRING . POSITION), the initial input\n\
   is STRING, but point is placed POSITION characters into the string.\n\
+  This feature is deprecated--it is best to pass nil for INITIAL.\n\
 HIST, if non-nil, specifies a history list\n\
   and optionally the initial position in the list.\n\
   It can be a symbol, which is the history list variable to use,\n\
@@ -1564,12 +1591,12 @@ test_completion (txt)
 int
 do_completion ()
 {
-  Lisp_Object completion, tem;
+  Lisp_Object completion, string, tem;
   int completedp;
   Lisp_Object last;
   struct gcpro gcpro1, gcpro2;
 
-  completion = Ftry_completion (Ffield_string (ZV),
+  completion = Ftry_completion (Ffield_string (make_number (ZV)),
                                Vminibuffer_completion_table,
                                Vminibuffer_completion_predicate);
   last = last_exact_completion;
@@ -1591,24 +1618,43 @@ do_completion ()
       return 1;
     }
 
-  /* compiler bug */
-  tem = Fstring_equal (completion, Ffield_string(ZV));
-  completedp = NILP (tem);
-  if (completedp)
+  string = Ffield_string (make_number (ZV));
+
+  /* COMPLETEDP should be true if some completion was done, which
+     doesn't include simply changing the case of the entered string.
+     However, for appearance, the string is rewritten if the case
+     changes.  */
+  tem = Fcompare_strings (completion, Qnil, Qnil, string, Qnil, Qnil, Qt);
+  completedp = !EQ (tem, Qt);
+
+  tem = Fcompare_strings (completion, Qnil, Qnil, string, Qnil, Qnil, Qnil);
+  if (!EQ (tem, Qt))
+    /* Rewrite the user's input.  */
     {
       Fdelete_field (make_number (ZV)); /* Some completion happened */
       Finsert (1, &completion);
+
+      if (! completedp)
+       /* The case of the string changed, but that's all.  We're not
+          sure whether this is a unique completion or not, so try again
+          using the real case (this shouldn't recurse again, because
+          the next time try-completion will return either `t' or the
+          exact string).  */
+       {
+         UNGCPRO;
+         return do_completion ();
+       }
     }
 
   /* It did find a match.  Do we match some possibility exactly now? */
-  tem = test_completion (Ffield_string(ZV));
+  tem = test_completion (Ffield_string (make_number (ZV)));
   if (NILP (tem))
     {
       /* not an exact match */
       UNGCPRO;
       if (completedp)
        return 5;
-      else if (auto_help)
+      else if (!NILP (Vcompletion_auto_help))
        Fminibuffer_completion_help ();
       else
        temp_echo_area_glyphs (" [Next char not unique]");
@@ -1625,7 +1671,7 @@ do_completion ()
   last_exact_completion = completion;
   if (!NILP (last))
     {
-      tem = Ffield_string (ZV);
+      tem = Ffield_string (make_number (ZV));
       if (!NILP (Fequal (tem, last)))
        Fminibuffer_completion_help ();
     }
@@ -1685,7 +1731,7 @@ scroll the window of possible completions.")
       struct buffer *obuf = current_buffer;
 
       Fset_buffer (XWINDOW (window)->buffer);
-      tem = Fpos_visible_in_window_p (make_number (ZV), window);
+      tem = Fpos_visible_in_window_p (make_number (ZV), window, Qnil);
       if (! NILP (tem))
        /* If end is in view, scroll up to the beginning.  */
        Fset_window_start (window, make_number (BEGV), Qnil);
@@ -1704,10 +1750,14 @@ scroll the window of possible completions.")
       return Qnil;
 
     case 1:
+      if (PT != ZV)
+       Fgoto_char (make_number (ZV));
       temp_echo_area_glyphs (" [Sole completion]");
       break;
 
     case 3:
+      if (PT != ZV)
+       Fgoto_char (make_number (ZV));
       temp_echo_area_glyphs (" [Complete, but not unique]");
       break;
     }
@@ -1746,10 +1796,10 @@ a repetition of this command will exit.")
   Lisp_Object val;
 
   /* Allow user to specify null string */
-  if (Ffield_beginning (ZV, Qnil) == ZV)
+  if (XINT (Ffield_beginning (make_number (ZV), Qnil)) == ZV)
     goto exit;
 
-  if (!NILP (test_completion (Ffield_string (ZV))))
+  if (!NILP (test_completion (Ffield_string (make_number (ZV)))))
     goto exit;
 
   /* Call do_completion, but ignore errors.  */
@@ -1776,7 +1826,7 @@ a repetition of this command will exit.")
       return Qnil;
     }
  exit:
-  Fthrow (Qexit, Qnil);
+  return Fthrow (Qexit, Qnil);
   /* NOTREACHED */
 }
 
@@ -1797,7 +1847,7 @@ Return nil if there is no valid completion, else t.")
   /* We keep calling Fbuffer_string rather than arrange for GC to
      hold onto a pointer to one of the strings thus made.  */
 
-  completion = Ftry_completion (Ffield_string (ZV),
+  completion = Ftry_completion (Ffield_string (make_number (ZV)),
                                Vminibuffer_completion_table,
                                Vminibuffer_completion_predicate);
   if (NILP (completion))
@@ -1810,7 +1860,7 @@ Return nil if there is no valid completion, else t.")
     return Qnil;
 
 #if 0 /* How the below code used to look, for reference. */
-  tem = Ffield_string (ZV);
+  tem = Ffield_string (make_number (ZV));
   b = XSTRING (tem)->data;
   i = ZV - 1 - XSTRING (completion)->size;
   p = XSTRING (completion)->data;
@@ -1829,7 +1879,7 @@ Return nil if there is no valid completion, else t.")
     int buffer_nchars, completion_nchars;
 
     CHECK_STRING (completion, 0);
-    tem = Ffield_string (ZV);
+    tem = Ffield_string (make_number (ZV));
     GCPRO2 (completion, tem);
     /* If reading a file name,
        expand any $ENVVAR refs in the buffer and in TEM.  */
@@ -1882,7 +1932,7 @@ Return nil if there is no valid completion, else t.")
   }
 #endif /* Rewritten code */
   
-  prompt_end_charpos = Ffield_beginning (make_number (ZV), Qnil);
+  prompt_end_charpos = XINT (Ffield_beginning (make_number (ZV), Qnil));
 
   {
     int prompt_end_bytepos;
@@ -1896,7 +1946,7 @@ Return nil if there is no valid completion, else t.")
   if (i == XSTRING (completion)->size)
     {
       GCPRO1 (completion);
-      tem = Ftry_completion (concat2 (Ffield_string (ZV), build_string (" ")),
+      tem = Ftry_completion (concat2 (Ffield_string (make_number (ZV)), build_string (" ")),
                             Vminibuffer_completion_table,
                             Vminibuffer_completion_predicate);
       UNGCPRO;
@@ -1907,7 +1957,7 @@ Return nil if there is no valid completion, else t.")
        {
          GCPRO1 (completion);
          tem =
-           Ftry_completion (concat2 (Ffield_string (ZV), build_string ("-")),
+           Ftry_completion (concat2 (Ffield_string (make_number (ZV)), build_string ("-")),
                             Vminibuffer_completion_table,
                             Vminibuffer_completion_predicate);
          UNGCPRO;
@@ -1941,7 +1991,7 @@ Return nil if there is no valid completion, else t.")
 
   if (i == ZV - prompt_end_charpos)
     {
-      if (auto_help)
+      if (!NILP (Vcompletion_auto_help))
        Fminibuffer_completion_help ();
       return Qnil;
     }
@@ -1995,6 +2045,8 @@ It can find the completion buffer in `standard-output'.")
          int length;
          Lisp_Object startpos, endpos;
 
+         startpos = Qnil;
+
          elt = Fcar (tail);
          /* Compute the length of this element.  */
          if (CONSP (elt))
@@ -2142,7 +2194,7 @@ DEFUN ("minibuffer-completion-help", Fminibuffer_completion_help, Sminibuffer_co
   Lisp_Object completions;
 
   message ("Making completion list...");
-  completions = Fall_completions (Ffield_string (ZV),
+  completions = Fall_completions (Ffield_string (make_number (ZV)),
                                  Vminibuffer_completion_table,
                                  Vminibuffer_completion_predicate,
                                  Qt);
@@ -2169,14 +2221,14 @@ DEFUN ("self-insert-and-exit", Fself_insert_and_exit, Sself_insert_and_exit, 0,
   else
     bitch_at_user ();
 
-  Fthrow (Qexit, Qnil);
+  return Fthrow (Qexit, Qnil);
 }
 
 DEFUN ("exit-minibuffer", Fexit_minibuffer, Sexit_minibuffer, 0, 0, "",
   "Terminate this minibuffer argument.")
   ()
 {
-  Fthrow (Qexit, Qnil);
+  return Fthrow (Qexit, Qnil);
 }
 
 DEFUN ("minibuffer-depth", Fminibuffer_depth, Sminibuffer_depth, 0, 0, 0,
@@ -2325,9 +2377,9 @@ just after a new element is inserted.  Setting the history-length\n\
 property of a history variable overrides this default.");
   XSETFASTINT (Vhistory_length, 30);
 
-  DEFVAR_BOOL ("completion-auto-help", &auto_help,
+  DEFVAR_LISP ("completion-auto-help", &Vcompletion_auto_help,
     "*Non-nil means automatically provide help for invalid completion input.");
-  auto_help = 1;
+  Vcompletion_auto_help = Qt;
 
   DEFVAR_BOOL ("completion-ignore-case", &completion_ignore_case,
     "Non-nil means don't consider case significant in completion.");
@@ -2398,6 +2450,15 @@ This also affects `read-string', but it does not affect `read-minibuffer',\n\
 with completion; they always discard text properties.");
   minibuffer_allow_text_properties = 0;
 
+  DEFVAR_LISP ("minibuffer-prompt-properties", &Vminibuffer_prompt_properties,
+    "Text properties that are added to minibuffer prompts.\n\
+These are in addition to the basic `field' property, and stickiness\n\
+properties.");
+  /* We use `intern' here instead of Qread_only to avoid
+     initialization-order problems.  */
+  Vminibuffer_prompt_properties
+    = Fcons (intern ("read-only"), Fcons (Qt, Qnil));
+
   defsubr (&Sset_minibuffer_window);
   defsubr (&Sread_from_minibuffer);
   defsubr (&Seval_minibuffer);