X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=utils%2Fhasktags%2FHaskTags.hs;h=a27752e55a8b012c6da7d8fd417ca166f97e8784;hb=a966047ca5c407f336a633d716d3d7b5ed29d231;hp=f1840332d23cb19d1a15c84577fda15f3fe75a64;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git

diff --git a/utils/hasktags/HaskTags.hs b/utils/hasktags/HaskTags.hs
index f184033..a27752e 100644
--- a/utils/hasktags/HaskTags.hs
+++ b/utils/hasktags/HaskTags.hs
@@ -1,5 +1,4 @@
 module Main where
-import System
 import Char
 import List
 import IO
@@ -34,17 +33,20 @@ main = do
 	   putStr $ usageInfo usageString options
 	   exitWith (ExitFailure 1)
          else return ()
-	let mode = getMode modes
+        let mode = getMode (Append `delete` modes)
+        let openFileMode = if elem Append modes
+			   then AppendMode
+			   else WriteMode
 	filedata <- mapM findthings filenames
         if mode == BothTags || mode == CTags
          then do 
-           ctagsfile <- openFile "tags" WriteMode
+           ctagsfile <- openFile "tags" openFileMode
 	   writectagsfile ctagsfile filedata
            hClose ctagsfile
          else return ()
 	if mode == BothTags || mode == ETags 
          then do
-           etagsfile <- openFile "TAGS" WriteMode
+           etagsfile <- openFile "TAGS" openFileMode
 	   writeetagsfile etagsfile filedata
            hClose etagsfile
          else return ()
@@ -58,7 +60,7 @@ getMode [x] = x
 getMode (x:xs) = max x (getMode xs)
 
 
-data Mode = ETags | CTags | BothTags | Help deriving (Ord, Eq, Show)
+data Mode = ETags | CTags | BothTags | Append | Help deriving (Ord, Eq, Show)
 
 options :: [OptDescr Mode]
 options = [ Option "c" ["ctags"]
@@ -67,6 +69,8 @@ options = [ Option "c" ["ctags"]
 	    (NoArg ETags) "generate ETAGS file (etags)"
 	  , Option "b" ["both"]
 	    (NoArg BothTags) ("generate both CTAGS and ETAGS")
+	  , Option "a" ["append"]
+	    (NoArg Append) ("append to existing CTAGS and/or ETAGS file(s)")
 	  , Option "h" ["help"] (NoArg Help) "This help"
 	  ]
 
@@ -142,20 +146,34 @@ 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
-	let tokens = concat $ zipWith3 (withline filename) noslcoms 
-					aslines [0 ..]
-	let nocoms = stripblockcomments tokens
-	return $ FileData filename $ findstuff nocoms
+    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 mywords aslines
+    let noslcoms = map stripslcomments wordlines
+    let tokens = concat $ zipWith3 (withline filename) noslcoms aslines [0 ..]
+    let nocoms = stripblockcomments tokens
+    return $ FileData filename $ findstuff nocoms
   where evaluate [] = return ()
         evaluate (c:cs) = c `seq` evaluate cs
-	
+        -- my words is mainly copied from Data.List.
+        -- difference abc::def is split into three words instead of one.
+        -- We should really be lexing Haskell properly here rather
+        -- than using hacks like this. In the future we expect hasktags
+        -- to be replaced by something using the GHC API.
+        mywords :: String -> [String]
+        mywords (':':':':xs) = "::" : mywords xs
+        mywords s =  case dropWhile isSpace s of
+                         "" -> []
+                         s' -> w : mywords s''
+                             where (w, s'') = myBreak s'
+                                   myBreak [] = ([],[])
+                                   myBreak (':':':':xs) = ([], "::"++xs)
+                                   myBreak (' ':xs) = ([],xs);
+                                   myBreak (x:xs) = let (a,b) = myBreak xs
+                                                    in  (x:a,b)
 -- Create tokens from words, by recording their line number
 -- and which token they are through that line