]> 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 c33a133860018039fd6015698cc74d0c12fe42f2..b6db7f1db21098eab603a9d21e54f88d2f610b17 100644 (file)
@@ -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;
@@ -214,7 +218,7 @@ 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,
@@ -433,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;
@@ -444,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 ();
@@ -718,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;
@@ -745,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);
 
@@ -906,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
@@ -930,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.
@@ -945,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;
@@ -978,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;
 }
@@ -995,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,
@@ -1033,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;
@@ -1055,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,
@@ -1170,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.
 
@@ -1207,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;
 
@@ -1215,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;
@@ -1241,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
@@ -1271,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;
          }
@@ -1309,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,
@@ -1330,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))
@@ -1363,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))))
@@ -1390,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,
@@ -1418,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.
 
@@ -1452,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;
@@ -1485,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
@@ -1515,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
@@ -1523,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)))
@@ -1537,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;
          }
@@ -1560,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,
@@ -1574,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
@@ -1682,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;
@@ -1784,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))
@@ -2046,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);
@@ -2643,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,