]> code.delx.au - gnu-emacs/blobdiff - src/minibuf.c
(main): Change `#ifdef HAVE_CARBON' to `#if defined (MAC_OSX) &&
[gnu-emacs] / src / minibuf.c
index b91a4a4fc2a422272769bace6222afe669184d9b..b6db7f1db21098eab603a9d21e54f88d2f610b17 100644 (file)
@@ -1,5 +1,5 @@
 /* Minibuffer input and completion.
-   Copyright (C) 1985,86,93,94,95,96,97,98,99,2000,01,03
+   Copyright (C) 1985,86,93,94,95,96,97,98,99,2000,01,03,04
              Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
@@ -61,6 +61,10 @@ Lisp_Object Vcompletion_auto_help;
 
 Lisp_Object Qhistory_length, Vhistory_length;
 
+/* No duplicates in history.  */
+
+int history_delete_duplicates;
+
 /* Fread_minibuffer leaves the input here as a string. */
 
 Lisp_Object last_minibuf_string;
@@ -209,11 +213,12 @@ without invoking the usual minibuffer commands.  */)
 /* Actual minibuffer invocation. */
 
 static Lisp_Object read_minibuf_unwind P_ ((Lisp_Object));
+static Lisp_Object run_exit_minibuf_hook P_ ((Lisp_Object));
 static Lisp_Object read_minibuf P_ ((Lisp_Object, Lisp_Object,
                                     Lisp_Object, Lisp_Object,
                                     int, Lisp_Object,
                                     Lisp_Object, Lisp_Object,
-                                    int, int));
+                                    int, int, int));
 static Lisp_Object read_minibuf_noninteractive P_ ((Lisp_Object, Lisp_Object,
                                                    Lisp_Object, Lisp_Object,
                                                    int, Lisp_Object,
@@ -432,7 +437,8 @@ minibuffer_completion_contents ()
 
 static Lisp_Object
 read_minibuf (map, initial, prompt, backup_n, expflag,
-             histvar, histpos, defalt, allow_props, inherit_input_method)
+             histvar, histpos, defalt, allow_props, inherit_input_method,
+             keep_all)
      Lisp_Object map;
      Lisp_Object initial;
      Lisp_Object prompt;
@@ -443,6 +449,7 @@ read_minibuf (map, initial, prompt, backup_n, expflag,
      Lisp_Object defalt;
      int allow_props;
      int inherit_input_method;
+     int keep_all;
 {
   Lisp_Object val;
   int count = SPECPDL_INDEX ();
@@ -563,6 +570,12 @@ read_minibuf (map, initial, prompt, backup_n, expflag,
 
   record_unwind_protect (read_minibuf_unwind, Qnil);
   minibuf_level++;
+  /* We are exiting the minibuffer one way or the other, so run the hook.
+     It should be run before unwinding the minibuf settings.  Do it
+     separately from read_minibuf_unwind because we need to make sure that
+     read_minibuf_unwind is fully executed even if exit-minibuffer-hook
+     signals an error.  --Stef  */
+  record_unwind_protect (run_exit_minibuf_hook, Qnil);
 
   /* Now that we can restore all those variables, start changing them.  */
 
@@ -711,7 +724,7 @@ read_minibuf (map, initial, prompt, backup_n, expflag,
   last_minibuf_string = val;
 
   /* Choose the string to add to the history.  */
-  if (SCHARS (val) != 0)
+  if (SCHARS (val) != 0 || keep_all)
     histstring = val;
   else if (STRINGP (defalt))
     histstring = defalt;
@@ -738,10 +751,12 @@ read_minibuf (map, initial, prompt, backup_n, expflag,
       if (NILP (histval)
          || (CONSP (histval)
              /* Don't duplicate the most recent entry in the history.  */
-             && NILP (Fequal (histstring, Fcar (histval)))))
+             && (keep_all
+                 || NILP (Fequal (histstring, Fcar (histval))))))
        {
          Lisp_Object length;
 
+         if (history_delete_duplicates) Fdelete (histstring, histval);
          histval = Fcons (histstring, histval);
          Fset (Vminibuffer_history_variable, histval);
 
@@ -822,6 +837,17 @@ get_minibuffer (depth)
   return buf;
 }
 
+static Lisp_Object
+run_exit_minibuf_hook (data)
+     Lisp_Object data;
+{
+  if (!NILP (Vminibuffer_exit_hook) && !EQ (Vminibuffer_exit_hook, Qunbound)
+      && !NILP (Vrun_hooks))
+    safe_run_hooks (Qminibuffer_exit_hook);
+
+  return Qnil;
+}
+
 /* This function is called on exiting minibuffer, whether normally or
    not, and it restores the current window, buffer, etc. */
 
@@ -832,12 +858,6 @@ read_minibuf_unwind (data)
   Lisp_Object old_deactivate_mark;
   Lisp_Object window;
 
-  /* We are exiting the minibuffer one way or the other,
-     so run the hook.  */
-  if (!NILP (Vminibuffer_exit_hook) && !EQ (Vminibuffer_exit_hook, Qunbound)
-      && !NILP (Vrun_hooks))
-    safe_run_hooks (Qminibuffer_exit_hook);
-
   /* If this was a recursive minibuffer,
      tie the minibuffer window back to the outer level minibuffer buffer.  */
   minibuf_level--;
@@ -894,7 +914,7 @@ read_minibuf_unwind (data)
 }
 \f
 
-DEFUN ("read-from-minibuffer", Fread_from_minibuffer, Sread_from_minibuffer, 1, 7, 0,
+DEFUN ("read-from-minibuffer", Fread_from_minibuffer, Sread_from_minibuffer, 1, 8, 0,
        doc: /* Read a string from the minibuffer, prompting with string PROMPT.
 The optional second arg INITIAL-CONTENTS is an obsolete alternative to
   DEFAULT-VALUE.  It normally should be nil in new code, except when
@@ -918,6 +938,8 @@ Sixth arg DEFAULT-VALUE is the default value.  If non-nil, it is available
   the empty string.
 Seventh arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits
  the current input method and the setting of `enable-multibyte-characters'.
+Eight arg KEEP-ALL, if non-nil, says to put all inputs in the history list,
+ even empty or duplicate inputs.
 If the variable `minibuffer-allow-text-properties' is non-nil,
  then the string which is returned includes whatever text properties
  were present in the minibuffer.  Otherwise the value has no text properties.
@@ -933,9 +955,9 @@ POSITION in the minibuffer.  Any integer value less than or equal to
 one puts point at the beginning of the string.  *Note* that this
 behavior differs from the way such arguments are used in `completing-read'
 and some related functions, which use zero-indexing for POSITION.  */)
-     (prompt, initial_contents, keymap, read, hist, default_value, inherit_input_method)
+  (prompt, initial_contents, keymap, read, hist, default_value, inherit_input_method, keep_all)
      Lisp_Object prompt, initial_contents, keymap, read, hist, default_value;
-     Lisp_Object inherit_input_method;
+     Lisp_Object inherit_input_method, keep_all;
 {
   Lisp_Object histvar, histpos, val;
   struct gcpro gcpro1;
@@ -966,7 +988,8 @@ and some related functions, which use zero-indexing for POSITION.  */)
                      Qnil, !NILP (read),
                      histvar, histpos, default_value,
                      minibuffer_allow_text_properties,
-                     !NILP (inherit_input_method));
+                     !NILP (inherit_input_method),
+                     !NILP (keep_all));
   UNGCPRO;
   return val;
 }
@@ -983,7 +1006,7 @@ arguments are used as in `read-from-minibuffer')  */)
   CHECK_STRING (prompt);
   return read_minibuf (Vminibuffer_local_map, initial_contents,
                       prompt, Qnil, 1, Qminibuffer_history,
-                      make_number (0), Qnil, 0, 0);
+                      make_number (0), Qnil, 0, 0, 0);
 }
 
 DEFUN ("eval-minibuffer", Feval_minibuffer, Seval_minibuffer, 1, 2, 0,
@@ -1021,7 +1044,7 @@ Fifth arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits
   Lisp_Object val;
   val = Fread_from_minibuffer (prompt, initial_input, Qnil,
                               Qnil, history, default_value,
-                              inherit_input_method);
+                              inherit_input_method, Qnil);
   if (STRINGP (val) && SCHARS (val) == 0 && ! NILP (default_value))
     val = default_value;
   return val;
@@ -1043,7 +1066,7 @@ the current input method and the setting of`enable-multibyte-characters'.  */)
   CHECK_STRING (prompt);
   return read_minibuf (Vminibuffer_local_ns_map, initial, prompt, Qnil,
                       0, Qminibuffer_history, make_number (0), Qnil, 0,
-                      !NILP (inherit_input_method));
+                      !NILP (inherit_input_method), 0);
 }
 
 DEFUN ("read-command", Fread_command, Sread_command, 1, 2, 0,
@@ -1158,13 +1181,16 @@ minibuf_conform_representation (string, basis)
 DEFUN ("try-completion", Ftry_completion, Stry_completion, 2, 3, 0,
        doc: /* Return common substring of all completions of STRING in ALIST.
 Each car of each element of ALIST (or each element if it is not a cons cell)
-is tested to see if it begins with STRING.
+is tested to see if it begins with STRING.  The possible matches may be
+strings or symbols.  Symbols are converted to strings before testing,
+see `symbol-name'.
 All that match are compared together; the longest initial sequence
 common to all matches is returned as a string.
 If there is no match at all, nil is returned.
 For a unique match which is exact, t is returned.
 
-If ALIST is a hash-table, all the string keys are the possible matches.
+If ALIST is a hash-table, all the string and symbol keys are the
+possible matches.
 If ALIST is an obarray, the names of all symbols in the obarray
 are the possible matches.
 
@@ -1195,6 +1221,7 @@ is used to further constrain the set of candidates.  */)
                           || NILP (XCAR (alist))));
   int index = 0, obsize = 0;
   int matchcount = 0;
+  int bindcount = -1;
   Lisp_Object bucket, zero, end, tem;
   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 
@@ -1203,6 +1230,7 @@ is used to further constrain the set of candidates.  */)
     return call3 (alist, string, predicate, Qnil);
 
   bestmatch = bucket = Qnil;
+  zero = make_number (0);
 
   /* If ALIST is not a list, set TAIL just for gc pro.  */
   tail = alist;
@@ -1229,10 +1257,10 @@ is used to further constrain the set of candidates.  */)
        }
       else if (type == 2)
        {
-         if (XFASTINT (bucket) != 0)
+         if (!EQ (bucket, zero))
            {
              elt = bucket;
-             eltstring = Fsymbol_name (elt);
+             eltstring = elt;
              if (XSYMBOL (bucket)->next)
                XSETSYMBOL (bucket, XSYMBOL (bucket)->next);
              else
@@ -1259,31 +1287,34 @@ is used to further constrain the set of candidates.  */)
 
       /* Is this element a possible completion? */
 
+      if (SYMBOLP (eltstring))
+       eltstring = Fsymbol_name (eltstring);
+
       if (STRINGP (eltstring)
          && SCHARS (string) <= SCHARS (eltstring)
-         && (tem = Fcompare_strings (eltstring, make_number (0),
+         && (tem = Fcompare_strings (eltstring, zero,
                                      make_number (SCHARS (string)),
-                                     string, make_number (0), Qnil,
+                                     string, zero, Qnil,
                                      completion_ignore_case ? Qt : Qnil),
              EQ (Qt, tem)))
        {
          /* Yes. */
          Lisp_Object regexps;
-         Lisp_Object zero;
-         XSETFASTINT (zero, 0);
 
          /* Ignore this element if it fails to match all the regexps.  */
          {
-           int count = SPECPDL_INDEX ();
-           specbind (Qcase_fold_search, completion_ignore_case ? Qt : Qnil);
            for (regexps = Vcompletion_regexp_list; CONSP (regexps);
                 regexps = XCDR (regexps))
              {
+               if (bindcount < 0) {
+                 bindcount = SPECPDL_INDEX ();
+                 specbind (Qcase_fold_search,
+                           completion_ignore_case ? Qt : Qnil);
+               }
                tem = Fstring_match (XCAR (regexps), eltstring, zero);
                if (NILP (tem))
                  break;
              }
-           unbind_to (count, Qnil);
            if (CONSP (regexps))
              continue;
          }
@@ -1297,6 +1328,10 @@ is used to further constrain the set of candidates.  */)
                tem = Fcommandp (elt, Qnil);
              else
                {
+                 if (bindcount >= 0) {
+                   unbind_to (bindcount, Qnil);
+                   bindcount = -1;
+                 }
                  GCPRO4 (tail, string, eltstring, bestmatch);
                  tem = type == 3
                    ? call2 (predicate, elt,
@@ -1318,9 +1353,9 @@ is used to further constrain the set of candidates.  */)
          else
            {
              compare = min (bestmatchsize, SCHARS (eltstring));
-             tem = Fcompare_strings (bestmatch, make_number (0),
+             tem = Fcompare_strings (bestmatch, zero,
                                      make_number (compare),
-                                     eltstring, make_number (0),
+                                     eltstring, zero,
                                      make_number (compare),
                                      completion_ignore_case ? Qt : Qnil);
              if (EQ (tem, Qt))
@@ -1351,15 +1386,15 @@ is used to further constrain the set of candidates.  */)
                      ((matchsize == SCHARS (eltstring))
                       ==
                       (matchsize == SCHARS (bestmatch))
-                      && (tem = Fcompare_strings (eltstring, make_number (0),
+                      && (tem = Fcompare_strings (eltstring, zero,
                                                   make_number (SCHARS (string)),
-                                                  string, make_number (0),
+                                                  string, zero,
                                                   Qnil,
                                                   Qnil),
                           EQ (Qt, tem))
-                      && (tem = Fcompare_strings (bestmatch, make_number (0),
+                      && (tem = Fcompare_strings (bestmatch, zero,
                                                   make_number (SCHARS (string)),
-                                                  string, make_number (0),
+                                                  string, zero,
                                                   Qnil,
                                                   Qnil),
                           ! EQ (Qt, tem))))
@@ -1378,6 +1413,11 @@ is used to further constrain the set of candidates.  */)
        }
     }
 
+  if (bindcount >= 0) {
+    unbind_to (bindcount, Qnil);
+    bindcount = -1;
+  }
+
   if (NILP (bestmatch))
     return Qnil;               /* No completions found */
   /* If we are ignoring case, and there is no exact match,
@@ -1406,10 +1446,13 @@ is used to further constrain the set of candidates.  */)
 DEFUN ("all-completions", Fall_completions, Sall_completions, 2, 4, 0,
        doc: /* Search for partial matches to STRING in ALIST.
 Each car of each element of ALIST (or each element if it is not a cons cell)
-is tested to see if it begins with STRING.
+is tested to see if it begins with STRING.  The possible matches may be
+strings or symbols.  Symbols are converted to strings before testing,
+see `symbol-name'.
 The value is a list of all the strings from ALIST that match.
 
-If ALIST is a hash-table, all the string keys are the possible matches.
+If ALIST is a hash-table, all the string and symbol keys are the
+possible matches.
 If ALIST is an obarray, the names of all symbols in the obarray
 are the possible matches.
 
@@ -1440,13 +1483,15 @@ are ignored unless STRING itself starts with a space.  */)
                       && (!SYMBOLP (XCAR (alist))
                           || NILP (XCAR (alist))));
   int index = 0, obsize = 0;
-  Lisp_Object bucket, tem;
+  int bindcount = -1;
+  Lisp_Object bucket, tem, zero;
   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 
   CHECK_STRING (string);
   if (type == 0)
     return call3 (alist, string, predicate, Qt);
   allmatches = bucket = Qnil;
+  zero = make_number (0);
 
   /* If ALIST is not a list, set TAIL just for gc pro.  */
   tail = alist;
@@ -1473,10 +1518,10 @@ are ignored unless STRING itself starts with a space.  */)
        }
       else if (type == 2)
        {
-         if (XFASTINT (bucket) != 0)
+         if (!EQ (bucket, zero))
            {
              elt = bucket;
-             eltstring = Fsymbol_name (elt);
+             eltstring = elt;
              if (XSYMBOL (bucket)->next)
                XSETSYMBOL (bucket, XSYMBOL (bucket)->next);
              else
@@ -1503,6 +1548,9 @@ are ignored unless STRING itself starts with a space.  */)
 
       /* Is this element a possible completion? */
 
+      if (SYMBOLP (eltstring))
+       eltstring = Fsymbol_name (eltstring);
+
       if (STRINGP (eltstring)
          && SCHARS (string) <= SCHARS (eltstring)
          /* If HIDE_SPACES, reject alternatives that start with space
@@ -1511,9 +1559,9 @@ are ignored unless STRING itself starts with a space.  */)
               && SREF (string, 0) == ' ')
              || SREF (eltstring, 0) != ' '
              || NILP (hide_spaces))
-         && (tem = Fcompare_strings (eltstring, make_number (0),
+         && (tem = Fcompare_strings (eltstring, zero,
                                      make_number (SCHARS (string)),
-                                     string, make_number (0),
+                                     string, zero,
                                      make_number (SCHARS (string)),
                                      completion_ignore_case ? Qt : Qnil),
              EQ (Qt, tem)))
@@ -1525,16 +1573,18 @@ are ignored unless STRING itself starts with a space.  */)
 
          /* Ignore this element if it fails to match all the regexps.  */
          {
-           int count = SPECPDL_INDEX ();
-           specbind (Qcase_fold_search, completion_ignore_case ? Qt : Qnil);
            for (regexps = Vcompletion_regexp_list; CONSP (regexps);
                 regexps = XCDR (regexps))
              {
+               if (bindcount < 0) {
+                 bindcount = SPECPDL_INDEX ();
+                 specbind (Qcase_fold_search,
+                           completion_ignore_case ? Qt : Qnil);
+               }
                tem = Fstring_match (XCAR (regexps), eltstring, zero);
                if (NILP (tem))
                  break;
              }
-           unbind_to (count, Qnil);
            if (CONSP (regexps))
              continue;
          }
@@ -1548,6 +1598,10 @@ are ignored unless STRING itself starts with a space.  */)
                tem = Fcommandp (elt, Qnil);
              else
                {
+                 if (bindcount >= 0) {
+                   unbind_to (bindcount, Qnil);
+                   bindcount = -1;
+                 }
                  GCPRO4 (tail, eltstring, allmatches, string);
                  tem = type == 3
                    ? call2 (predicate, elt,
@@ -1562,6 +1616,11 @@ are ignored unless STRING itself starts with a space.  */)
        }
     }
 
+  if (bindcount >= 0) {
+    unbind_to (bindcount, Qnil);
+    bindcount = -1;
+  }
+
   return Fnreverse (allmatches);
 }
 \f
@@ -1602,7 +1661,7 @@ HIST, if non-nil, specifies a history list and optionally the initial
   is the initial position (the position in the list used by the
   minibuffer history commands).  For consistency, you should also
   specify that element of the history as the value of
-  INITIAL-CONTENTS.  (This is the only case in which you should use
+  INITIAL-INPUT.  (This is the only case in which you should use
   INITIAL-INPUT instead of DEF.)  Positions are counted starting from
   1 at the beginning of the list.  The variable `history-length'
   controls the maximum length of a history list.
@@ -1670,7 +1729,7 @@ Completion ignores case if the ambient value of
                      : Vminibuffer_local_must_match_map,
                      init, prompt, make_number (pos), 0,
                      histvar, histpos, def, 0,
-                     !NILP (inherit_input_method));
+                     !NILP (inherit_input_method), 0);
 
   if (STRINGP (val) && SCHARS (val) == 0 && ! NILP (def))
     val = def;
@@ -1772,19 +1831,20 @@ the values STRING, PREDICATE and `lambda'.  */)
     return call3 (alist, string, predicate, Qlambda);
 
   /* Reject this element if it fails to match all the regexps.  */
-  {
-    int count = SPECPDL_INDEX ();
-    specbind (Qcase_fold_search, completion_ignore_case ? Qt : Qnil);
-    for (regexps = Vcompletion_regexp_list; CONSP (regexps);
-        regexps = XCDR (regexps))
-      {
-       if (NILP (Fstring_match (XCAR (regexps),
-                                SYMBOLP (tem) ? string : tem,
-                                Qnil)))
-         return unbind_to (count, Qnil);
-      }
-    unbind_to (count, Qnil);
-  }
+  if (CONSP (Vcompletion_regexp_list))
+    {
+      int count = SPECPDL_INDEX ();
+      specbind (Qcase_fold_search, completion_ignore_case ? Qt : Qnil);
+      for (regexps = Vcompletion_regexp_list; CONSP (regexps);
+          regexps = XCDR (regexps))
+       {
+         if (NILP (Fstring_match (XCAR (regexps),
+                                  SYMBOLP (tem) ? string : tem,
+                                  Qnil)))
+           return unbind_to (count, Qnil);
+       }
+      unbind_to (count, Qnil);
+    }
 
   /* Finally, check the predicate.  */
   if (!NILP (predicate))
@@ -2034,10 +2094,28 @@ a repetition of this command will exit.  */)
   if (XINT (Fminibuffer_prompt_end ()) == ZV)
     goto exit;
 
-  if (!NILP (Ftest_completion (Fminibuffer_contents (),
+  val = Fminibuffer_contents ();
+  if (!NILP (Ftest_completion (val,
                               Vminibuffer_completion_table,
                               Vminibuffer_completion_predicate)))
-    goto exit;
+    {
+      if (completion_ignore_case)
+       { /* Fixup case of the field, if necessary. */
+         Lisp_Object compl
+           = Ftry_completion (val,
+                              Vminibuffer_completion_table,
+                              Vminibuffer_completion_predicate);
+         if (STRINGP (compl)
+             /* If it weren't for this piece of paranoia, I'd replace
+                the whole thing with a call to do_completion. */
+             && EQ (Flength (val), Flength (compl)))
+           {
+             del_range (XINT (Fminibuffer_prompt_end ()), ZV);
+             Finsert (1, &compl);
+           }
+       }
+      goto exit;
+    }
 
   /* Call do_completion, but ignore errors.  */
   SET_PT (ZV);
@@ -2631,12 +2709,21 @@ just after a new element is inserted.  Setting the history-length
 property of a history variable overrides this default.  */);
   XSETFASTINT (Vhistory_length, 30);
 
+  DEFVAR_BOOL ("history-delete-duplicates", &history_delete_duplicates,
+              doc: /* *Non-nil means to delete duplicates in history.
+If set to t when adding a new history element, all previous identical
+elements are deleted.  */);
+  history_delete_duplicates = 0;
+
   DEFVAR_LISP ("completion-auto-help", &Vcompletion_auto_help,
               doc: /* *Non-nil means automatically provide help for invalid completion input.  */);
   Vcompletion_auto_help = Qt;
 
   DEFVAR_BOOL ("completion-ignore-case", &completion_ignore_case,
-              doc: /* Non-nil means don't consider case significant in completion.  */);
+              doc: /* Non-nil means don't consider case significant in completion.
+
+For file-name completion, the variable `read-file-name-completion-ignore-case'
+controls the behavior, rather than this variable.  */);
   completion_ignore_case = 0;
 
   DEFVAR_BOOL ("enable-recursive-minibuffers", &enable_recursive_minibuffers,