diff --git a/core/io/pathnames/pathnames-docs.factor b/core/io/pathnames/pathnames-docs.factor index 733283d298..63a905d578 100644 --- a/core/io/pathnames/pathnames-docs.factor +++ b/core/io/pathnames/pathnames-docs.factor @@ -23,6 +23,24 @@ HELP: file-name { $example "USING: io.pathnames prettyprint ;" "\"/usr/libexec/awk/\" file-name ." "\"awk\"" } } ; +HELP: file-extension +{ $values { "path" "a pathname string" } { "extension" string } } +{ $description "Outputs the extension of " { $snippet "path" } ", or " { $link f } " if the filename has no extension." } +{ $examples + { $example "USING: io.pathnames prettyprint ;" "\"/usr/bin/gcc\" file-extension ." "f" } + { $example "USING: io.pathnames prettyprint ;" "\"/home/csi/gui.vbs\" file-extension ." "\"vbs\"" } +} ; + +HELP: file-stem +{ $values { "path" "a pathname string" } { "stem" string } } +{ $description "Outputs the " { $link file-name } " of " { $snippet "filename" } " with the file extension removed, if any." } +{ $examples + { $example "USING: io.pathnames prettyprint ;" "\"/usr/bin/gcc\" file-stem ." "\"gcc\"" } + { $example "USING: io.pathnames prettyprint ;" "\"/home/csi/gui.vbs\" file-stem ." "\"gui\"" } +} ; + +{ file-name file-stem file-extension } related-words + HELP: path-components { $values { "path" "a pathnames string" } { "seq" sequence } } { $description "Splits a pathname on the " { $link path-separator } " into its its component strings." } ; @@ -86,6 +104,8 @@ ARTICLE: "io.pathnames" "Pathname manipulation" "Pathname manipulation:" { $subsection parent-directory } { $subsection file-name } +{ $subsection file-stem } +{ $subsection file-extension } { $subsection last-path-separator } { $subsection path-components } { $subsection prepend-path } diff --git a/core/io/pathnames/pathnames.factor b/core/io/pathnames/pathnames.factor index 30e9e6c206..6a49ed5797 100644 --- a/core/io/pathnames/pathnames.factor +++ b/core/io/pathnames/pathnames.factor @@ -118,7 +118,10 @@ PRIVATE> ] if ] unless ; -: file-extension ( filename -- extension ) +: file-stem ( path -- stem ) + file-name "." split1-last drop ; + +: file-extension ( path -- extension ) file-name "." split1-last nip ; : path-components ( path -- seq )