diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 33c5e2cedb..3a8e3f6e0f 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -7929,24 +7929,33 @@ message-make-tool-bar
 				    'message-mode-map))))
   message-tool-bar-map)
 
-;;; Group name completion.
+;;; Group and mail name completion.
 
 (defcustom message-newgroups-header-regexp
   "^\\(Newsgroups\\|Followup-To\\|Posted-To\\|Gcc\\):"
-  "Regexp that match headers that lists groups."
+  "Regexp matching headers that list groups."
   :group 'message
   :type 'regexp)
 
+(defcustom message-mail-header-regexp
+  (concat
+   "^"
+   (regexp-opt
+    '("To" "Bcc" "Cc" "Resent-To" "Resent-Bcc" "Resent-Cc"
+      "Reply-To" "From" "Mail-Followup-To" "Mail-Copies-To"
+      "Disposition-Notification-To" "Return-Receipt-To"))
+   ":")
+  "Regexp matching headers that list name/mail addresses."
+  :group 'message
+  :type 'regexp
+  :version "27.1")
+
 (defcustom message-completion-alist
-  ;; FIXME: Make it possible to use the standard completion UI.
-  (list (cons message-newgroups-header-regexp 'message-expand-group)
-	'("^\\(Resent-\\)?\\(To\\|B?Cc\\):" . message-expand-name)
-	'("^\\(Reply-To\\|From\\|Mail-Followup-To\\|Mail-Copies-To\\):"
-	  . message-expand-name)
-	'("^\\(Disposition-Notification-To\\|Return-Receipt-To\\):"
-	  . message-expand-name))
-  "Alist of (RE . FUN).  Use FUN for completion on header lines matching RE."
-  :version "22.1"
+  (list (cons message-newgroups-header-regexp #'message-expand-group)
+	(cons message-mail-header-regexp #'message-expand-name))
+  "Alist of (RE . FUN).
+Use FUN for completion on header lines matching RE."
+  :version "27.1"
   :group 'message
   :type '(alist :key-type regexp :value-type function))
 
@@ -7956,6 +7965,19 @@ message-expand-name-databases
 Each element is a symbol and can be `bbdb' or `eudc'."
   :group 'message
   :type '(set (const bbdb) (const eudc)))
+(make-obsolete-variable
+ 'message-expand-name-databases
+ "Add completion tables to `message-expand-name-tables' instead"
+ "27.1")
+
+(defcustom message-expand-name-tables nil
+  "List of tables that can be used to expand names.
+Each \"table\" is a collection containing potential expansions,
+and can be an alist, a plain list, a hash table, an obarray, or a
+function.  Multiple tables will be merged."
+  :group 'message
+  :version "27.1"
+  :type 'list)
 
 (defcustom message-tab-body-function nil
   "Function to execute when `message-tab' (TAB) is executed in the body.
@@ -7982,24 +8004,16 @@ message-tab
    (message-tab-body-function (funcall message-tab-body-function))
    (t (funcall (or (lookup-key text-mode-map "\t")
                    (lookup-key global-map "\t")
-                   'indent-relative)))))
+                   #'indent-relative)))))
 
 (defvar mail-abbrev-mode-regexp)
 
-(defun message-completion-function ()
-  (let ((alist message-completion-alist))
-    (while (and alist
-		(let ((mail-abbrev-mode-regexp (caar alist)))
-		  (not (mail-abbrev-in-expansion-header-p))))
-      (setq alist (cdr alist)))
-    (when (cdar alist)
-      (let ((fun (cdar alist)))
-        ;; Even if completion fails, return a non-nil value, so as to avoid
-        ;; falling back to message-tab-body-function.
-        (lambda () (funcall fun) 'completion-attempted)))))
+(defvar message--old-style-completion-functions nil)
 
-(defun message-expand-group ()
-  "Expand the group name under point."
+(defsubst message-header-completion-bounds ()
+  "Return the bounds of header input for completion.
+Searches back for either the end of header or the nearest comma,
+and forward for either the nearest comma or EOL."
   (let ((b (save-excursion
 	     (save-restriction
 	       (narrow-to-region
@@ -8009,36 +8023,57 @@ message-expand-group
 		  (1+ (point)))
 		(point))
 	       (skip-chars-backward "^, \t\n") (point))))
-	(completion-ignore-case t)
-	(e (progn (skip-chars-forward "^,\t\n ") (point)))
-	group collection)
-    (when (and (boundp 'gnus-active-hashtb)
-	       gnus-active-hashtb)
-      (mapatoms
-       (lambda (symbol)
-	 (setq group (symbol-name symbol))
-	 (push (if (string-match "[^\000-\177]" group)
-		   (gnus-group-decoded-name group)
-		 group)
-	       collection))
-       gnus-active-hashtb))
-    (completion-in-region b e collection)))
+	(e (progn (skip-chars-forward "^,\t\n ") (point))))
+    (cons b e)))
+
+(defun message-completion-function ()
+  "Possibly complete a group name or mail address.
+Check if point is in an appropriate header for completion,
+otherwise return nil."
+  (let ((alist message-completion-alist))
+    (while (and alist
+		(let ((mail-abbrev-mode-regexp (caar alist)))
+		  (not (mail-abbrev-in-expansion-header-p))))
+      (setq alist (cdr alist)))
+    (when (cdar alist)
+      (let ((fun (cdar alist))
+	    (completion-ignore-case t))
+	(if (member fun message--old-style-completion-functions)
+	    ;; Even if completion fails, return a non-nil value, so as to avoid
+	    ;; falling back to message-tab-body-function.
+	    (lambda () (funcall fun) 'completion-attempted)
+	  (let ((ticks-before (buffer-chars-modified-tick))
+		(data (funcall fun)))
+	    (if (and (eq ticks-before (buffer-chars-modified-tick))
+		     (or (null data)
+			 (integerp (car-safe data))))
+		data
+	      (push fun message--old-style-completion-functions)
+	      ;; Completion was already performed, so just return a dummy
+	      ;; function that prevents trying any further.
+	      (lambda () 'completion-attempted))))))))
+
+(defun message-expand-group ()
+  "Return group completion from `gnus-active-hashtb'."
+  (pcase-let ((`(,b . ,e) (message-header-completion-bounds)))
+    (let (collection group)
+     (when (and (boundp 'gnus-active-hashtb)
+		gnus-active-hashtb)
+       (mapatoms
+	(lambda (symbol)
+	  (setq group (symbol-name symbol))
+	  (push (if (string-match "[^\000-\177]" group)
+		    (gnus-group-decoded-name group)
+		  group)
+		collection))
+	gnus-active-hashtb)
+       (list b e collection)))))
 
 (defun message-expand-name ()
-  (cond ((and (memq 'eudc message-expand-name-databases)
-		    (boundp 'eudc-protocol)
-		    eudc-protocol)
-	 (eudc-expand-inline))
-	((and (memq 'bbdb message-expand-name-databases)
-	      (fboundp 'bbdb-complete-name))
-         (let ((starttick (buffer-modified-tick)))
-           (or (bbdb-complete-name)
-               ;; Apparently, bbdb-complete-name can return nil even when
-               ;; completion took place.  So let's double check the buffer was
-               ;; not modified.
-               (/= starttick (buffer-modified-tick)))))
-	(t
-	 (expand-abbrev))))
+  (pcase-let ((`(,b . ,e) (message-header-completion-bounds)))
+    (when message-expand-name-tables
+      (list b e (apply #'completion-table-in-turn
+		       message-expand-name-tables)))))
 
 ;;; Help stuff.