diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 3bbd68bdcd..e609aa7405 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -8266,9 +8266,11 @@ message-completion-alist
 (defcustom message-expand-name-databases
   '(bbdb eudc)
   "List of databases to try for name completion (`message-expand-name').
-Each element is a symbol and can be `bbdb' or `eudc'."
+Each element can be the symbol `bbdb', the symbol `eudc', or a function."
   :group 'message
-  :type '(set (const bbdb) (const eudc)))
+  :version "29.1"
+  :type '(repeat
+          (choice (const bbdb) (const eudc) function)))
 
 (defcustom message-tab-body-function nil
   "Function to execute when `message-tab' (TAB) is executed in the body.
@@ -8379,6 +8381,8 @@ message-expand-name
                ;; completion took place.  So let's double check the buffer was
                ;; not modified.
                (/= starttick (buffer-modified-tick)))))
+        ((and (functionp (car message-expand-name-databases))
+              (funcall (car message-expand-name-databases))))
 	(t
 	 (expand-abbrev))))
 
@@ -8408,26 +8412,28 @@ message--bbdb-query-with-words
 
 (defun message--name-table (orig-string)
   (let ((orig-words (split-string orig-string "[ \t]+"))
-        eudc-responses
-        bbdb-responses)
+        database-responses)
     (lambda (string pred action)
       (pcase action
         ('metadata '(metadata (category . email)))
         ('lambda t)
         ((or 'nil 't)
          (when orig-words
-           (when (and (memq 'eudc message-expand-name-databases)
-		      (boundp 'eudc-protocol)
-		      eudc-protocol)
-	     (setq eudc-responses (eudc-query-with-words orig-words)))
-	   (when (memq 'bbdb message-expand-name-databases)
-	     (setq bbdb-responses (message--bbdb-query-with-words orig-words)))
+           (dolist (db message-expand-name-databases)
+             (push
+              (pcase db
+                ((and `eudc (guard (bound-and-true-p eudc-protocol)))
+                 (eudc-query-with-words orig-words))
+                (`bbdb (message--bbdb-query-with-words orig-words))
+                ((pred functionp) (funcall db orig-words)))
+              database-responses))
 	   (ecomplete-setup)
 	   (setq orig-words nil))
          (let ((candidates
 	        ;; FIXME: Add `expand-abbrev'!
-	        (append (all-completions string eudc-responses pred)
-	                (all-completions string bbdb-responses pred)
+	        (append (mapcan (lambda (resp)
+                                  (all-completions string resp pred))
+                                database-responses)
 	                (when (and (bound-and-true-p ecomplete-database)
 	                           (fboundp 'ecomplete-completion-table))
                           (all-completions string