From 4f2765f6f1a2cc6da408e3c5ff99ea5f8756bad4 Mon Sep 17 00:00:00 2001
From: Colin Woodbury <colin@fosskers.ca>
Date: Wed, 30 Jun 2021 14:07:29 +0200
Subject: [PATCH] Add new function file-name-with-extension

* doc/lispref/files.texi (File Name Components): Document it.
* lisp/emacs-lisp/shortdoc.el (file-name): Ditto.

* lisp/files.el (file-name-with-extension): New function.
---
 doc/lispref/files.texi      | 19 +++++++++++++++++++
 etc/NEWS                    |  5 +++++
 lisp/emacs-lisp/shortdoc.el |  3 +++
 lisp/files.el               | 21 +++++++++++++++++++++
 test/lisp/files-tests.el    | 18 ++++++++++++++++++
 5 files changed, 66 insertions(+)

diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index 2033177fbb0..dd9ce2cd011 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -2129,6 +2129,25 @@ the period that delimits the extension, and if @var{filename} has no
 extension, the value is @code{""}.
 @end defun
 
+@defun file-name-with-extension filename extension
+This function returns @var{filename} with its extension set to
+@var{extension}.  A single leading dot in the @var{extension} will be
+stripped if there is one.  For example:
+
+@example
+(file-name-with-extension "file" "el")
+     @result{} "file.el"
+(file-name-with-extension "file" ".el")
+     @result{} "file.el"
+(file-name-with-extension "file.c" "el")
+     @result{} "file.el"
+@end example
+
+Note that this function will error if @var{filename} or
+@var{extension} are empty, or if the @var{filename} is shaped like a
+directory (i.e. if @code{directory-name-p} returns non-@code{nil}).
+@end defun
+
 @defun file-name-sans-extension filename
 This function returns @var{filename} minus its extension, if any.  The
 version/backup part, if present, is only removed if the file has an
diff --git a/etc/NEWS b/etc/NEWS
index b9a9369049a..6345992dfe1 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -3058,6 +3058,11 @@ been added, and takes a callback to handle the return status.
 ---
 ** 'ascii' is now a coding system alias for 'us-ascii'.
 
++++
+** New function 'file-name-with-extension'.
+This function allows a canonical way to set/replace the extension of a
+filename string.
+
 +++
 ** New function 'file-backup-file-names'.
 This function returns the list of file names of all the backup files
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
index 4ff7cee623c..4df404015a0 100644
--- a/lisp/emacs-lisp/shortdoc.el
+++ b/lisp/emacs-lisp/shortdoc.el
@@ -268,6 +268,9 @@ There can be any number of :example/:result elements."
    :eval (file-name-extension "/tmp/foo.txt"))
   (file-name-sans-extension
    :eval (file-name-sans-extension "/tmp/foo.txt"))
+  (file-name-with-extension
+   :eval (file-name-with-extension "foo.txt" "bin")
+   :eval (file-name-with-extension "foo" "bin"))
   (file-name-base
    :eval (file-name-base "/tmp/foo.txt"))
   (file-relative-name
diff --git a/lisp/files.el b/lisp/files.el
index 04db0faffd0..39f4ca65b1d 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -4894,6 +4894,27 @@ extension, the value is \"\"."
         (if period
             "")))))
 
+(defun file-name-with-extension (filename extension)
+  "Set the EXTENSION of a FILENAME.
+The extension (in a file name) is the part that begins with the last \".\".
+
+Trims a leading dot from the EXTENSION so that either \"foo\" or
+\".foo\" can be given.
+
+Errors if the filename or extension are empty, or if the given
+filename has the format of a directory.
+
+See also `file-name-sans-extension'."
+  (let ((extn (string-trim-left extension "[.]")))
+    (cond ((string-empty-p filename)
+           (error "Empty filename: %s" filename))
+          ((string-empty-p extn)
+           (error "Malformed extension: %s" extension))
+          ((directory-name-p filename)
+           (error "Filename is a directory: %s" filename))
+          (t
+           (concat (file-name-sans-extension filename) "." extn)))))
+
 (defun file-name-base (&optional filename)
   "Return the base name of the FILENAME: no directory, no extension."
   (declare (advertised-calling-convention (filename) "27.1"))
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index dc96dff6398..257cbc2d329 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -1478,5 +1478,23 @@ The door of all subtleties!
                                (buffer-substring (point-min) (point-max))
                                nil nil)))))
 
+(ert-deftest files-tests-file-name-with-extension-good ()
+  "Test that `file-name-with-extension' succeeds with reasonable input."
+  (should (string= (file-name-with-extension "Jack" "css") "Jack.css"))
+  (should (string= (file-name-with-extension "Jack" ".css") "Jack.css"))
+  (should (string= (file-name-with-extension "Jack.scss" "css") "Jack.css"))
+  (should (string= (file-name-with-extension "/path/to/Jack.md" "org") "/path/to/Jack.org")))
+
+(ert-deftest files-tests-file-name-with-extension-bad ()
+  "Test that `file-name-with-extension' fails on malformed input."
+  (should-error (file-name-with-extension nil nil))
+  (should-error (file-name-with-extension "Jack" nil))
+  (should-error (file-name-with-extension nil "css"))
+  (should-error (file-name-with-extension "" ""))
+  (should-error (file-name-with-extension "" "css"))
+  (should-error (file-name-with-extension "Jack" ""))
+  (should-error (file-name-with-extension "Jack" "."))
+  (should-error (file-name-with-extension "/is/a/directory/" "css")))
+
 (provide 'files-tests)
 ;;; files-tests.el ends here
-- 
2.39.2