--- a/src/ChangeLog	Fri Dec 30 16:39:14 2011 +0000
+++ b/src/ChangeLog	Sun Jan 01 15:18:52 2012 +0000
@@ -1,3 +1,49 @@
+2012-01-01  Aidan Kehoe  <kehoea@parhasard.net>
+
+	Add #'test-completion, API from GNU.
+	Accept hash table COLLECTIONs in it and in the other
+	completion-oriented functions, #'try-completion,
+	#'all-completions, and those Lisp functions implemented in terms
+	of them.
+
+	* lisp.h: Update the prototype of map_obarray(), making FN
+	compatible with the FUNCTION argument of elisp_maphash();
+
+	* abbrev.c (abbrev_match_mapper):
+	* abbrev.c (record_symbol):
+	* doc.c (verify_doc_mapper):
+	* symbols.c (mapatoms_1):
+	* symbols.c (apropos_mapper):
+	Update these mapper functions to reflect the new argument to
+	map_obarray().
+
+	* symbols.c (map_obarray):
+	Call FN with two arguments, the string name of the symbol, and the
+	symbol itself, for API (mapper) compatibility with
+	elisp_maphash().
+
+	* minibuf.c (map_completion): New. Map a maphash_function_t across
+	a non function COLLECTION, as appropriate for #'try-completion and
+	friends.
+	* minibuf.c (map_completion_list): New. Map a maphash_function_t
+	across a pseudo-alist, as appropriate for the completion
+	functions. 
+	* minibuf.c (ignore_completion_p): PRED needs to be called with
+	two args if and only if the collection is a hash table. Implement
+	this.
+	* minibuf.c (try_completion_mapper): New. The loop body of
+	#'try-completion, refactored out.
+	* minibuf.c (Ftry_completion): Use try_completion_mapper(),
+	map_completion(). 
+	* minibuf.c (all_completions_mapper): New. The loop body of
+	#'all-completions, refactored out.
+	* minibuf.c (Fall_completions): Use all_completions_mapper(),
+	map_completion().
+	* minibuf.c (test_completion_mapper): New. The loop body of
+	#'test-completion. 
+	* minibuf.c (Ftest_completion): New, API from GNU.
+	* minibuf.c (syms_of_minibuf): Make Ftest_completion available.
+
 2011-12-30  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* eval.c (Fmacroexpand):

--- a/src/abbrev.c	Fri Dec 30 16:39:14 2011 +0000
+++ b/src/abbrev.c	Sun Jan 01 15:18:52 2012 +0000
@@ -88,7 +88,8 @@
    before point, case-insensitively.  When found, return non-zero, so
    that map_obarray terminates mapping.  */
 static int
-abbrev_match_mapper (Lisp_Object symbol, void *arg)
+abbrev_match_mapper (Lisp_Object UNUSED (key), Lisp_Object symbol, 
+                     void *arg)
 {
   struct abbrev_match_mapper_closure *closure =
     (struct abbrev_match_mapper_closure *)arg;
@@ -478,7 +479,7 @@
 }
 
 static int
-record_symbol (Lisp_Object sym, void *arg)
+record_symbol (Lisp_Object UNUSED (key), Lisp_Object sym, void *arg)
 {
   Lisp_Object closure = * (Lisp_Object *) arg;
   XSETCDR (closure, Fcons (sym, XCDR (closure)));

--- a/src/doc.c	Fri Dec 30 16:39:14 2011 +0000
+++ b/src/doc.c	Sun Jan 01 15:18:52 2012 +0000
@@ -972,7 +972,7 @@
 
 
 static int
-verify_doc_mapper (Lisp_Object sym, void *arg)
+verify_doc_mapper (Lisp_Object UNUSED (key), Lisp_Object sym, void *arg)
 {
   Lisp_Object closure = * (Lisp_Object *) arg;
 

--- a/src/lisp.h	Fri Dec 30 16:39:14 2011 +0000
+++ b/src/lisp.h	Sun Jan 01 15:18:52 2012 +0000
@@ -5797,7 +5797,9 @@
 MODULE_API Lisp_Object intern (const CIbyte *str);
 Lisp_Object intern_massaging_name (const CIbyte *str);
 Lisp_Object oblookup (Lisp_Object, const Ibyte *, Bytecount);
-void map_obarray (Lisp_Object, int (*) (Lisp_Object, void *), void *);
+/* Note that the mapper function has the same signature as in elisp_maphash. */
+void map_obarray (Lisp_Object, int (*) (Lisp_Object, Lisp_Object, void *),
+                  void *);
 Lisp_Object indirect_function (Lisp_Object, int);
 Lisp_Object symbol_value_in_buffer (Lisp_Object, Lisp_Object);
 void kill_buffer_local_variables (struct buffer *);

--- a/src/minibuf.c	Fri Dec 30 16:39:14 2011 +0000
+++ b/src/minibuf.c	Sun Jan 01 15:18:52 2012 +0000
@@ -35,6 +35,7 @@
 #include "insdel.h"
 #include "redisplay.h"
 #include "window-impl.h"
+#include "elhash.h"
 
 /* Depth in minibuffer invocations.  */
 int minibuf_level;
@@ -244,6 +245,51 @@
   else return len - l;
 }
 
+/* Map FUNCTION, a C function, across LISZT, a pseudo-alist, calling
+   it with three args, ELTSTRING (the car of the element if a cons,
+   otherwise the element itself), ELT (the element, always) and
+   EXTRA_ARG. Stop if FUNCTION returns non-zero. */
+static void
+map_completion_list (maphash_function_t function, Lisp_Object liszt,
+                     void *extra_arg)
+{
+  Lisp_Object eltstring;
+
+  GC_EXTERNAL_LIST_LOOP_2 (elt, liszt)
+    {
+      eltstring = CONSP (elt) ? XCAR (elt) : elt;
+      if (function (eltstring, elt, extra_arg))
+        {
+          XUNGCPRO (elt);
+          return;
+        }
+    }
+  END_GC_EXTERNAL_LIST_LOOP (elt);
+}
+
+static void
+map_completion (maphash_function_t function, Lisp_Object collection,
+                void *extra_arg, Lisp_Object predicate)
+{
+  if (LISTP (collection))
+    {
+      map_completion_list (function, collection, extra_arg);
+    }
+  else if (VECTORP (collection))
+    {
+      map_obarray (collection, function, extra_arg);
+    }
+  else if (NILP (predicate))
+    {
+      /* This can't call Lisp, no need to copy and compress the hash
+         table entries. */
+      elisp_maphash_unsafe (function, collection, extra_arg);
+    }
+  else
+    {
+      elisp_maphash (function, collection, extra_arg);
+    }
+}
 
 int
 regexp_ignore_completion_p (const Ibyte *nonreloc,
@@ -264,53 +310,157 @@
   return 0;
 }
 
-
 /* Callers should GCPRO, since this may call eval */
 static int
 ignore_completion_p (Lisp_Object completion_string,
-                     Lisp_Object pred, Lisp_Object completion)
+                     Lisp_Object pred, Lisp_Object completion,
+                     Boolint hash_tablep)
 {
+  Lisp_Object tem;
+
   if (regexp_ignore_completion_p (0, completion_string, 0, -1))
     return 1;
 
-  /* Ignore this element if there is a predicate
-     and the predicate doesn't like it. */
-  if (!NILP (pred))
-  {
-    Lisp_Object tem;
-    if (EQ (pred, Qcommandp))
+  if (NILP (pred))
+    {
+      return 0;
+    }
+
+  /* Ignore this element if there is a predicate and the predicate doesn't
+     like it. */
+  if (hash_tablep)
+    {
+      tem = call2 (pred, completion_string, completion);
+    }
+  else if (EQ (pred, Qcommandp))
+    {
       tem = Fcommandp (completion);
-    else
+    }
+  else
+    {
       tem = call1 (pred, completion);
-    if (NILP (tem))
-      return 1;
-  }
+    }
+
+  return NILP (tem);
+}
+
+struct try_completion_closure 
+{
+  Lisp_Object string;
+  Charcount slength;
+  Lisp_Object predicate;
+  Lisp_Object bestmatch;
+  Charcount blength;
+  Charcount bestmatchsize;
+  Boolint hash_tablep;
+  int matchcount;
+};
+
+static int
+try_completion_mapper (Lisp_Object eltstring, Lisp_Object value,
+                       void *arg)
+{
+  struct try_completion_closure *tcc = (struct try_completion_closure *) arg;
+  Charcount eltlength;
+
+  if (SYMBOLP (eltstring))
+    {
+      eltstring = XSYMBOL_NAME (eltstring);
+    }
+
+  if (!STRINGP (eltstring))
+    {
+      return 0;
+    }
+
+  /* Is this element a possible completion? */
+  eltlength = string_char_length (eltstring);
+  if (tcc->slength <= eltlength
+      && (0 > scmp (XSTRING_DATA (eltstring), XSTRING_DATA (tcc->string),
+                    tcc->slength)))
+    {
+      struct gcpro gcpro1, gcpro2, gcpro3;
+      int loser;
+      GCPRO3 (tcc->string, eltstring, tcc->bestmatch);
+      loser = ignore_completion_p (eltstring, tcc->predicate, value,
+                                   tcc->hash_tablep);
+      UNGCPRO;
+      if (loser)      /* reject this one */
+        {
+          return 0;
+        }
+
+      /* Update computation of how much all possible completions
+         match */
+
+      tcc->matchcount++;
+      if (NILP (tcc->bestmatch))
+        {
+          tcc->bestmatch = eltstring;
+          tcc->blength = eltlength;
+          tcc->bestmatchsize = eltlength;
+        }
+      else
+        {
+          Charcount compare = min (tcc->bestmatchsize, eltlength);
+          Charcount matchsize =
+            scmp (XSTRING_DATA (tcc->bestmatch), XSTRING_DATA (eltstring),
+                  compare);
+          if (matchsize < 0)
+            matchsize = compare;
+          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 == eltlength
+                   && matchsize < tcc->blength)
+                  ||
+                  /* 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 == eltlength)
+                   ==
+                   (matchsize == tcc->blength)
+                   && 0 > scmp_1 (XSTRING_DATA (eltstring),
+                                  XSTRING_DATA (tcc->string),
+                                  tcc->slength, 0)
+                   && 0 <= scmp_1 (XSTRING_DATA (tcc->bestmatch),
+                                   XSTRING_DATA (tcc->string),
+                                   tcc->slength, 0)))
+                {
+                  tcc->bestmatch = eltstring;
+                  tcc->blength = eltlength;
+                }
+            }
+          tcc->bestmatchsize = matchsize;
+        }
+    }
+
   return 0;
 }
 
-
-/* #### Maybe we should allow COLLECTION to be a hash table.
-   It is wrong for the use of obarrays to be better-rewarded than the
-   use of hash tables.  By better-rewarded I mean that you can pass an
-   obarray to all of the completion functions, whereas you can't do
-   anything like that with a hash table.
-
-   To do so, there should probably be a
-   map_obarray_or_alist_or_hash_table function which would be used by
-   both Ftry_completion and Fall_completions.  [[ But would the
-   additional funcalls slow things down? ]] Seriously doubtful. --ben */
-
 DEFUN ("try-completion", Ftry_completion, 2, 3, 0, /*
 Return common substring of all completions of STRING in COLLECTION.
-COLLECTION must be an alist, an obarray, or a function.
-Each string in COLLECTION is tested to see if it begins with STRING.
-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 an exact match, t is returned.
+COLLECTION must be a list, a hash table, an obarray, or a function.
+
+Each string (or symbol) in COLLECTION is tested to see if it (or its
+name) begins with STRING.  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 an exact
+match, t is returned.
 
-If COLLECTION is list, the elements of the list that are not cons
+If COLLECTION is a list, the elements of the list that are not cons
 cells and the cars of the elements of the list that are cons cells
-(which must be strings) form the set of possible completions.
+\(which must be strings or symbols) form the set of possible
+completions.
+
+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.
@@ -322,207 +472,122 @@
 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.
+or the symbol from the obarray.  If COLLECTION is a hash table,
+PREDICATE is passed two arguments, the key and the value of the hash
+table entry.
 */
        (string, collection, predicate))
 {
   /* This function can GC */
-  Lisp_Object bestmatch, tail;
-  Charcount bestmatchsize = 0;
-  int list;
-  int indice = 0;
-  int matchcount = 0;
-  int obsize;
-  Lisp_Object bucket;
-  Charcount slength, blength;
+  struct try_completion_closure tcc;
 
   CHECK_STRING (string);
 
-  if (CONSP (collection))
+  if (!NILP (Ffunctionp (collection)))
     {
-      Lisp_Object tem = XCAR (collection);
-      if (SYMBOLP (tem))	/* lambda, autoload, etc.  Emacs-lisp sucks */
-	return call3 (collection, string, predicate, Qnil);
-      else
-	list = 1;
+      return call3 (collection, string, predicate, Qnil);
     }
-  else if (VECTORP (collection))
-    list = 0;
-  else if (NILP (collection))
-    list = 1;
-  else
-    return call3 (collection, string, predicate, Qnil);
 
-  bestmatch = Qnil;
-  blength = 0;
-  slength = string_char_length (string);
-
-  /* If COLLECTION is not a list, set TAIL just for gc pro.  */
-  tail = collection;
-  if (!list)
+  if (!(LISTP (collection) || VECTORP (collection) || HASH_TABLEP (collection)))
     {
-      obsize = XVECTOR_LENGTH (collection);
-      bucket = XVECTOR_DATA (collection)[indice];
-    }
-  else /* warning suppression */
-    {
-      obsize = 0;
-      bucket = Qnil;
+      signal_error (Qwrong_type_argument,
+                    "must be a list, vector, hash table or function",
+                    collection);
     }
 
-  while (1)
-    {
-      /* Get the next element of the alist or obarray. */
-      /* 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. */
-      Lisp_Object elt;
-      Lisp_Object eltstring;
-
-      if (list)
-	{
-	  if (NILP (tail))
-	    break;
-	  elt = Fcar (tail);
-	  if (CONSP (elt))
-	    eltstring = Fcar (elt);
-	  else
-	    eltstring = elt;
-	  tail = Fcdr (tail);
-	}
-      else
-	{
-	  if (!ZEROP (bucket))
-	    {
-              Lisp_Symbol *next;
-	      if (!SYMBOLP (bucket))
-		{
-		  invalid_argument ("Bad obarray passed to try-completions",
-				    bucket);
-		}
-	      next = symbol_next (XSYMBOL (bucket));
-	      elt = bucket;
-	      eltstring = Fsymbol_name (elt);
-              if (next)
-		bucket = wrap_symbol (next);
-	      else
-		bucket = Qzero;
-	    }
-	  else if (++indice >= obsize)
-	    break;
-	  else
-	    {
-	      bucket = XVECTOR_DATA (collection)[indice];
-	      continue;
-	    }
-	}
-
-      /* Is this element a possible completion? */
+  tcc.string = string;
+  tcc.slength = string_char_length (string);
+  tcc.bestmatch = Qnil;
+  tcc.blength = 0;
+  tcc.bestmatchsize = 0;
+  tcc.predicate = predicate;
+  tcc.hash_tablep = HASH_TABLEP (collection);
+  tcc.matchcount = 0;
 
-      if (STRINGP (eltstring))
-	{
-	  Charcount eltlength = string_char_length (eltstring);
-	  if (slength <= eltlength
-	      && (0 > scmp (XSTRING_DATA (eltstring),
-                            XSTRING_DATA (string),
-                            slength)))
-	    {
-              {
-                struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
-                int loser;
-                GCPRO4 (tail, string, eltstring, bestmatch);
-                loser = ignore_completion_p (eltstring, predicate, elt);
-                UNGCPRO;
-                if (loser)      /* reject this one */
-                  continue;
-              }
+  map_completion (try_completion_mapper, collection, &tcc, predicate);
 
-	      /* Update computation of how much all possible
-		 completions match */
+  if (NILP (tcc.bestmatch))
+    return Qnil;		/* No completions found */
 
-	      matchcount++;
-	      if (NILP (bestmatch))
-		{
-		  bestmatch = eltstring;
-                  blength = eltlength;
-		  bestmatchsize = eltlength;
-		}
-	      else
-		{
-		  Charcount compare = min (bestmatchsize, eltlength);
-		  Charcount matchsize =
-		    scmp (XSTRING_DATA (bestmatch),
-			  XSTRING_DATA (eltstring),
-			  compare);
-		  if (matchsize < 0)
-		    matchsize = compare;
-		  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 == eltlength
-			   && matchsize < blength)
-			  ||
-			  /* 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 == eltlength)
-			   ==
-			   (matchsize == blength)
-			   && 0 > scmp_1 (XSTRING_DATA (eltstring),
-					  XSTRING_DATA (string),
-					  slength, 0)
-			   && 0 <= scmp_1 (XSTRING_DATA (bestmatch),
-					   XSTRING_DATA (string),
-					   slength, 0)))
-                      {
-			bestmatch = eltstring;
-                        blength = eltlength;
-                      }
-		    }
-		  bestmatchsize = matchsize;
-		}
-	    }
-	}
-    }
-
-  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 == slength
-      && blength > bestmatchsize)
+  /* 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 && tcc.bestmatchsize == tcc.slength
+      && tcc.blength > tcc.bestmatchsize)
     return string;
 
-  /* Return t if the supplied string is an exact match (counting case);
-     it does not require any change to be made.  */
-  if (matchcount == 1
-      && bestmatchsize == slength
-      && 0 > scmp_1 (XSTRING_DATA (bestmatch),
-		     XSTRING_DATA (string),
-		     bestmatchsize, 0))
+  /* Return t if the supplied string is an exact match (counting
+     case); it does not require any change to be made.  */
+  if (tcc.matchcount == 1 && tcc.bestmatchsize == tcc.slength
+      && 0 > scmp_1 (XSTRING_DATA (tcc.bestmatch), XSTRING_DATA (tcc.string),
+		     tcc.bestmatchsize, 0))
     return Qt;
 
   /* Else extract the part in which all completions agree */
-  return Fsubseq (bestmatch, Qzero, make_fixnum (bestmatchsize));
+  return Fsubseq (tcc.bestmatch, Qzero, make_fixnum (tcc.bestmatchsize));
+}
+
+struct all_completions_closure
+{
+  Lisp_Object string;
+  Charcount slength;
+  Lisp_Object predicate;
+  Lisp_Object allmatches;
+  Boolint hash_tablep;
+};
+
+static int
+all_completions_mapper (Lisp_Object eltstring, Lisp_Object value, void *arg)
+{
+  struct all_completions_closure *acc = (struct all_completions_closure *) arg;
+  /* Is this element a possible completion? */
+
+  if (SYMBOLP (eltstring))
+    {
+      eltstring = XSYMBOL_NAME (eltstring);
+    }
+
+  if (STRINGP (eltstring) && (acc->slength <= string_char_length (eltstring))
+      /* Reject alternatives that start with space unless the input
+         starts with space.  */
+      && ((acc->slength > 0 && string_ichar (acc->string, 0) == ' ')
+          || string_ichar (eltstring, 0) != ' ')
+      && (0 > scmp (XSTRING_DATA (eltstring), XSTRING_DATA (acc->string),
+                    acc->slength)))
+    {
+      /* Yes.  Now check whether predicate likes it. */
+      struct gcpro gcpro1, gcpro2;
+      int loser;
+      GCPRO2 (eltstring, acc->string);
+      loser = ignore_completion_p (eltstring, acc->predicate, value,
+                                   acc->hash_tablep);
+      UNGCPRO;
+      if (!loser)
+        {
+          /* Ok => put it on the list. */
+          XSETCDR (acc->allmatches, Fcons (eltstring, Qnil));
+          acc->allmatches = XCDR (acc->allmatches);
+        }
+    }
+
+  return 0;
 }
 
-
 DEFUN ("all-completions", Fall_completions, 2, 3, 0, /*
 Search for partial matches to STRING in COLLECTION.
-COLLECTION must be an alist, an obarray, or a function.
-Each string in COLLECTION is tested to see if it begins with STRING.
-The value is a list of all the strings from COLLECTION that match.
+COLLECTION must be an list, a hash table, an obarray, or a function.
+
+Each string (or symbol) in COLLECTION is tested to see if it (or its
+name) begins with STRING.  The value is a list of all the strings from
+COLLECTION that match.
 
-If COLLECTION is an alist, the cars of the elements of the alist
-\(which must be strings) form the set of possible completions.
+If COLLECTION is a list, the elements of the list that are not cons
+cells and the cars of the elements of the list that are cons cells
+\(which must be strings or symbols) form the set of possible
+completions.
+
+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.
@@ -534,117 +599,179 @@
 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.
+or the symbol from the obarray.  If COLLECTION is a hash table,
+PREDICATE is passed two arguments, the key and the value of the hash
+table entry.
 */
        (string, collection, predicate))
 {
   /* This function can GC */
-  Lisp_Object tail;
-  Lisp_Object allmatches;
-  int list;
-  int indice = 0;
-  int obsize;
-  Lisp_Object bucket;
-  Charcount slength;
+  struct all_completions_closure acc;
+  Lisp_Object allmatches = noseeum_cons (Qnil, Qnil);
+  struct gcpro gcpro1;
 
   CHECK_STRING (string);
 
-  if (CONSP (collection))
+  if (!NILP (Ffunctionp (collection)))
     {
-      Lisp_Object tem = XCAR (collection);
-      if (SYMBOLP (tem))	/* lambda, autoload, etc.  Emacs-lisp sucks */
-	return call3 (collection, string, predicate, Qt);
-      else
-	list = 1;
-    }
-  else if (VECTORP (collection))
-    list = 0;
-  else if (NILP (collection))
-    list = 1;
-  else
-    return call3 (collection, string, predicate, Qt);
-
-  allmatches = Qnil;
-  slength = string_char_length (string);
-
-  /* If COLLECTION is not a list, set TAIL just for gc pro.  */
-  tail = collection;
-  if (!list)
-    {
-      obsize = XVECTOR_LENGTH (collection);
-      bucket = XVECTOR_DATA (collection)[indice];
-    }
-  else /* warning suppression */
-    {
-      obsize = 0;
-      bucket = Qnil;
+      return call3 (collection, string, predicate, Qt);
     }
 
-  while (1)
+  if (!(LISTP (collection) || VECTORP (collection) || HASH_TABLEP (collection)))
     {
-      /* Get the next element of the alist or obarray. */
-      /* 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. */
-      Lisp_Object elt;
-      Lisp_Object eltstring;
+      signal_error (Qwrong_type_argument,
+                    "must be a list, vector, hash table or function",
+                    collection);
+    }
+  GCPRO1 (allmatches);
+  acc.string = string;
+  acc.slength = string_char_length (string);
+  acc.predicate = predicate;
+  acc.allmatches = allmatches;
+  acc.hash_tablep = HASH_TABLEP (collection);
+
+  map_completion (all_completions_mapper, collection, &acc, predicate);
+
+  acc.allmatches = XCDR (allmatches);
+  free_cons (allmatches);
+  UNGCPRO;
+  return acc.allmatches;
+}
+
+struct test_completion_closure
+{
+  Lisp_Object string;
+  Lisp_Object predicate;
+  Lisp_Object result;
+  Boolint hash_tablep;
+};
 
-      if (list)
-	{
-	  if (NILP (tail))
-	    break;
-	  elt = Fcar (tail);
-	  eltstring = Fcar (elt);
-	  tail = Fcdr (tail);
-	}
-      else
-	{
-	  if (!ZEROP (bucket))
-	    {
-              Lisp_Symbol *next = symbol_next (XSYMBOL (bucket));
-	      elt = bucket;
-	      eltstring = Fsymbol_name (elt);
-              if (next)
-		bucket = wrap_symbol (next);
-	      else
-		bucket = Qzero;
-            }
-	  else if (++indice >= obsize)
-	    break;
-	  else
-	    {
-	      bucket = XVECTOR_DATA (collection)[indice];
-	      continue;
-	    }
-	}
+static int
+test_completion_mapper (Lisp_Object eltstring, Lisp_Object value, void *arg)
+{
+  struct test_completion_closure *tcc = (struct test_completion_closure *) arg;
+
+  if (SYMBOLP (eltstring))
+    {
+      eltstring = XSYMBOL_NAME (eltstring);
+    }
+
+  if (!STRINGP (eltstring))
+    {
+      return 0;
+    }
 
-      /* Is this element a possible completion? */
-
-      if (STRINGP (eltstring)
-          && (slength <= string_char_length (eltstring))
-          /* Reject alternatives that start with space
-	     unless the input starts with space.  */
-	  && ((string_char_length (string) > 0 &&
-	       string_ichar (string, 0) == ' ')
-	      || string_ichar (eltstring, 0) != ' ')
-	  && (0 > scmp (XSTRING_DATA (eltstring),
-                        XSTRING_DATA (string),
-                        slength)))
-	{
-	  /* Yes.  Now check whether predicate likes it. */
-          struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
-          int loser;
-          GCPRO4 (tail, eltstring, allmatches, string);
-          loser = ignore_completion_p (eltstring, predicate, elt);
-          UNGCPRO;
-          if (!loser)
-            /* Ok => put it on the list. */
-            allmatches = Fcons (eltstring, allmatches);
+  if (completion_ignore_case ?
+      0 == qxetextcasecmp (XSTRING_DATA (tcc->string),
+                           XSTRING_LENGTH (tcc->string),
+                           XSTRING_DATA (eltstring),
+                           XSTRING_LENGTH (eltstring))
+      : 0 == qxememcmp4 (XSTRING_DATA (tcc->string),
+                         XSTRING_LENGTH (tcc->string),
+                         XSTRING_DATA (eltstring),
+                         XSTRING_LENGTH (eltstring)))
+    {
+      struct gcpro gcpro1, gcpro2, gcpro3;
+      int loser;
+      GCPRO3 (eltstring, tcc->string, tcc->predicate);
+      loser = ignore_completion_p (eltstring, tcc->predicate, value,
+                                   tcc->hash_tablep);
+      UNGCPRO;
+      if (!loser)
+        {
+          tcc->result = Qt;
+          return 1;
         }
     }
 
-  return Fnreverse (allmatches);
+  return 0;
 }
+
+DEFUN ("test-completion", Ftest_completion, 2, 3, 0, /*
+Return non-nil if STRING is a valid completion in COLLECTION.
+
+COLLECTION must be a list, a hash table, an obarray, or a function.
+
+Each string (or symbol) in COLLECTION is tested to see if it (or its
+name) begins with STRING.  The value is a list of all the strings from
+COLLECTION that match.
+
+If COLLECTION is a list, the elements of the list that are not cons
+cells and the cars of the elements of the list that are cons cells
+\(which must be strings or symbols) form the set of possible
+completions.
+
+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.
+
+If COLLECTION is a function, it is called with three arguments: the
+values STRING, PREDICATE and the symbol `lambda'.  Whatever it returns
+is passed back by `test-completion'.
+
+If optional third argument PREDICATE is non-nil, it is used to test
+for possible matches.  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 passed two arguments, the key and the value of the hash
+table entry.
+*/
+       (string, collection, predicate))
+{
+  struct test_completion_closure tcc;
+
+  CHECK_STRING (string);
+
+  if (!NILP (Ffunctionp (collection)))
+    {
+      return call3 (collection, string, predicate, Qlambda);
+    }
+
+  if (!(LISTP (collection) || VECTORP (collection) || HASH_TABLEP (collection)))
+    {
+      signal_error (Qwrong_type_argument,
+                    "must be a list, vector, hash table or function",
+                    collection);
+    }
+
+  tcc.string = string;
+  tcc.predicate = predicate;
+  tcc.result = Qnil;
+  tcc.hash_tablep = HASH_TABLEP (collection);
+
+  if (VECTORP (collection) && !completion_ignore_case)
+    {
+      /* We're case sensitive -> no need for a linear search. */
+      Lisp_Object lookup = Fintern_soft (string, collection, Qzero);
+
+      if (ZEROP (lookup))
+        {
+          return Qnil;
+        }
+
+      return ignore_completion_p (XSYMBOL_NAME (lookup), tcc.predicate,
+                                  lookup, 0) ? Qnil : Qt;
+
+      /* It would be reasonable to do something similar for the hash
+         tables, except, both symbol and string keys are vaild
+         completions there. So a negative #'gethash for the string
+         (with #'equal as the hash table tests) still means you have
+         to do the linear search, for any symbols with that string
+         name, which hash very differently; returning t is a little
+         quicker, but returning nil is just as slow, so our average
+         performance barely changes, at the cost of code
+         complexity. */
+    }
+  else
+    {
+      map_completion (test_completion_mapper, collection, &tcc, predicate);
+    }
+
+  return tcc.result;
+}
+
 
 /* Useless FSFmacs functions */
 /* More than useless.  I've nuked minibuf_prompt_width so they won't
@@ -939,6 +1066,7 @@
 
   DEFSUBR (Ftry_completion);
   DEFSUBR (Fall_completions);
+  DEFSUBR (Ftest_completion);
 
   DEFSYMBOL (Qappend_message);
   DEFSYMBOL (Qclear_message);

--- a/src/symbols.c	Fri Dec 30 16:39:14 2011 +0000
+++ b/src/symbols.c	Sun Jan 01 15:18:52 2012 +0000
@@ -446,7 +446,7 @@
    non-zero value.  */
 void
 map_obarray (Lisp_Object obarray,
-	     int (*fn) (Lisp_Object, void *), void *arg)
+	     int (*fn) (Lisp_Object, Lisp_Object, void *), void *arg)
 {
   REGISTER int i;
 
@@ -458,7 +458,7 @@
 	while (1)
 	  {
 	    Lisp_Symbol *next;
-	    if ((*fn) (tail, arg))
+	    if ((*fn) (XSYMBOL_NAME (tail), tail, arg))
 	      return;
 	    next = symbol_next (XSYMBOL (tail));
 	    if (!next)
@@ -469,7 +469,7 @@
 }
 
 static int
-mapatoms_1 (Lisp_Object sym, void *arg)
+mapatoms_1 (Lisp_Object UNUSED (key), Lisp_Object sym, void *arg)
 {
   call1 (*(Lisp_Object *)arg, sym);
   return 0;
@@ -506,7 +506,7 @@
 };
 
 static int
-apropos_mapper (Lisp_Object symbol, void *arg)
+apropos_mapper (Lisp_Object UNUSED (key), Lisp_Object symbol, void *arg)
 {
   struct appropos_mapper_closure *closure =
     (struct appropos_mapper_closure *) arg;

--- a/tests/ChangeLog	Fri Dec 30 16:39:14 2011 +0000
+++ b/tests/ChangeLog	Sun Jan 01 15:18:52 2012 +0000
@@ -1,3 +1,9 @@
+2012-01-01  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* automated/completion-tests.el: New.
+	Test #'try-completion, #'all-completion and #'test-completion with
+	list, vector and hash-table COLLECTION arguments.
+
 2011-12-30  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* automated/hash-table-tests.el:

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/automated/completion-tests.el	Sun Jan 01 15:18:52 2012 +0000
@@ -0,0 +1,307 @@
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; Author: Aidan Kehoe <kehoea@parhasard.net>
+;; Maintainers: Aidan Kehoe <kehoea@parhasard.net>
+;; Created: 2012
+;; Keywords: tests
+
+;; This file is part of XEmacs.
+
+;; XEmacs 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.
+
+;; XEmacs is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+;; for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Synched up with: Not in FSF.
+
+;; This file tests pseudo-alist, obarray and hash-table arguments to
+;; #'try-completion, #'all-completions and #'test-completion. It doesn't
+;; test function arguments as COLLECTION.
+
+(require 'cl)
+
+(or (featurep 'xemacs)
+    (defmacro Assert (assertion &optional failing-case)
+      ;; This file can actually execute on GNU, though it exposes some bugs
+      ;; as of So 1 Jan 2012 14:41:32 GMT, described in
+      ;; http://mid.gmane.org/20224.27302.821804.284656@parhasard.net .
+      `(condition-case err
+           (assert ,assertion nil
+                   ,@(if (memq (car-safe assertion)
+                               '(eq eql equal equalp = string= < <= > >=))
+                         (list
+                          (concat (if failing-case
+                                      (concat failing-case ", ")
+                                    "")
+                                  "%S should be `"
+                                  (symbol-name (car assertion))
+                                  "' to %S but isn't")
+                          (cadr assertion)
+                          (caddr assertion))
+                       (list failing-case)))
+           (error
+            (message "error executing %S, %S, %S" ',assertion ,failing-case
+                     err)))))
+
+(let* ((strings '("del-alist" "delay-mode-hooks" "delete" "delete*"
+		  "delete-and-extract-region" "delete-annotation"
+		  "delete-auto-save-file-if-necessary" "delete-backward-char"
+		  "delete-blank-lines" "delete-char"
+		  "delete-completion-window" "delete-console"
+		  "delete-debug-class-to-check" "delete-device"
+		  "delete-directory" "delete-duplicates" "delete-dups"
+		  "delete-extent" "delete-extract-rectangle" "delete-field"
+		  "delete-file" "delete-forward-p" "delete-frame"
+		  "delete-horizontal-space" "delete-if" "delete-if-not"
+		  "delete-indentation" "delete-itimer" "delete-matching-lines"
+		  "delete-menu-item" "delete-non-matching-lines"
+		  "delete-other-frames" "delete-other-windows"
+		  "delete-overlay" "delete-primary-selection" "delete-process"
+		  "delete-rectangle" "delete-region" "delete-selection-mode"
+		  "delete-text-in-column" "delete-to-left-margin"
+		  "delete-window" "delete-windows-on" "delq" "remote-compile"
+		  "remote-path-file-handler-function" "remove" "remove*"
+		  "remove-alist" "remove-char-table" "remove-database"
+		  "remove-directory" "remove-duplicates"
+		  "remove-face-property" "remove-from-invisibility-spec"
+		  "remove-glyph-property" "remove-gutter-element"
+		  "remove-hook" "remove-if" "remove-if-not"
+		  "remove-local-hook" "remove-message"
+		  "remove-progress-feedback" "remove-range-table"
+		  "remove-specifier"
+		  "remove-specifier-specs-matching-tag-set-cdrs"
+		  "remove-text-properties" "sublis"
+		  "submenu-generate-accelerator-spec" "subr-arity"
+		  "subr-interactive" "subr-max-args" "subr-min-args"
+		  "subr-name" "subregexp-context-p" "subrp" "subseq" "subsetp"
+		  "subsidiary-coding-system" "subst" "subst-char-in-region"
+		  "subst-char-in-string" "subst-if" "subst-if-not"
+		  "substitute" "substitute-command-keys" "substitute-env-vars"
+		  "substitute-if" "substitute-if-not"
+		  "substitute-in-file-name" "substitute-key-definition"
+		  "substring" "substring-no-properties" "subtract-time"
+		  "subwindow-height" "subwindow-image-instance-p"
+		  "subwindow-width" "subwindow-xid" "subwindowp"))
+       (list (let ((count -1))
+	       (mapcar #'(lambda (string)
+			   (incf count)
+			   (case (% count 3)
+			     (0 string)
+			     (1 (cons (make-symbol string) nil))
+			     (2 (cons string (make-symbol string))))) strings)))
+       (vector (loop
+		 for string in strings
+		 with vector = (make-vector 511 0)
+		 with count = -1
+		 with symbol = nil
+		 do
+		 (setq symbol (intern string vector)
+		       count (1+ count))
+		 (case (% count 3)
+		   (0 (set symbol nil))
+		   (1 (fset symbol (symbol-function 'ignore)))
+		   (2 (setf (symbol-plist symbol) 'hello)))
+		 finally return vector))
+       (init-hash-table
+        #'(lambda ()
+            (loop
+              for string in strings
+              with hash-table = (make-hash-table :test #'equal)
+              with count = -1
+              do
+              (incf count)
+              (case (% count 3)
+                (0 (setf (gethash (make-symbol string) hash-table)
+                         'hello))
+                (1 (setf (gethash string hash-table) 'everyone))
+                (2 (setf (gethash string hash-table) nil)))
+              finally return hash-table)))
+       (hash-table (funcall init-hash-table))
+       ;; The following three could be circular lists, but that's not
+       ;; portable to GNU.
+       (list-list (make-list (length strings) list))
+       (vector-list (make-list (length strings) vector))
+       (hash-table-list (make-list (length strings) hash-table))
+       scratch-hash-table cleared)
+  (macrolet
+      ((Assert-with-collections (assertion failing-case)
+         `(progn
+           (Assert ,(subst 'list 'collection assertion :test #'eq)
+                   ,(replace-regexp-in-string "collection" "list" failing-case))
+           (Assert ,(subst 'vector 'collection assertion :test #'eq)
+                   ,(replace-regexp-in-string "collection" "vector"
+                                              failing-case))
+           (Assert ,(subst 'hash-table 'collection assertion :test #'eq)
+                   ,(replace-regexp-in-string "collection" "hash-table"
+                                              failing-case)))))
+    ;; #'try-completion.
+    (Assert (every #'try-completion strings list-list)
+            "check #'try-completion gives no false negatives, list")
+    (Assert (every #'try-completion strings vector-list)
+            "check #'try-completion gives no false negatives, vector")
+    (Assert (every #'try-completion strings hash-table-list)
+            "check #'try-completion gives no false negatives, hash-table")
+    (Assert-with-collections
+     (null (try-completion "iX/ZXLwiOU+a " collection))
+     "check #'try-completion with no match, collection")
+    (Assert-with-collections
+     (eq t (try-completion "delq" collection))
+     "check #'try-completion with an exact match, collection")
+    (Assert-with-collections
+     (equal "delq"
+	    (let ((completion-ignore-case t))
+	      (try-completion "DElq" collection)))
+     "check #'try-completion with a case-insensitive match, collection")
+    (Assert-with-collections
+     (equal "del" (try-completion "de" collection))
+     "check #'try-completion where it needs to complete, collection")
+    (Assert (equal "del" (try-completion "de" list #'consp))
+	    "check #'try-completion, list, it needs to complete, predicate")
+    (Assert
+     (equal "del" (try-completion "de" vector #'fboundp))
+     "check #'try-completion, vector, it needs to complete, predicate")
+    (Assert
+     (equal "del" (try-completion "de" hash-table #'(lambda (key value)
+						      (eq 'everyone value))))
+     "check #'try-completion, hash-table, it needs to complete, predicate")
+    (Assert
+     ;; The actual result here is undefined, the important thing is we don't
+     ;; segfault.
+     (prog1
+         t
+       (try-completion "de"
+                       (setq cleared nil
+                             scratch-hash-table (funcall init-hash-table))
+                       #'(lambda (key value)
+                           (if cleared
+                               (eq 'everyone value)
+                             (clrhash scratch-hash-table)
+                             (garbage-collect)
+                             (setq cleared t)))))
+     "check #'try-completion doesn't crash when hash table modified")
+
+    ;; #'all-completions
+    (Assert (every #'all-completions strings list-list)
+            "check #'all-completions gives no false negatives, list")
+    (Assert (every #'all-completions strings vector-list)
+            "check #'all-completions gives no false negatives, vector")
+    (Assert (every #'all-completions strings hash-table-list)
+            "check #'all-completions gives no false negatives, hash-table")
+    (Assert-with-collections
+     (null (all-completions "iX/ZXLwiOU+a " collection))
+     "check #'all-completion with no match, collection")
+    (Assert-with-collections
+     (equal '("delq") (all-completions "delq" collection))
+     "check #'all-completions with an exact match, collection")
+    (Assert-with-collections
+     (equal '("delq") (let ((completion-ignore-case t))
+			(all-completions "dElQ" collection)))
+     "check #'all-completions with a case-insensitive match, collection")
+    (Assert
+     (equal
+      '("delay-mode-hooks" "delete-and-extract-region"
+        "delete-backward-char" "delete-completion-window" "delete-device"
+        "delete-dups" "delete-field" "delete-frame" "delete-if-not"
+        "delete-matching-lines" "delete-other-frames"
+        "delete-primary-selection" "delete-region" "delete-to-left-margin"
+        "delq")
+      (sort (all-completions "de" vector #'fboundp) #'string-lessp))
+     "check #'all-completions where it need to complete, vector")
+    (Assert
+     (eql (length (all-completions "de" hash-table #'(lambda (key value)
+                                                       (eq 'everyone value))))
+          15)
+     "check #'all-completions gives enough results with predicate, hash")
+    (Assert
+     (equal (sort
+             (all-completions
+              "de" list #'(lambda (object) (and (consp object)
+                                                (null (cdr object)))))
+             #'string-lessp)
+            (sort
+             (all-completions
+              "de" hash-table #'(lambda (key value)
+                                  (eq 'everyone value)))
+             #'string-lessp))
+     "check #'all-completion with complex predicates behaves well")
+    (Assert-with-collections
+     (equal (sort* (all-completions "" collection) #'string-lessp) strings)
+     "check #'all-completions, empty string, with collection")
+    (Assert
+     ;; The actual result here is undefined, the important thing is we don't
+     ;; segfault.
+     (prog1
+         t
+       (all-completions "de"
+                        (setq cleared nil
+                              scratch-hash-table (funcall init-hash-table))
+                        #'(lambda (key value)
+                            (if cleared
+                                (eq 'everyone value)
+                              (clrhash scratch-hash-table)
+                              (garbage-collect)
+                              (setq cleared t)))))
+     "check #'all-completions doesn't crash when hash table modified")
+    ;; #'test-completion
+    (Assert (every #'test-completion strings list-list)
+            "check #'test-completion gives no false negatives, list")
+    (Assert (every #'test-completion strings vector-list)
+            "check #'test-completion gives no false negatives, vector")
+    (Assert (every #'test-completion strings hash-table-list)
+            "check #'test-completion gives no false negatives, hash-table")
+    (Assert-with-collections
+     (null (test-completion "iX/ZXLwiOU+a " collection))
+     "check #'test-completion with no match, collection")
+    (Assert-with-collections
+     (eq t (test-completion "delq" collection))
+     "check #'test-completion with an exact match, collection")
+    (Assert-with-collections
+     (null (let (completion-ignore-case) (test-completion "DElq" collection)))
+     "check #'test-completion fails correctly if case-sensitive, collection")
+    (Assert-with-collections
+     (eq t (let ((completion-ignore-case t))
+             (test-completion "DElq" collection)))
+     "check #'test-completion with a case-insensitive match, collection")
+    (Assert-with-collections
+     (null (test-completion "de" collection))
+     "check #'test-completion gives nil if no exact match, collection")
+    (Assert (null (test-completion "de" list #'consp))
+	    "check #'test-completion, list, no exact match, predicate")
+    (Assert (eq t (test-completion "delete-matching-lines" list #'consp))
+	    "check #'test-completion, list, exact match, predicate")
+    (Assert (null (test-completion "de" vector #'fboundp))
+	    "check #'test-completion, vector, no exact match, predicate")
+    (Assert (eq t (test-completion "delete-to-left-margin" vector #'fboundp))
+	    "check #'test-completion, vector, exact match, predicate")
+    (Assert
+     (null (test-completion "de" hash-table #'(lambda (key value)
+                                                (eq 'everyone value))))
+     "check #'test-completion, hash-table, it needs to complete, predicate")
+    (Assert
+     (eq t (test-completion "delete-frame" hash-table
+                            #'(lambda (key value) (eq 'everyone value))))
+     "check #'test-completion, hash-table, exact match, predicate")
+    (Assert
+     ;; The actual result here is undefined, the important thing is we don't
+     ;; segfault.
+     (prog1
+         t
+       (test-completion "delete-frame"
+                        (setq cleared nil
+                              scratch-hash-table (funcall init-hash-table))
+                        #'(lambda (key value)
+                            (if cleared
+                                (eq 'everyone value)
+                              (clrhash scratch-hash-table)
+                              (garbage-collect)
+                              (setq cleared t)))))
+     "check #'all-completions doesn't crash when hash table modified")))
+