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

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

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

Hi all, thanks for the input. I've revised the patch to account for empty strings and for filenames that look like directories (i.e. that end in a slash).

I've also begun the copyright assignment process, since adding the unit tests lengthened the patch past the critical line count.

As for the naming of `set-extension`, the best I can think of as an alternative would be `with-extension` as a dual to `sans-extension`, although I think `set` still signals the intent well enough. I'll defer to others here.

Cheers,
Colin

On Fri, 4 Jun 2021, at 06:23, Mattias Engdegård wrote:
> 4 juni 2021 kl. 15.08 skrev Philipp <p.stephani2@gmail.com <mailto:p.stephani2%40gmail.com>>:
> 
> > Likewise, change the docstring to clarify that a new string is returned.
> 
> Actually we usually don't bother saying that a function creates a new string unless this is guaranteed and somehow important, since we don't encourage string mutation anyway. For example, functions are usually allowed to return an unchanged argument string if that would make sense.
> 
> Conversely, only functions that do mutate strings need to mention that fact. By default, a user should be able to assume that no string mutation takes place.
> 
> I fully agree with the rest of Philipp's excellent points.
> 
> 

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

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

diff --git a/lisp/files.el b/lisp/files.el
index 2450daf5bf..f37264d7d5 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -4892,6 +4892,18 @@ extension, the value is \"\"."
         (if period
             "")))))
 
+(defun file-name-set-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."
+  (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..92bbd95eaf 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-set-extension-good ()
+  "Test that `file-name-set-extension' succeeds with reasonable input."
+  (should (string= (file-name-set-extension "Jack" "css") "Jack.css"))
+  (should (string= (file-name-set-extension "Jack" ".css") "Jack.css"))
+  (should (string= (file-name-set-extension "Jack.scss" "css") "Jack.css"))
+  (should (string= (file-name-set-extension "Jack..." "...css") "Jack.css"))
+  (should (string= (file-name-set-extension "/path/to/Jack.md" "org") "/path/to/Jack.org")))
+
+(ert-deftest files-tests-file-name-set-extension-bad ()
+  "Test that `file-name-set-extension' fails on malformed input."
+  (should-error (file-name-set-extension nil nil))
+  (should-error (file-name-set-extension "Jack" nil))
+  (should-error (file-name-set-extension nil "css"))
+  (should-error (file-name-set-extension "" ""))
+  (should-error (file-name-set-extension "" "css"))
+  (should-error (file-name-set-extension "Jack" ""))
+  (should-error (file-name-set-extension "Jack" "..."))
+  (should-error (file-name-set-extension "..." "css"))
+  (should-error (file-name-set-extension "/is/a/directory/" "css")))
+
 (provide 'files-tests)
 ;;; files-tests.el ends here