diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -4,7 +4,7 @@ Usage ----- -Cgrep 6.4.21 Usage: cgrep [OPTION] [PATTERN] files... +Cgrep 6.4.22 Usage: cgrep [OPTION] [PATTERN] files... cgrep [OPTIONS] [ITEM] diff --git a/cgrep.cabal b/cgrep.cabal --- a/cgrep.cabal +++ b/cgrep.cabal @@ -1,6 +1,6 @@ Name: cgrep Description: Cgrep: a context-aware grep for source codes -Version: 6.4.21 +Version: 6.4.22 Synopsis: Command line tool Homepage: http://awgn.github.io/cgrep/ License: GPL-2 diff --git a/src/CGrep/CGrep.hs b/src/CGrep/CGrep.hs --- a/src/CGrep/CGrep.hs +++ b/src/CGrep/CGrep.hs @@ -34,7 +34,7 @@ hasLanguage :: FilePath -> Options -> [Lang] -> Bool -hasLanguage path opt xs = isJust $ getLang opt path >>= (`elemIndex` xs) +hasLanguage path opt xs = isJust $ getFileLang opt path >>= (`elemIndex` xs) sanitizeOptions :: FilePath -> Options -> Options diff --git a/src/CGrep/Lang.hs b/src/CGrep/Lang.hs --- a/src/CGrep/Lang.hs +++ b/src/CGrep/Lang.hs @@ -16,7 +16,7 @@ -- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -module CGrep.Lang (Lang(..), langMap, getLang, splitLangList, +module CGrep.Lang (Lang(..), langMap, getFileLang, splitLangList, dumpLangMap, dumpLangRevMap) where import qualified Data.Map as Map @@ -91,8 +91,8 @@ -- utility functions -lookupLang :: FilePath -> Maybe Lang -lookupLang f = Map.lookup (Name $ takeFileName f) langRevMap <|> Map.lookup (Ext (let name = takeExtension f in case name of ('.':xs) -> xs; _ -> name )) langRevMap +lookupFileLang :: FilePath -> Maybe Lang +lookupFileLang f = Map.lookup (Name $ takeFileName f) langRevMap <|> Map.lookup (Ext (let name = takeExtension f in case name of ('.':xs) -> xs; _ -> name )) langRevMap forcedLang :: Options -> Maybe Lang @@ -101,8 +101,8 @@ | otherwise = Map.lookup (Ext $ fromJust l) langRevMap <|> Map.lookup (Name $ fromJust l) langRevMap -getLang :: Options -> FilePath -> Maybe Lang -getLang opts f = forcedLang opts <|> lookupLang f +getFileLang :: Options -> FilePath -> Maybe Lang +getFileLang opts f = forcedLang opts <|> lookupFileLang f dumpLangMap :: LangMapType -> IO () diff --git a/src/CGrep/Strategy/BoyerMoore.hs b/src/CGrep/Strategy/BoyerMoore.hs --- a/src/CGrep/Strategy/BoyerMoore.hs +++ b/src/CGrep/Strategy/BoyerMoore.hs @@ -62,7 +62,7 @@ -- context filter - let text'' = contextFilter (getLang opt filename) (mkContextFilter opt) text' + let text'' = contextFilter (getFileLang opt filename) (mkContextFilter opt) text' -- expand multi-line diff --git a/src/CGrep/Strategy/Cpp/Semantic.hs b/src/CGrep/Strategy/Cpp/Semantic.hs --- a/src/CGrep/Strategy/Cpp/Semantic.hs +++ b/src/CGrep/Strategy/Cpp/Semantic.hs @@ -80,7 +80,7 @@ -- context filter - let text'' = contextFilter (getLang opt filename) filt text' + let text'' = contextFilter (getFileLang opt filename) filt text' -- expand multi-line diff --git a/src/CGrep/Strategy/Cpp/Tokenizer.hs b/src/CGrep/Strategy/Cpp/Tokenizer.hs --- a/src/CGrep/Strategy/Cpp/Tokenizer.hs +++ b/src/CGrep/Strategy/Cpp/Tokenizer.hs @@ -57,7 +57,7 @@ -- context filter - let text'' = contextFilter (getLang opt filename) filt text' + let text'' = contextFilter (getFileLang opt filename) filt text' -- expand multi-line diff --git a/src/CGrep/Strategy/Generic/Semantic.hs b/src/CGrep/Strategy/Generic/Semantic.hs --- a/src/CGrep/Strategy/Generic/Semantic.hs +++ b/src/CGrep/Strategy/Generic/Semantic.hs @@ -52,7 +52,7 @@ -- pre-process patterns - patterns = map (Generic.tokenizer . contextFilter (getLang opt filename) filt) ps -- [ [t1,t2,..], [t1,t2...] ] + patterns = map (Generic.tokenizer . contextFilter (getFileLang opt filename) filt) ps -- [ [t1,t2,..], [t1,t2...] ] patterns' = map (map mkWildCardFromToken) patterns -- [ [w1,w2,..], [w1,w2,..] ] patterns'' = map (combineMultiCard . map (:[])) patterns' -- [ [m1,m2,..], [m1,m2,..] ] == [[[w1], [w2],..], [[w1],[w2],..]] @@ -80,7 +80,7 @@ -- context filter - let text'' = contextFilter (getLang opt filename) filt text' + let text'' = contextFilter (getFileLang opt filename) filt text' -- expand multi-line diff --git a/src/CGrep/Strategy/Levenshtein.hs b/src/CGrep/Strategy/Levenshtein.hs --- a/src/CGrep/Strategy/Levenshtein.hs +++ b/src/CGrep/Strategy/Levenshtein.hs @@ -39,7 +39,7 @@ -- transform text - let text' = ignoreCase opt . contextFilter (getLang opt filename) (mkContextFilter opt) $ text + let text' = ignoreCase opt . contextFilter (getFileLang opt filename) (mkContextFilter opt) $ text text'' = expandMultiline opt text' diff --git a/src/CGrep/Strategy/Regex.hs b/src/CGrep/Strategy/Regex.hs --- a/src/CGrep/Strategy/Regex.hs +++ b/src/CGrep/Strategy/Regex.hs @@ -47,7 +47,7 @@ -- context filter - text'' = contextFilter (getLang opt filename) (mkContextFilter opt) text' + text'' = contextFilter (getFileLang opt filename) (mkContextFilter opt) text' -- expand multi-line diff --git a/src/Config.hs b/src/Config.hs --- a/src/Config.hs +++ b/src/Config.hs @@ -31,7 +31,7 @@ cgreprc = "cgreprc" version :: String -version = "6.4.21" +version = "6.4.22" data Config = Config diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -56,29 +56,26 @@ import qualified Data.ByteString.Char8 as C + -- push file names in Chan... -putRecursiveContents :: Options -> TChan (Maybe FilePath) -> FilePath -> [Lang] -> [String] -> Set.Set FilePath -> IO () -putRecursiveContents opts inchan topdir langs prunedir visited = do - dir <- doesDirectoryExist topdir - if dir - then do - names <- liftM (filter (`notElem` [".", ".."])) $ getDirectoryContents topdir - forM_ names $ \n -> E.catch ( do - let path = topdir n - let filename = takeFileName path - cpath <- canonicalizePath path - status <- getFileStatus path +withRecursiveContents :: Options -> FilePath -> [Lang] -> [String] -> Set.Set FilePath -> (FilePath -> IO ()) -> IO () +withRecursiveContents opts dir langs prunedir visited action = do + isDir <- doesDirectoryExist dir + if isDir then do + names <- liftM (filter (`notElem` [".", ".."])) $ getDirectoryContents dir + forM_ names $ \n -> E.catch (do + let path = dir n + filename = takeFileName path + fstatus <- getFileStatus path lstatus <- getSymbolicLinkStatus path - unless (cpath `Set.member` visited) $ - if isDirectory status && (not (isSymbolicLink lstatus) || deference_recursive opts) - then unless (filename `elem` prunedir) $ - putRecursiveContents opts inchan path langs prunedir (Set.insert cpath visited) - else case getLang opts filename >>= (\f -> f `elemIndex` langs <|> toMaybe 0 (null langs) ) of - Nothing -> return () - _ -> atomically $ writeTChan inchan (Just path) - ) (\e -> let msg = show (e :: SomeException) in hPutStrLn stderr ("cgrep: " ++ msg)) - else atomically $ writeTChan inchan (Just topdir) + if isDirectory fstatus && (deference_recursive opts || not (isSymbolicLink lstatus)) + then unless (filename `elem` prunedir) $ do -- this is a good directory (unless already visited)! + cpath <- canonicalizePath path + unless (cpath `Set.member` visited) $ withRecursiveContents opts path langs prunedir (Set.insert cpath visited) action + else unless (isNothing $ getFileLang opts filename >>= (\f -> f `elemIndex` langs <|> toMaybe 0 (null langs))) $ action path + ) (\e -> let msg = show (e :: SomeException) in hPutStrLn stderr ("Cgrep: " ++ msg)) + else action dir -- read patterns from file @@ -115,7 +112,7 @@ Nothing -> atomically $ writeTChan out_chan [] Just x -> do out <- let op = sanitizeOptions x opts in - liftM (take (max_count opts)) $ cgrepDispatch op x op patterns $ guard (x /= "") >> f + liftM (take (max_count opts)) $ cgrepDispatch op x op patterns $ guard (x /= "") >> f unless (null out) $ atomically $ writeTChan out_chan out ) (\e -> let msg = show (e :: SomeException) in hPutStrLn stderr (showFile opts (fromMaybe "" f) ++ ": exception: " ++ if length msg > 80 then take 80 msg ++ "..." else msg)) @@ -127,10 +124,8 @@ _ <- forkIO $ do if recursive opts || deference_recursive opts - then - forM_ (if null paths then ["."] else paths) $ \p -> putRecursiveContents opts in_chan p langs (configPruneDirs conf) (Set.singleton p) - else - forM_ (if null paths && not isTermIn then [""] else paths) (atomically . writeTChan in_chan . Just) + then forM_ (if null paths then ["."] else paths) $ \p -> withRecursiveContents opts p langs (configPruneDirs conf) (Set.singleton p) (atomically . writeTChan in_chan . Just) + else forM_ (if null paths && not isTermIn then [""] else paths) (atomically . writeTChan in_chan . Just) -- enqueue EOF messages: