From dd3c90bf1182fd94039e26ccb1853daddaa3beeb Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Thu, 30 Jul 2009 20:58:32 -0500
Subject: [PATCH] add file-stem word to io.pathnames as the counterpart to
 file-extension. write docs for both

---
 core/io/pathnames/pathnames-docs.factor | 20 ++++++++++++++++++++
 core/io/pathnames/pathnames.factor      |  5 ++++-
 2 files changed, 24 insertions(+), 1 deletion(-)

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 )