Commit f96c7c1a authored by simonmar's avatar simonmar
Browse files

[project @ 2005-06-13 14:12:59 by simonmar]

Implement :tags command

Patch supplied by Claus Reinke, with some modifications by me.
Ideally we'd like this to be a command line option too, and we'd like
to drop the restriction that all the source files must be interpreted,
but that needs some work elsewhere (interface files have to store
definition source locations).
parent 7004f764
......@@ -22,6 +22,12 @@ import GHC ( Session, verbosity, dopt, DynFlag(..),
CheckedModule(..) )
import Outputable
-- for createtags (should these come via GHC?)
import Module( moduleUserString )
import Name( nameSrcLoc, nameModule, nameOccName )
import OccName( pprOccName )
import SrcLoc( isGoodSrcLoc, srcLocFile, srcLocLine, srcLocCol )
-- following all needed for :info... ToDo: remove
import IfaceSyn ( IfaceDecl(..), IfaceClassOp(..), IfaceConDecls(..),
IfaceConDecl(..), IfaceType,
......@@ -38,11 +44,10 @@ import Config
import StaticFlags ( opt_IgnoreDotGhci )
import Linker ( showLinkerState )
import Util ( removeSpaces, handle, global, toArgs,
looksLikeModuleName, prefixMatch )
looksLikeModuleName, prefixMatch, sortLe )
import ErrUtils ( printErrorsAndWarnings )
#ifndef mingw32_HOST_OS
import Util ( handle )
import System.Posix
#if __GLASGOW_HASKELL__ > 504
hiding (getEnv)
......@@ -110,6 +115,7 @@ builtin_commands = [
("check", keepGoing checkModule),
("set", keepGoing setCmd),
("show", keepGoing showCmd),
("tags", keepGoing createTagsFileCmd),
("type", keepGoing typeOfExpr),
("kind", keepGoing kindOfType),
("unset", keepGoing unsetOptions),
......@@ -147,6 +153,7 @@ helpText =
" :show modules show the currently loaded modules\n" ++
" :show bindings show the current bindings made at the prompt\n" ++
"\n" ++
" :tags -e|-c create tags file for Vi (-c) or Emacs (-e)\n" ++
" :type <expr> show the type of <expr>\n" ++
" :kind <type> show the kind of <type>\n" ++
" :undef <cmd> undefine user-defined command :<cmd>\n" ++
......@@ -476,9 +483,6 @@ specialCommand str = do
foldr1 (\a b -> a ++ ',':b) (map fst cs)
++ ")") >> return False)
noArgs c = throwDyn (CmdLineError ("command '" ++ c ++ "' takes no arguments"))
-----------------------------------------------------------------------------
-- To flush buffers for the *interpreted* computation we need
-- to refer to *its* stdout/stderr handles
......@@ -839,6 +843,114 @@ quit _ = return True
shellEscape :: String -> GHCi Bool
shellEscape str = io (system str >> return False)
-----------------------------------------------------------------------------
-- create tags file for currently loaded modules.
createTagsFileCmd :: String -> GHCi ()
createTagsFileCmd "-c" = ghciCreateTagsFile CTags "tags"
createTagsFileCmd "-e" = ghciCreateTagsFile ETags "TAGS"
createTagsFileCmd _ = throwDyn (CmdLineError "syntax: :tags -c|-e")
data TagsKind = ETags | CTags
ghciCreateTagsFile :: TagsKind -> FilePath -> GHCi ()
ghciCreateTagsFile kind file = do
session <- getSession
io $ createTagsFile session kind file
-- ToDo:
-- - remove restriction that all modules must be interpreted
-- (problem: we don't know source locations for entities unless
-- we compiled the module.
--
-- - extract createTagsFile so it can be used from the command-line
-- (probably need to fix first problem before this is useful).
--
createTagsFile :: Session -> TagsKind -> FilePath -> IO ()
createTagsFile session tagskind tagFile = do
graph <- GHC.getModuleGraph session
let ms = map GHC.ms_mod graph
tagModule m = do
is_interpreted <- GHC.moduleIsInterpreted session m
-- should we just skip these?
when (not is_interpreted) $
throwDyn (CmdLineError ("module '" ++ moduleUserString m ++ "' is not interpreted"))
mbModInfo <- GHC.getModuleInfo session m
let unqual
| Just modinfo <- mbModInfo,
Just unqual <- GHC.modInfoPrintUnqualified modinfo = unqual
| otherwise = GHC.alwaysQualify
case mbModInfo of
Just modInfo -> return $! listTags unqual modInfo
_ -> return []
mtags <- mapM tagModule ms
either_res <- collateAndWriteTags tagskind tagFile $ concat mtags
case either_res of
Left e -> hPutStrLn stderr $ ioeGetErrorString e
Right _ -> return ()
listTags :: PrintUnqualified -> GHC.ModuleInfo -> [TagInfo]
listTags unqual modInfo =
[ tagInfo unqual name loc
| name <- GHC.modInfoExports modInfo
, let loc = nameSrcLoc name
, isGoodSrcLoc loc
]
type TagInfo = (String -- tag name
,String -- file name
,Int -- line number
,Int -- column number
)
-- get tag info, for later translation into Vim or Emacs style
tagInfo :: PrintUnqualified -> Name -> SrcLoc -> TagInfo
tagInfo unqual name loc
= ( showSDocForUser unqual $ pprOccName (nameOccName name)
, showSDocForUser unqual $ ftext (srcLocFile loc)
, srcLocLine loc
, srcLocCol loc
)
collateAndWriteTags :: TagsKind -> FilePath -> [TagInfo] -> IO (Either IOError ())
collateAndWriteTags CTags file tagInfos = do -- ctags style, Vim et al
let tags = unlines $ sortLe (<=) $ nub $ map showTag tagInfos
IO.try (writeFile file tags)
collateAndWriteTags ETags file tagInfos = do -- etags style, Emacs/XEmacs
let byFile op (_,f1,_,_) (_,f2,_,_) = f1 `op` f2
groups = groupBy (byFile (==)) $ sortLe (byFile (<=)) tagInfos
tagGroups <- mapM tagFileGroup groups
IO.try (writeFile file $ concat tagGroups)
where
tagFileGroup group@[] = throwDyn (CmdLineError "empty tag file group??")
tagFileGroup group@((_,fileName,_,_):_) = do
file <- readFile fileName -- need to get additional info from sources..
let byLine (_,_,l1,_) (_,_,l2,_) = l1 <= l2
sortedGroup = sortLe byLine group
tags = unlines $ perFile sortedGroup 1 0 $ lines file
return $ "\x0c\n" ++ fileName ++ "," ++ show (length tags) ++ "\n" ++ tags
perFile (tagInfo@(tag,file,lNo,colNo):tags) count pos (line:lines) | lNo>count =
perFile (tagInfo:tags) (count+1) (pos+length line) lines
perFile (tagInfo@(tag,file,lNo,colNo):tags) count pos lines@(line:_) | lNo==count =
showETag tagInfo line pos : perFile tags count pos lines
perFile tags count pos lines = []
-- simple ctags format, for Vim et al
showTag :: TagInfo -> String
showTag (tag,file,lineNo,colNo)
= tag ++ "\t" ++ file ++ "\t" ++ show lineNo
-- etags format, for Emacs/XEmacs
showETag :: TagInfo -> String -> Int -> String
showETag (tag,file,lineNo,colNo) line charPos
= take colNo line ++ tag
++ "\x7f" ++ tag
++ "\x01" ++ show lineNo
++ "," ++ show charPos
-----------------------------------------------------------------------------
-- Browsing a module's contents
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment