Re: [PATCH] lisp/files.el: Add `file-name-set-extension`

["Colin Woodbury" <colin@fosskers.ca>]

[-- Attachment #1.1: Type: text/plain, Size: 555 bytes --]

Good catch Michael, thank you, I had completely forgotten about Windows.  I've updated the patch.

Cheers,
Colin

On Thu, 10 Jun 2021, at 00:46, Michael Albinus wrote:
> "Colin Woodbury" <colin@fosskers.ca <mailto:colin%40fosskers.ca>> writes:
> 
> > Hi all,
> 
> Hi Colin,
> 
> > +          ((equal ?/ (string-to-char (substring file -1))) (error "Filename is a directory: %s" filename))
> 
> This shall be (directory-name-p file) . You cannot assume that ?/ is
> always the directory separator, for example on MS Windows.
> 
> Best regards, Michael.
> 

[-- Attachment #1.2: Type: text/html, Size: 1074 bytes --]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: file-name-with-extension.patch --]
[-- Type: text/x-patch; name="file-name-with-extension.patch", Size: 2625 bytes --]

diff --git a/lisp/files.el b/lisp/files.el
index 2450daf5bf..5fb9b9dcdc 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -4892,6 +4892,20 @@ extension, the value is \"\"."
         (if period
             "")))))
 
+(defun file-name-with-extension (filename extension)
+  "Set the EXTENSION of a FILENAME.
+Consolidates leading/trailing dots so that either `foo' or `.foo'
+can be passed as an EXTENSION.
+
+See also `file-name-sans-extension'."
+  (let* ((patt "[ .]+")
+         (file (string-trim-right filename patt))
+         (extn (string-trim-left extension patt)))
+    (cond ((string-empty-p file) (error "Malformed filename: %s" filename))
+          ((string-empty-p extn) (error "Malformed extension: %s" extension))
+          ((directory-name-p file) (error "Filename is a directory: %s" filename))
+          (t (concat (file-name-sans-extension file) "." 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 dc96dff639..80f47a78dc 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -1478,5 +1478,25 @@ 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 "Jack..." "...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 "..." "css"))
+  (should-error (file-name-with-extension "/is/a/directory/" "css")))
+
 (provide 'files-tests)
 ;;; files-tests.el ends here