5 files changed, 80 insertions, 1 deletions

diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index 9d73aa89b2d..066bfc79718 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -965,6 +965,9 @@ too short).  Both of those begin with the string @samp{foobar}.
      @result{} "foobar"
 @end group
 @end smallexample
+
+  See also the function @code{string-common-prefix} in
+@ref{Creating Strings}.
 @end defun
 
 @defun all-completions string collection &optional predicate
diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi
index 44be529d562..caa29747ff5 100644
--- a/doc/lispref/strings.texi
+++ b/doc/lispref/strings.texi
@@ -248,6 +248,43 @@ equivalent to 0.  Thus, @w{@code{(substring-no-properties
 properties removed.
 @end defun
 
+@cindex common prefix of a collection of strings
+@cindex string completion
+@defun string-common-prefix strings &optional ignore-case
+This function returns the longest initial substring common to all
+members of @var{strings}.  It returns an empty string if there is no
+common prefix or if @var{strings} is @code{nil}.  If @var{strings}
+contains exactly one string, it returns that string.
+
+@example
+(string-common-prefix '("foobar" "foozot"))
+     @result{} "foo"
+(string-common-prefix '("foobar" "foozot" "gazonk"))
+     @result{} ""
+(string-common-prefix '("foobar"))
+     @result{} "foobar"
+@end example
+
+If @var{ignore-case} is non-@code{nil}, letter case is ignored when
+matching the substrings, but no guarantee is made about the letter-case
+of the return value, except that it comes from one of the members of
+@var{strings}.
+
+@var{strings} may be a list of strings or any other collection type
+supported by @code{try-completion} and @code{all-completions}
+(@pxref{Basic Completion}).  This function is similar to
+@code{try-completion}, but always returns a string.  The filtering
+features of the completion functions (by string prefix, regular
+expression, and predicate function) are available using
+@code{all-completions}:
+
+@example
+(string-common-prefix (all-completions
+                       "foo" '("foobar" "foobaz" "gazonk")))
+     @result{} "fooba"
+@end example
+@end defun
+
 @defun concat &rest sequences
 @cindex copying strings
 @cindex concatenating strings
diff --git a/etc/NEWS b/etc/NEWS
index 2cb1978738e..256c8ab139d 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -3879,6 +3879,12 @@ It offers a more concise way to create a completion table with metadata.
 ** 'all-completions' and 'unintern' no longer support old calling conventions.
 
 +++
+** New function 'string-common-prefix'.
+Return the longest common prefix from a collection of strings.  This
+function is similar to 'try-completion', but it returns a string in all
+cases.
+
++++
 ** New symbol property 'find-function-type-alist' used by 'find-function' etc.
 Macros that define an object in a way that makes the object's name and
 the macro call site defining the object hard to associate can add an
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
index 70583e08dbd..af15d15523d 100644
--- a/lisp/emacs-lisp/shortdoc.el
+++ b/lisp/emacs-lisp/shortdoc.el
@@ -385,8 +385,15 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'),
    :eval (reverse "foo"))
   (substring-no-properties
    :eval (substring-no-properties (propertize "foobar" 'face 'bold) 0 3))
+  (string-common-prefix
+   :eval (string-common-prefix '("foobar" "foozot"))
+   :eval (string-common-prefix '("foobar" "foozot" "gazonk"))
+   :eval (string-common-prefix nil))
   (try-completion
-   :eval (try-completion "foo" '("foobar" "foozot" "gazonk")))
+   :eval (try-completion "f" '("foobar" "foozot" "gazonk"))
+   :eval (try-completion "f" '("foo"))
+   :eval (try-completion "foo" '("foo"))
+   :eval (try-completion "foo" nil))
   "Unicode Strings"
   (string-glyph-split
    :eval (string-glyph-split "Hello, 👼🏻🧑🏼‍🤝‍🧑🏻"))
diff --git a/lisp/subr.el b/lisp/subr.el
index d307a07f05b..a5191ba74f3 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -6129,6 +6129,32 @@ attention to letter-case differences."
          (eq t (compare-strings suffix nil nil
                                 string start-pos nil ignore-case)))))
 
+(defun string-common-prefix (strings &optional ignore-case)
+  "Return the longest common prefix from a collection of STRINGS.
+
+Return \"\" if there is no common prefix or if STRINGS is nil.
+If STRINGS contains exactly one string, return that string.
+
+If IGNORE-CASE is non-nil, letter case is ignored when matching the
+substrings, but no guarantee is made about the letter-case of the return
+value, except that it comes from one of the members of STRINGS.
+
+STRINGS may be a list of strings or any other collection type supported
+by `try-completion' and `all-completions' (which see).  To find the
+common prefix of a subset of STRINGS (filtered by string prefix, regular
+expression, or predicate function), use `all-completions' to perform the
+filtering and pass the result to `string-common-prefix' as STRINGS."
+  ;; Note that `try-completion' is not affected by `completion-styles'.
+  (let* ((completion-ignore-case ignore-case)
+         (completion-regexp-list nil)
+         (prefix (try-completion "" strings)))
+    (if (stringp prefix)
+        prefix
+      ;; nil means there was no match.
+      ;; t means that the "" argument was an exact match.
+      ;; We always return a string, so we treat both cases the same.
+      "")))
+
 (defun bidi-string-mark-left-to-right (str)
   "Return a string that can be safely inserted in left-to-right text.