mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

tweak

Browse source
This commit is contained in:
Joey Hess 2011-02-08 18:26:38 -04:00
parent c1b69d1511
commit 81e045a539
2 changed files with 3 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
Command/Map.hs
View file

@ -100,7 +100,7 @@ nodeId r =
node :: (M.Map UUID String) -> [Git.Repo] -> Git.Repo -> String node :: (M.Map UUID String) -> [Git.Repo] -> Git.Repo -> String
node umap fullinfo r = unlines $ n:edges node umap fullinfo r = unlines $ n:edges
where where
n = Dot.subGraph (hostname r) (basehostname r) "grey" $ n = Dot.subGraph (hostname r) (basehostname r) "lightblue" $
decorate $ Dot.graphNode (nodeId r) (repoName umap r) decorate $ Dot.graphNode (nodeId r) (repoName umap r)
edges = map (edge umap fullinfo r) (Git.remotes r) edges = map (edge umap fullinfo r) (Git.remotes r)
decorate decorate

2
Dot.hs
View file

@ -45,6 +45,7 @@ subGraph :: String -> String -> String -> String -> String
subGraph subid l color s = subGraph subid l color s =
"subgraph " ++ name ++ " {\n" ++ "subgraph " ++ name ++ " {\n" ++
ii setlabel ++ ii setlabel ++
ii setfilled ++
ii setcolor ++ ii setcolor ++
ii s ++ ii s ++
indent "}" indent "}"
@ -52,6 +53,7 @@ subGraph subid l color s =
-- the "cluster_" makes dot draw a box -- the "cluster_" makes dot draw a box
name = quote ("cluster_" ++ subid) name = quote ("cluster_" ++ subid)
setlabel = "label=" ++ quote l setlabel = "label=" ++ quote l
setfilled = "style=" ++ quote "filled"
setcolor = "fillcolor=" ++ quote color setcolor = "fillcolor=" ++ quote color
ii x = (indent $ indent x) ++ "\n" ii x = (indent $ indent x) ++ "\n"