1{- | Editor integration. -}
2
3-- {-# LANGUAGE OverloadedStrings #-}
4
5module Hledger.UI.Editor (
6   -- TextPosition
7   endPosition
8  ,runEditor
9  ,runIadd
10  )
11where
12
13import Control.Applicative ((<|>))
14import Safe
15import System.Environment
16import System.Exit
17import System.FilePath
18import System.Process
19
20import Hledger
21
22-- | A position we can move to in a text editor: a line and optional column number.
23-- Line number 1 or 0 means the first line. A negative line number means the last line.
24type TextPosition = (Int, Maybe Int)
25
26-- | The text position meaning "last line, first column".
27endPosition :: Maybe TextPosition
28endPosition = Just (-1,Nothing)
29
30-- | Run the hledger-iadd executable on the given file, blocking until it exits,
31-- and return the exit code; or raise an error.
32-- hledger-iadd is an alternative to the built-in add command.
33runIadd :: FilePath -> IO ExitCode
34runIadd f = runCommand ("hledger-iadd -f " ++ f) >>= waitForProcess
35
36-- | Run the user's preferred text editor (or try a default editor),
37-- on the given file, blocking until it exits, and return the exit
38-- code; or raise an error. If a text position is provided, the editor
39-- will be focussed at that position in the file, if we know how.
40runEditor :: Maybe TextPosition -> FilePath -> IO ExitCode
41runEditor mpos f = editFileAtPositionCommand mpos f >>= runCommand >>= waitForProcess
42
43-- | Get a shell command line to open the user's preferred text editor
44-- (or a default editor) on the given file, and to focus it at the
45-- given text position if one is provided and if we know how.
46-- We know how to focus on position for: emacs, vi, nano.
47-- We know how to focus on last line for: vi.
48--
49-- Some tests: With line and column numbers specified,
50-- @
51-- if EDITOR is:  the command should be:
52-- -------------  -----------------------------------
53-- notepad        notepad FILE
54-- vi             vi +LINE FILE
55--                vi + FILE                                    # negative LINE
56-- emacs          emacs +LINE:COL FILE
57--                emacs FILE                                   # negative LINE
58-- (unset)        emacsclient -a '' -nw +LINE:COL FILE
59--                emacsclient -a '' -nw FILE                   # negative LINE
60-- @
61--
62-- How to open editors at the last line of a file:
63-- @
64-- emacs:       emacs FILE -f end-of-buffer
65-- emacsclient: can't
66-- vi:          vi + FILE
67-- @
68--
69editFileAtPositionCommand :: Maybe TextPosition -> FilePath -> IO String
70editFileAtPositionCommand mpos f = do
71  let f' = singleQuoteIfNeeded f
72  editcmd <- getEditCommand
73  let editor = lowercase $ takeFileName $ headDef "" $ words' editcmd
74  let positionarg =
75        case mpos of
76          Just (l, mc)
77            | editor `elem` [
78                "ex",
79                "vi","vim","view","nvim","evim","eview",
80                "gvim","gview","rvim","rview","rgvim","rgview"
81                ] -> plusAndMaybeLine l mc
82          Just (l, mc)
83            | editor `elem` ["emacs", "emacsclient"] -> plusLineAndMaybeColonColumnOrEnd l mc
84          Just (l, mc)
85            | editor `elem` ["nano"] -> plusLineAndMaybeCommaColumn l mc
86          _ -> ""
87        where
88          plusAndMaybeLine            l _  = "+" ++ if l >= 0 then show l else ""
89          plusLineAndMaybeCommaColumn l mc = "+" ++ show l ++ maybe "" ((","++).show) mc
90          plusLineAndMaybeColonColumnOrEnd l mc
91            | l >= 0    = "+" ++ show l ++ maybe "" ((":"++).show) mc
92            | otherwise = ""
93            -- otherwise = "-f end-of-buffer"
94            -- XXX Problems with this:
95            -- it must appear after the filename, whereas +LINE:COL must appear before
96            -- it works only with emacs, not emacsclient
97  return $ unwords [editcmd, positionarg, f']
98
99-- | Get the user's preferred edit command. This is the value of the
100-- $HLEDGER_UI_EDITOR environment variable, or of $EDITOR, or a
101-- default ("emacsclient -a '' -nw", which starts/connects to an emacs
102-- daemon in terminal mode).
103getEditCommand :: IO String
104getEditCommand = do
105  hledger_ui_editor_env <- lookupEnv "HLEDGER_UI_EDITOR"
106  editor_env            <- lookupEnv "EDITOR"
107  let Just cmd = hledger_ui_editor_env <|> editor_env <|> Just "emacsclient -a '' -nw"
108  return cmd
109
110