hat-2.9.0.0: tools/SrcRefViewer.hs

-- Simple program to display a src reference.
-- Reports the filename and location, and shows a section of the file
-- with the cursor on the actual location.  We try to place the
-- important line as near the centre of the screen as possible.

module Main where

import System.Environment (getProgName, getArgs)
import System.Process (system)
import System.Exit    (exitWith, ExitCode(..))
import System.IO      (hSetBuffering,BufferMode(..),stdin,stdout)
import Data.Char      (isSpace,isDigit)
import Run            (runAndReadStdout)
import HighlightStyle (getTerminalSize,cls,goto,highlight,lineWrap
                      ,Highlight(..),Colour(..))

main = do
    args <- System.Environment.getArgs
    case args of
      [filename,sline,scol] ->
              let line = (read sline)::Int
                  column = (read scol)::Int in
              display filename line column 0 0
      [filename,sline,scol,sline2,scol2] ->
              let line = (read sline)::Int
                  column = (read scol)::Int
                  endline = (read sline2)::Int
                  endcolumn = (read scol2)::Int in
              display filename line column endline endcolumn
      _ -> do prog <- System.Environment.getProgName
              putStrLn ("Usage: "++prog++" srcfile line col [endline endcol]")
              exitWith (ExitFailure 1)

display :: FilePath -> Int -> Int -> Int -> Int -> IO ()
display srcfile line column endline endcolumn = do
    len <- runAndReadStdout ("wc -l "++srcfile)
    let n = read (takeWhile isDigit (dropWhile isSpace len))
    case n of
      0 -> do putStrLn ("File "++srcfile++" not found.")
              exitWith (ExitFailure 1)
      _ -> do (width,height) <- getTerminalSize
              f <- readFile srcfile
              hSetBuffering stdin NoBuffering
              hSetBuffering stdout NoBuffering
              let middle= (height `div` 2) - 1
                  trim  = if line < middle then 0 else line - middle
                  fs    = (expandTabs . unlines . take (height-2)
                          . drop trim . lines) f
                  line' = line-trim
                  (a,b,c) = split (line',column,endline-trim,endcolumn) fs
              putStr (cls ++ goto 1 1 ++ lineWrap False)
              putStr (highlight [Bold] ("---- "++srcfile++" ---- line: "
                                       ++show line++" ---- column: "
                                       ++show column++" ----"))
              if endline==0
                then putStr (goto 1 2 ++ fs ++ goto column (line'+1))
                else putStr (goto 1 2 ++ a
                             ++ highlight [Bold, Foreground Magenta] b ++ c
                             ++ goto column (line'+1))
              system ("stty -icanon min 1 -echo")
              awaitQuit
              system ("stty icanon echo")
              putStr (goto 1 height)
              return ()

split :: (Int,Int,Int,Int) -> String -> (String,String,String)
split (sl,sc,el,ec) str
  | sl==el    =
    let (a,b) = splitAt (el-1) (lines str)
        (c,d) = splitAt ec (head b)
        (e,f) = splitAt (sc-1) c
    in (unlines a++e, f, unlines (d:tail b))
  | otherwise =
    let ls = lines str
        (a,b)   = splitAt (el-1) (lines str)
        (a',b') = splitAt  ec    (head b)
        (p,q)   = splitAt (sl-1) a
        (p',q') = splitAt (sc-1) (head q)
    in (unlines p++p', unlines (q':tail q)++a', unlines (b':tail b))

awaitQuit :: IO ()
awaitQuit = do
  q <- getChar
  case q of
    'q' -> return ()
    'x' -> return ()
    _   -> awaitQuit

expandTabs :: String -> String
expandTabs = expand 0
  where expand n []         = []
        expand n ('\n':xs)  = '\n': expand 0 xs
        expand 8 ('\t':xs)  = replicate 8     ' ' ++ expand 0 xs
        expand n ('\t':xs)  = replicate (8-n) ' ' ++ expand 0 xs
        expand 8 (x:xs)     = x : expand 1 xs
        expand n (x:xs)     = x : expand (n+1) xs