diff --git a/lisp/files.el b/lisp/files.el index 2450daf5bf..ad04386cc2 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)) + ((equal ?/ (string-to-char (substring file -1))) (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