Lisp completion functions

* src/minibuf.c (minibuf_conform_representation, Ftry_completion)
  (Fall_completions, Ftest_completion, Finternal_complete_buffer):
  Rewrite in Lisp and move...
* lisp/minibuffer.el (minibuf-conform-representation, try-completion)
  (all-completions, test-completion, internal-complete-buffer):
  ...here.

1 files changed, 0 insertions, 602 deletions

diff --git a/src/minibuf.c b/src/minibuf.c
index e257ac2177..5df56a5f98 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -1149,440 +1149,6 @@ function, instead of the usual behavior.  */)
   return result;
 }
 
-static Lisp_Object
-minibuf_conform_representation (Lisp_Object string, Lisp_Object basis)
-{
-  if (STRING_MULTIBYTE (string) == STRING_MULTIBYTE (basis))
-    return string;
-
-  if (STRING_MULTIBYTE (string))
-    return Fstring_make_unibyte (string);
-  else
-    return Fstring_make_multibyte (string);
-}
-
-DEFUN ("try-completion", Ftry_completion, Stry_completion, 2, 3, 0,
-       doc: /* Return common substring of all completions of STRING in COLLECTION.
-Test each possible completion specified by COLLECTION
-to see if it begins with STRING.  The possible completions may be
-strings or symbols.  Symbols are converted to strings before testing,
-see `symbol-name'.
-All that match STRING are compared together; the longest initial sequence
-common to all these matches is the return value.
-If there is no match at all, the return value is nil.
-For a unique match which is exact, the return value is t.
-
-If COLLECTION is an alist, the keys (cars of elements) are the
-possible completions.  If an element is not a cons cell, then the
-element itself is the possible completion.
-If COLLECTION is a hash-table, all the keys that are strings or symbols
-are the possible completions.
-If COLLECTION is an obarray, the names of all symbols in the obarray
-are the possible completions.
-
-COLLECTION can also be a function to do the completion itself.
-It receives three arguments: the values STRING, PREDICATE and nil.
-Whatever it returns becomes the value of `try-completion'.
-
-If optional third argument PREDICATE is non-nil,
-it is used to test each possible match.
-The match is a candidate only if PREDICATE returns non-nil.
-The argument given to PREDICATE is the alist element
-or the symbol from the obarray.  If COLLECTION is a hash-table,
-predicate is called with two arguments: the key and the value.
-Additionally to this predicate, `completion-regexp-list'
-is used to further constrain the set of candidates.  */)
-  (Lisp_Object string, Lisp_Object collection, Lisp_Object predicate)
-{
-  Lisp_Object bestmatch, tail, elt, eltstring;
-  /* Size in bytes of BESTMATCH.  */
-  ptrdiff_t bestmatchsize = 0;
-  /* These are in bytes, too.  */
-  ptrdiff_t compare, matchsize;
-  enum { function_table, list_table, obarray_table, hash_table}
-    type = (HASH_TABLE_P (collection) ? hash_table
-	    : VECTORP (collection) ? obarray_table
-	    : ((NILP (collection)
-		|| (CONSP (collection) && !FUNCTIONP (collection)))
-	       ? list_table : function_table));
-  ptrdiff_t idx = 0, obsize = 0;
-  int matchcount = 0;
-  Lisp_Object bucket, zero, end, tem;
-  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
-
-  CHECK_STRING (string);
-  if (type == function_table)
-    return call3 (collection, string, predicate, Qnil);
-
-  bestmatch = bucket = Qnil;
-  zero = make_number (0);
-
-  /* If COLLECTION is not a list, set TAIL just for gc pro.  */
-  tail = collection;
-  if (type == obarray_table)
-    {
-      collection = check_obarray (collection);
-      obsize = ASIZE (collection);
-      bucket = AREF (collection, idx);
-    }
-
-  while (1)
-    {
-      /* Get the next element of the alist, obarray, or hash-table.  */
-      /* Exit the loop if the elements are all used up.  */
-      /* elt gets the alist element or symbol.
-	 eltstring gets the name to check as a completion.  */
-
-      if (type == list_table)
-	{
-	  if (!CONSP (tail))
-	    break;
-	  elt = XCAR (tail);
-	  eltstring = CONSP (elt) ? XCAR (elt) : elt;
-	  tail = XCDR (tail);
-	}
-      else if (type == obarray_table)
-	{
-	  if (!EQ (bucket, zero))
-	    {
-	      if (!SYMBOLP (bucket))
-		error ("Bad data in guts of obarray");
-	      elt = bucket;
-	      eltstring = elt;
-	      if (XSYMBOL (bucket)->next)
-		XSETSYMBOL (bucket, XSYMBOL (bucket)->next);
-	      else
-		XSETFASTINT (bucket, 0);
-	    }
-	  else if (++idx >= obsize)
-	    break;
-	  else
-	    {
-	      bucket = AREF (collection, idx);
-	      continue;
-	    }
-	}
-      else /* if (type == hash_table) */
-	{
-	  while (idx < HASH_TABLE_SIZE (XHASH_TABLE (collection))
-		 && NILP (HASH_HASH (XHASH_TABLE (collection), idx)))
-	    idx++;
-	  if (idx >= HASH_TABLE_SIZE (XHASH_TABLE (collection)))
-	    break;
-	  else
-	    elt = eltstring = HASH_KEY (XHASH_TABLE (collection), idx++);
-	}
-
-      /* Is this element a possible completion?  */
-
-      if (SYMBOLP (eltstring))
-	eltstring = Fsymbol_name (eltstring);
-
-      if (STRINGP (eltstring)
-	  && SCHARS (string) <= SCHARS (eltstring)
-	  && (tem = Fcompare_strings (eltstring, zero,
-				      make_number (SCHARS (string)),
-				      string, zero, Qnil,
-				      completion_ignore_case ? Qt : Qnil),
-	      EQ (Qt, tem)))
-	{
-	  /* Yes.  */
-	  Lisp_Object regexps;
-
-	  /* Ignore this element if it fails to match all the regexps.  */
-	  {
-            dynwind_begin ();
-            specbind (Qcase_fold_search,
-                      completion_ignore_case ? Qt : Qnil);
-	    for (regexps = Vcompletion_regexp_list; CONSP (regexps);
-		 regexps = XCDR (regexps))
-	      {
-		tem = Fstring_match (XCAR (regexps), eltstring, zero);
-		if (NILP (tem))
-		  break;
-	      }
-            dynwind_end ();
-	    if (CONSP (regexps))
-	      continue;
-	  }
-
-	  /* Ignore this element if there is a predicate
-	     and the predicate doesn't like it.  */
-
-	  if (!NILP (predicate))
-	    {
-	      if (EQ (predicate, Qcommandp))
-		tem = Fcommandp (elt, Qnil);
-	      else
-		{
-		  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;
-	    }
-
-	  /* Update computation of how much all possible completions match */
-
-	  if (NILP (bestmatch))
-	    {
-	      matchcount = 1;
-	      bestmatch = eltstring;
-	      bestmatchsize = SCHARS (eltstring);
-	    }
-	  else
-	    {
-	      compare = min (bestmatchsize, SCHARS (eltstring));
-	      tem = Fcompare_strings (bestmatch, zero,
-				      make_number (compare),
-				      eltstring, zero,
-				      make_number (compare),
-				      completion_ignore_case ? Qt : Qnil);
-	      matchsize = EQ (tem, Qt) ? compare : eabs (XINT (tem)) - 1;
-
-	      if (completion_ignore_case)
-		{
-		  /* If this is an exact match except for case,
-		     use it as the best match rather than one that is not an
-		     exact match.  This way, we get the case pattern
-		     of the actual match.  */
-		  if ((matchsize == SCHARS (eltstring)
-		       && matchsize < SCHARS (bestmatch))
-		      ||
-		      /* If there is more than one exact match ignoring case,
-			 and one of them is exact including case,
-			 prefer that one.  */
-		      /* If there is no exact match ignoring case,
-			 prefer a match that does not change the case
-			 of the input.  */
-		      ((matchsize == SCHARS (eltstring))
-		       ==
-		       (matchsize == SCHARS (bestmatch))
-		       && (tem = Fcompare_strings (eltstring, zero,
-						   make_number (SCHARS (string)),
-						   string, zero,
-						   Qnil,
-						   Qnil),
-			   EQ (Qt, tem))
-		       && (tem = Fcompare_strings (bestmatch, zero,
-						   make_number (SCHARS (string)),
-						   string, zero,
-						   Qnil,
-						   Qnil),
-			   ! EQ (Qt, tem))))
-		    bestmatch = eltstring;
-		}
-	      if (bestmatchsize != SCHARS (eltstring)
-		  || bestmatchsize != matchsize)
-		/* Don't count the same string multiple times.  */
-		matchcount += matchcount <= 1;
-	      bestmatchsize = matchsize;
-	      if (matchsize <= SCHARS (string)
-		  /* If completion-ignore-case is non-nil, don't
-		     short-circuit because we want to find the best
-		     possible match *including* case differences.  */
-		  && !completion_ignore_case
-		  && matchcount > 1)
-		/* No need to look any further.  */
-		break;
-	    }
-	}
-    }
-
-  if (NILP (bestmatch))
-    return Qnil;		/* No completions found.  */
-  /* If we are ignoring case, and there is no exact match,
-     and no additional text was supplied,
-     don't change the case of what the user typed.  */
-  if (completion_ignore_case && bestmatchsize == SCHARS (string)
-      && SCHARS (bestmatch) > bestmatchsize)
-    return minibuf_conform_representation (string, bestmatch);
-
-  /* Return t if the supplied string is an exact match (counting case);
-     it does not require any change to be made.  */
-  if (matchcount == 1 && !NILP (Fequal (bestmatch, string)))
-    return Qt;
-
-  XSETFASTINT (zero, 0);		/* Else extract the part in which */
-  XSETFASTINT (end, bestmatchsize);	/* all completions agree.  */
-  return Fsubstring (bestmatch, zero, end);
-}
-
-DEFUN ("all-completions", Fall_completions, Sall_completions, 2, 4, 0,
-       doc: /* Search for partial matches to STRING in COLLECTION.
-Test each of the possible completions specified by COLLECTION
-to see if it begins with STRING.  The possible completions may be
-strings or symbols.  Symbols are converted to strings before testing,
-see `symbol-name'.
-The value is a list of all the possible completions that match STRING.
-
-If COLLECTION is an alist, the keys (cars of elements) are the
-possible completions.  If an element is not a cons cell, then the
-element itself is the possible completion.
-If COLLECTION is a hash-table, all the keys that are strings or symbols
-are the possible completions.
-If COLLECTION is an obarray, the names of all symbols in the obarray
-are the possible completions.
-
-COLLECTION can also be a function to do the completion itself.
-It receives three arguments: the values STRING, PREDICATE and t.
-Whatever it returns becomes the value of `all-completions'.
-
-If optional third argument PREDICATE is non-nil,
-it is used to test each possible match.
-The match is a candidate only if PREDICATE returns non-nil.
-The argument given to PREDICATE is the alist element
-or the symbol from the obarray.  If COLLECTION is a hash-table,
-predicate is called with two arguments: the key and the value.
-Additionally to this predicate, `completion-regexp-list'
-is used to further constrain the set of candidates.
-
-An obsolete optional fourth argument HIDE-SPACES is still accepted for
-backward compatibility.  If non-nil, strings in COLLECTION that start
-with a space are ignored unless STRING itself starts with a space.  */)
-  (Lisp_Object string, Lisp_Object collection, Lisp_Object predicate, Lisp_Object hide_spaces)
-{
-  Lisp_Object tail, elt, eltstring;
-  Lisp_Object allmatches;
-  int type = HASH_TABLE_P (collection) ? 3
-    : VECTORP (collection) ? 2
-    : NILP (collection) || (CONSP (collection) && !FUNCTIONP (collection));
-  ptrdiff_t idx = 0, obsize = 0;
-  Lisp_Object bucket, tem, zero;
-  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
-
-  CHECK_STRING (string);
-  if (type == 0)
-    return call3 (collection, string, predicate, Qt);
-  allmatches = bucket = Qnil;
-  zero = make_number (0);
-
-  /* If COLLECTION is not a list, set TAIL just for gc pro.  */
-  tail = collection;
-  if (type == 2)
-    {
-      collection = check_obarray (collection);
-      obsize = ASIZE (collection);
-      bucket = AREF (collection, idx);
-    }
-
-  while (1)
-    {
-      /* Get the next element of the alist, obarray, or hash-table.  */
-      /* Exit the loop if the elements are all used up.  */
-      /* elt gets the alist element or symbol.
-	 eltstring gets the name to check as a completion.  */
-
-      if (type == 1)
-	{
-	  if (!CONSP (tail))
-	    break;
-	  elt = XCAR (tail);
-	  eltstring = CONSP (elt) ? XCAR (elt) : elt;
-	  tail = XCDR (tail);
-	}
-      else if (type == 2)
-	{
-	  if (!EQ (bucket, zero))
-	    {
-	      if (!SYMBOLP (bucket))
-		error ("Bad data in guts of obarray");
-	      elt = bucket;
-	      eltstring = elt;
-	      if (XSYMBOL (bucket)->next)
-		XSETSYMBOL (bucket, XSYMBOL (bucket)->next);
-	      else
-		XSETFASTINT (bucket, 0);
-	    }
-	  else if (++idx >= obsize)
-	    break;
-	  else
-	    {
-	      bucket = AREF (collection, idx);
-	      continue;
-	    }
-	}
-      else /* if (type == 3) */
-	{
-	  while (idx < HASH_TABLE_SIZE (XHASH_TABLE (collection))
-		 && NILP (HASH_HASH (XHASH_TABLE (collection), idx)))
-	    idx++;
-	  if (idx >= HASH_TABLE_SIZE (XHASH_TABLE (collection)))
-	    break;
-	  else
-	    elt = eltstring = HASH_KEY (XHASH_TABLE (collection), idx++);
-	}
-
-      /* 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
-	     unless the input starts with space.  */
-	  && (NILP (hide_spaces)
-	      || (SBYTES (string) > 0
-		  && SREF (string, 0) == ' ')
-	      || SREF (eltstring, 0) != ' ')
-	  && (tem = Fcompare_strings (eltstring, zero,
-				      make_number (SCHARS (string)),
-				      string, zero,
-				      make_number (SCHARS (string)),
-				      completion_ignore_case ? Qt : Qnil),
-	      EQ (Qt, tem)))
-	{
-	  /* Yes.  */
-	  Lisp_Object regexps;
-
-	  /* Ignore this element if it fails to match all the regexps.  */
-	  {
-            dynwind_begin ();
-            specbind (Qcase_fold_search,
-                      completion_ignore_case ? Qt : Qnil);
-	    for (regexps = Vcompletion_regexp_list; CONSP (regexps);
-		 regexps = XCDR (regexps))
-	      {
-		tem = Fstring_match (XCAR (regexps), eltstring, zero);
-		if (NILP (tem))
-		  break;
-	      }
-            dynwind_end ();
-	    if (CONSP (regexps))
-	      continue;
-	  }
-
-	  /* Ignore this element if there is a predicate
-	     and the predicate doesn't like it.  */
-
-	  if (!NILP (predicate))
-	    {
-	      if (EQ (predicate, Qcommandp))
-		tem = Fcommandp (elt, Qnil);
-	      else
-		{
-		  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;
-	    }
-	  /* Ok => put it on the list.  */
-	  allmatches = Fcons (eltstring, allmatches);
-	}
-    }
-
-  return Fnreverse (allmatches);
-}
-
 DEFUN ("completing-read", Fcompleting_read, Scompleting_read, 2, 8, 0,
        doc: /* Read a string in the minibuffer, with completion.
 PROMPT is a string to prompt with; normally it ends in a colon and a space.
@@ -1655,173 +1221,6 @@ See also `completing-read-function'.  */)
   return Ffuncall (9, args);
 }
 
-/* Test whether TXT is an exact completion.  */
-DEFUN ("test-completion", Ftest_completion, Stest_completion, 2, 3, 0,
-       doc: /* Return non-nil if STRING is a valid completion.
-Takes the same arguments as `all-completions' and `try-completion'.
-If COLLECTION is a function, it is called with three arguments:
-the values STRING, PREDICATE and `lambda'.  */)
-  (Lisp_Object string, Lisp_Object collection, Lisp_Object predicate)
-{
-  Lisp_Object regexps, tail, tem = Qnil;
-  ptrdiff_t i = 0;
-
-  CHECK_STRING (string);
-
-  if (NILP (collection) || (CONSP (collection) && !FUNCTIONP (collection)))
-    {
-      tem = Fassoc_string (string, collection, completion_ignore_case ? Qt : Qnil);
-      if (NILP (tem))
-	return Qnil;
-    }
-  else if (VECTORP (collection))
-    {
-      /* Bypass intern-soft as that loses for nil.  */
-      tem = oblookup (collection,
-		      SSDATA (string),
-		      SCHARS (string),
-		      SBYTES (string));
-      if (!SYMBOLP (tem))
-	{
-	  if (STRING_MULTIBYTE (string))
-	    string = Fstring_make_unibyte (string);
-	  else
-	    string = Fstring_make_multibyte (string);
-
-	  tem = oblookup (collection,
-			  SSDATA (string),
-			  SCHARS (string),
-			  SBYTES (string));
-	}
-
-      if (completion_ignore_case && !SYMBOLP (tem))
-	{
-	  for (i = ASIZE (collection) - 1; i >= 0; i--)
-	    {
-	      tail = AREF (collection, i);
-	      if (SYMBOLP (tail))
-		while (1)
-		  {
-		    if (EQ (Fcompare_strings (string, make_number (0), Qnil,
-					      Fsymbol_name (tail),
-					      make_number (0) , Qnil, Qt),
-			   Qt))
-		      {
-			tem = tail;
-			break;
-		      }
-		    if (XSYMBOL (tail)->next == 0)
-		      break;
-		    XSETSYMBOL (tail, XSYMBOL (tail)->next);
-		  }
-	    }
-	}
-
-      if (!SYMBOLP (tem))
-	return Qnil;
-    }
-  else if (HASH_TABLE_P (collection))
-    {
-      struct Lisp_Hash_Table *h = XHASH_TABLE (collection);
-      Lisp_Object key = Qnil;
-      i = hash_lookup (h, string, NULL);
-      if (i >= 0)
-	tem = HASH_KEY (h, i);
-      else
-	for (i = 0; i < HASH_TABLE_SIZE (h); ++i)
-	  if (!NILP (HASH_HASH (h, i))
-	      && (key = HASH_KEY (h, i),
-		  SYMBOLP (key) ? key = Fsymbol_name (key) : key,
-		  STRINGP (key))
-	      && EQ (Fcompare_strings (string, make_number (0), Qnil,
-				       key, make_number (0) , Qnil,
-				       completion_ignore_case ? Qt : Qnil),
-		     Qt))
-	    {
-	      tem = key;
-	      break;
-	    }
-      if (!STRINGP (tem))
-	return Qnil;
-    }
-  else
-    return call3 (collection, string, predicate, Qlambda);
-
-  /* Reject this element if it fails to match all the regexps.  */
-  if (CONSP (Vcompletion_regexp_list))
-    {
-      dynwind_begin ();
-      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))){
-	    
-	      dynwind_end ();
-  	    return Qnil;
-	    }
-	}
-      dynwind_end ();
-    }
-
-  /* Finally, check the predicate.  */
-  if (!NILP (predicate))
-    {
-      return HASH_TABLE_P (collection)
-	? call2 (predicate, tem, HASH_VALUE (XHASH_TABLE (collection), i))
-	: call1 (predicate, tem);
-    }
-  else
-    return Qt;
-}
-
-static Lisp_Object Qmetadata;
-
-DEFUN ("internal-complete-buffer", Finternal_complete_buffer, Sinternal_complete_buffer, 3, 3, 0,
-       doc: /* Perform completion on buffer names.
-STRING and PREDICATE have the same meanings as in `try-completion',
-`all-completions', and `test-completion'.
-
-If FLAG is nil, invoke `try-completion'; if it is t, invoke
-`all-completions'; otherwise invoke `test-completion'.  */)
-  (Lisp_Object string, Lisp_Object predicate, Lisp_Object flag)
-{
-  if (NILP (flag))
-    return Ftry_completion (string, Vbuffer_alist, predicate);
-  else if (EQ (flag, Qt))
-    {
-      Lisp_Object res = Fall_completions (string, Vbuffer_alist, predicate, Qnil);
-      if (SCHARS (string) > 0)
-	return res;
-      else
-	{ /* Strip out internal buffers.  */
-	  Lisp_Object bufs = res;
-	  /* First, look for a non-internal buffer in `res'.  */
-	  while (CONSP (bufs) && SREF (XCAR (bufs), 0) == ' ')
-	    bufs = XCDR (bufs);
-	  if (NILP (bufs))
-	    return (EQ (Flength (res), Flength (Vbuffer_alist))
-		    /* If all bufs are internal don't strip them out.  */
-		    ? res : bufs);
-	  res = bufs;
-	  while (CONSP (XCDR (bufs)))
-	    if (SREF (XCAR (XCDR (bufs)), 0) == ' ')
-	      XSETCDR (bufs, XCDR (XCDR (bufs)));
-	    else
-	      bufs = XCDR (bufs);
-	  return res;
-	}
-    }
-  else if (EQ (flag, Qlambda))
-    return Ftest_completion (string, Vbuffer_alist, predicate);
-  else if (EQ (flag, Qmetadata))
-    return list2 (Qmetadata, Fcons (Qcategory, Qbuffer));
-  else
-    return Qnil;
-}
-
 /* Like assoc but assumes KEY is a string, and ignores case if appropriate.  */
 
 DEFUN ("assoc-string", Fassoc_string, Sassoc_string, 2, 3, 0,
@@ -1920,7 +1319,6 @@ syms_of_minibuf (void)
   DEFSYM (Qcurrent_input_method, "current-input-method");
   DEFSYM (Qactivate_input_method, "activate-input-method");
   DEFSYM (Qcase_fold_search, "case-fold-search");
-  DEFSYM (Qmetadata, "metadata");
 
   DEFVAR_LISP ("read-expression-history", Vread_expression_history,
 	       doc: /* A history list for arguments that are Lisp expressions to evaluate.