X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Futils%2Fhasktags%2FHaskTags.hs;h=f1840332d23cb19d1a15c84577fda15f3fe75a64;hb=0f0e83390daf09bceb7ed0be5b280f3c662c02a8;hp=de2dd4ebb9363543868b9ee1aa9c0c3537b51b50;hpb=b665000714d802f62d01d1183d92ade3e78476f6;p=ghc-hetmet.git

diff --git a/ghc/utils/hasktags/HaskTags.hs b/ghc/utils/hasktags/HaskTags.hs
index de2dd4e..f184033 100644
--- a/ghc/utils/hasktags/HaskTags.hs
+++ b/ghc/utils/hasktags/HaskTags.hs
@@ -3,6 +3,9 @@ import System
 import Char
 import List
 import IO
+import System.Environment
+import System.Console.GetOpt
+import System.Exit
 
 
 -- search for definitions of things 
@@ -21,15 +24,52 @@ import IO
 
 main :: IO ()
 main = do
-	filenames <- getArgs
+        progName <- getProgName
+	args <- getArgs
+        let usageString = "Usage: " ++ progName ++ " [OPTION...] [files...]"
+	let (modes, filenames, errs) = getOpt Permute options args
+	if errs /= [] || elem Help modes || filenames == []
+         then do
+           putStr $ unlines errs 
+	   putStr $ usageInfo usageString options
+	   exitWith (ExitFailure 1)
+         else return ()
+	let mode = getMode modes
 	filedata <- mapM findthings filenames
-	ctagsfile <- openFile "tags" WriteMode
-	etagsfile <- openFile "TAGS" WriteMode
-	writectagsfile ctagsfile filedata
-	writeetagsfile etagsfile filedata
-	hClose ctagsfile
-	hClose etagsfile
-	
+        if mode == BothTags || mode == CTags
+         then do 
+           ctagsfile <- openFile "tags" WriteMode
+	   writectagsfile ctagsfile filedata
+           hClose ctagsfile
+         else return ()
+	if mode == BothTags || mode == ETags 
+         then do
+           etagsfile <- openFile "TAGS" WriteMode
+	   writeetagsfile etagsfile filedata
+           hClose etagsfile
+         else return ()
+
+-- | getMode takes a list of modes and extract the mode with the
+--   highest precedence.  These are as follows: Both, CTags, ETags
+--   The default case is Both.
+getMode :: [Mode] -> Mode
+getMode [] = BothTags
+getMode [x] = x
+getMode (x:xs) = max x (getMode xs)
+
+
+data Mode = ETags | CTags | BothTags | Help deriving (Ord, Eq, Show)
+
+options :: [OptDescr Mode]
+options = [ Option "c" ["ctags"]
+	    (NoArg CTags) "generate CTAGS file (ctags)"
+	  , Option "e" ["etags"]
+	    (NoArg ETags) "generate ETAGS file (etags)"
+	  , Option "b" ["both"]
+	    (NoArg BothTags) ("generate both CTAGS and ETAGS")
+	  , Option "h" ["help"] (NoArg Help) "This help"
+	  ]
+
 type FileName = String
 
 type ThingName = String
@@ -103,6 +143,9 @@ spacedwords xs = (blanks ++ wordchars):(spacedwords rest2)
 findthings :: FileName -> IO FileData
 findthings filename = do
 	text <- readFile filename
+        evaluate text -- forces evaluation of text
+                      -- too many files were being opened otherwise since
+                      -- readFile is lazy
 	let aslines = lines text
 	let wordlines = map words aslines
 	let noslcoms = map stripslcomments wordlines
@@ -110,6 +153,8 @@ findthings filename = do
 					aslines [0 ..]
 	let nocoms = stripblockcomments tokens
 	return $ FileData filename $ findstuff nocoms
+  where evaluate [] = return ()
+        evaluate (c:cs) = c `seq` evaluate cs
 	
 -- Create tokens from words, by recording their line number
 -- and which token they are through that line