procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add `file-name-set-extension'

Browse source 
* lisp/files.el (file-name-with-extension): New defun.

* test/lisp/files-tests.el (files-tests-file-name-with-extension-good)
(files-tests-file-name-with-extension-bad): New tests.
This commit is contained in:
Michael Albinus 2021-06-19 11:10:46 +02:00
parent e6a700a28e
commit 4f1a5e456e
2 changed files with 34 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
lisp/files.el
View file

@ -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"))

20
test/lisp/files-tests.el
View file

@ -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