From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Colin Woodbury Newsgroups: gmane.emacs.devel Subject: Re: master 4f1a5e4: Add `file-name-set-extension' Date: Sat, 26 Jun 2021 11:26:46 -0700 Message-ID: <871r8oscrd.fsf@fosskers.ca> References: <20210619091053.4521.94680@vcs0.savannah.gnu.org> <20210619091054.A82BE20B76@vcs0.savannah.gnu.org> <87pmwi2ibz.fsf@gnus.org> <87k0mqhx91.fsf@gmx.de> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="26510"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: mu4e 1.4.15; emacs 28.0.50 Cc: Lars Ingebrigtsen , emacs-devel@gnu.org To: Michael Albinus Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Sat Jun 26 20:27:33 2021 Return-path: Envelope-to: ged-emacs-devel@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1lxD1f-0006fo-Jz for ged-emacs-devel@m.gmane-mx.org; Sat, 26 Jun 2021 20:27:31 +0200 Original-Received: from localhost ([::1]:57054 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lxD1d-00027L-HY for ged-emacs-devel@m.gmane-mx.org; Sat, 26 Jun 2021 14:27:29 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:37074) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lxD13-0001Rb-IZ for emacs-devel@gnu.org; Sat, 26 Jun 2021 14:26:53 -0400 Original-Received: from out5-smtp.messagingengine.com ([66.111.4.29]:43345) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lxD11-0007XS-5e for emacs-devel@gnu.org; Sat, 26 Jun 2021 14:26:53 -0400 Original-Received: from compute5.internal (compute5.nyi.internal [10.202.2.45]) by mailout.nyi.internal (Postfix) with ESMTP id CA3885C00C6; Sat, 26 Jun 2021 14:26:48 -0400 (EDT) Original-Received: from mailfrontend2 ([10.202.2.163]) by compute5.internal (MEProxy); Sat, 26 Jun 2021 14:26:48 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=fosskers.ca; h= references:from:to:cc:subject:in-reply-to:date:message-id :mime-version:content-type; s=fm1; bh=BOCOG8OfeVaaEng9V0KUn1Yh9d 9Ty2iw+dUgvrLoIkM=; b=xe/jhF8yJJno3dsdAY20q3dPyWsLs1db7Er+atJJ8T REquvgzCU/iqFQvokKiZXRwgEGDlsa5d34/xtPEgwHkzwh/hpNAXwYlYZIzF+fIP Dq3DoME5aaCEujJ3DZklLsnppVfCDnKmceuoWR9W9fLwA00HjVDskc+ef97w4W1k 929TA/xw8qcYfxRZ+oCw+yDw/EQK1jFzyo53LIdluCPtLSMzy78xkVsGP0DqolMX C4p7NzcP/lE+Ivm5LCwYlAp+Sp8vt3YrEsou8KOcc1BcF75H5S5BqGEuSlPtP8WP TLbL78xhXaSCXYwvvtsWIiGIlEnSE2q6fQ5oqCaWvUaA== DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d= messagingengine.com; h=cc:content-type:date:from:in-reply-to :message-id:mime-version:references:subject:to:x-me-proxy :x-me-proxy:x-me-sender:x-me-sender:x-sasl-enc; s=fm3; bh=BOCOG8 OfeVaaEng9V0KUn1Yh9d9Ty2iw+dUgvrLoIkM=; b=l9+EhtKV9Fc9thCmxSQiVN j28+EvBWsVrZ0ct79tIduqTjpUF29Cv5TpKRaI/DAsgZBRBBjF8EyMQcj8xz8dK/ cvM/Lplv1dPMDmac9jrPLhqR52RRmb7PsNlFZyw/j7TP2tb/Myv84zcJ1pllPggA jr6MPitMS78ZlwFQsEjc7+dZhONIzNvFzR0xVq9yJFF3Zv2iv0W5IkIOa0sZKgqB vjVwFhQAsXWfK3PCiPd2/sqdc9ZKo/Cnkp3sQVeKQBlpkGPp7ND8bCPYwc1SY2Bl jR/uXdq3ljPB/jBO2eJtQan7MsOvS9kbaHrjaLnEZzmGCoL7+kndY6mUxW+7fnig == X-ME-Sender: X-ME-Received: X-ME-Proxy-Cause: gggruggvucftvghtrhhoucdtuddrgeduledrfeehtddguddvtdcutefuodetggdotefrod ftvfcurfhrohhfihhlvgemucfhrghsthforghilhdpqfgfvfdpuffrtefokffrpgfnqfgh necuuegrihhlohhuthemuceftddtnecusecvtfgvtghiphhivghnthhsucdlqddutddtmd enucfjughrpehffgfhvffujgffkfggtgesmhdtreertdertdenucfhrhhomhepveholhhi nhcuhghoohgusghurhihuceotgholhhinhesfhhoshhskhgvrhhsrdgtrgeqnecuggftrf grthhtvghrnhepgffhgefhvdfgleelfefgheejfeeugeeukedtgfekudekkeevvefguedv tdefteejnecuvehluhhsthgvrhfuihiivgeptdenucfrrghrrghmpehmrghilhhfrhhomh eptgholhhinhesfhhoshhskhgvrhhsrdgtrg X-ME-Proxy: Original-Received: by mail.messagingengine.com (Postfix) with ESMTPA; Sat, 26 Jun 2021 14:26:47 -0400 (EDT) In-reply-to: <87k0mqhx91.fsf@gmx.de> Received-SPF: none client-ip=66.111.4.29; envelope-from=colin@fosskers.ca; helo=out5-smtp.messagingengine.com X-Spam_score_int: -27 X-Spam_score: -2.8 X-Spam_bar: -- X-Spam_report: (-2.8 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, RCVD_IN_DNSWL_LOW=-0.7, RCVD_IN_MSPIKE_H4=0.001, RCVD_IN_MSPIKE_WL=0.001, SPF_HELO_PASS=-0.001, SPF_NONE=0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.23 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.io gmane.emacs.devel:271035 Archived-At: --=-=-= Content-Type: text/plain Hi gentlemen, Lars brought up some excellent points, so I did a survey of other languages to see what they expect/permit: | Language | Forgives dot? | Scrutinizes ext? | Handles directories? | |----------+---------------+------------------+----------------------| | Rust | No | No | No | | Python | "Yes" | "Yes" | No | | Haskell | Yes | No | No | Rust allows everything, including setting the extension of a directory, the result of which then returns `false` for `is_dir()`. Python throws an exception if the passed extension doesn't begin with a dot, but otherwise allows anything else in the filename or extension. Haskell allows the "dot or not" trick that I had adopted in my patches, but otherwise doesn't scrutinize the contents of the filename or extension. I also looked at Golang, but it was just raw string manipulation with no extra helper functions. And given that my FS seems to accept spaces in both filenames and their extensions without issue, I've landed on the following logic: - DO allow the passing of an optionally dotted extension, like Haskell. - DO only strip a single dot. - DO check if the filename is empty or shaped like a directory name. - DON'T otherwise care about the contents of the filename or extension. I've attached a revised patch that accounts for these. And for Michael, I made sure to add the texinfo docs and NEWS entry. Cheers! Colin --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=file-name-with-extension.patch diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 2033177fbb..8096c9e861 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -2129,6 +2129,24 @@ 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 exmaple, + +@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 the @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 @code{t}). + @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 60226f0a3e..9838693a65 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2964,6 +2964,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/files.el b/lisp/files.el index 2450daf5bf..a5ac1821b2 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -4892,6 +4892,22 @@ extension, the value is \"\"." (if period ""))))) +(defun file-name-with-extension (filename extension) + "Set the EXTENSION of a FILENAME. + +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 dc96dff639..257cbc2d32 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 --=-=-=--