Documentation for editFileAtPositionCommand is made more precise. This commit makes it possible for hledger-ui to open a file at the last line on emacs and kakoune. It also prevents hledger-ui from opening an editor with imprecise arguments. Passing imprecise arguments to editors can cause undefined behaviors in editors. I tested it with emacs(client), nano, vscode, kakoune, nvim, and vis.
		
			
				
	
	
		
			136 lines
		
	
	
		
			5.5 KiB
		
	
	
	
		
			Haskell
		
	
	
	
	
	
			
		
		
	
	
			136 lines
		
	
	
		
			5.5 KiB
		
	
	
	
		
			Haskell
		
	
	
	
	
	
| {- | Editor integration. -}
 | |
| 
 | |
| module Hledger.UI.Editor (
 | |
|    -- TextPosition
 | |
|    endPosition
 | |
|   ,runEditor
 | |
|   ,runIadd
 | |
|   )
 | |
| where
 | |
| 
 | |
| import Control.Applicative ((<|>))
 | |
| import Data.List (intercalate)
 | |
| import Data.Maybe (catMaybes)
 | |
| import Data.Bifunctor (bimap)
 | |
| import Safe
 | |
| import System.Environment
 | |
| import System.Exit
 | |
| import System.FilePath
 | |
| import System.Process
 | |
| 
 | |
| import Hledger
 | |
| 
 | |
| -- | A position we can move to in a text editor: a line and optional column number.
 | |
| -- Line number 1 or 0 means the first line. A negative line number means the last line.
 | |
| type TextPosition = (Int, Maybe Int)
 | |
| 
 | |
| -- | The text position meaning "last line, first column".
 | |
| endPosition :: Maybe TextPosition
 | |
| endPosition = Just (-1, Nothing)
 | |
| 
 | |
| -- | Run the hledger-iadd executable on the given file, blocking until it exits,
 | |
| -- and return the exit code; or raise an error.
 | |
| -- hledger-iadd is an alternative to the built-in add command.
 | |
| runIadd :: FilePath -> IO ExitCode
 | |
| runIadd f = runCommand ("hledger-iadd -f " ++ f) >>= waitForProcess
 | |
| 
 | |
| -- | Run the user's preferred text editor (or try a default editor),
 | |
| -- on the given file, blocking until it exits, and return the exit
 | |
| -- code; or raise an error. If a text position is provided, the editor
 | |
| -- will be focussed at that position in the file, if we know how.
 | |
| runEditor :: Maybe TextPosition -> FilePath -> IO ExitCode
 | |
| runEditor mpos f = editFileAtPositionCommand mpos f >>= runCommand >>= waitForProcess
 | |
| 
 | |
| -- | Get a shell command line to open the user's preferred text editor
 | |
| -- (or a default editor) on the given file, and to focus it at the
 | |
| -- given text position if one is provided and if we know how.
 | |
| --
 | |
| -- Just ('-' : _, _) is any text position with a negative line number.
 | |
| -- A text position with a negative line number means the last line.
 | |
| --
 | |
| -- Some tests:
 | |
| -- @
 | |
| -- EDITOR program:  Maybe TextPosition    Command should be:
 | |
| -- ---------------  --------------------- ------------------------------------
 | |
| -- emacs            Just (line, Just col) emacs +LINE:COL FILE
 | |
| --                  Just (line, Nothing)  emacs +LINE     FILE
 | |
| --                  Just ('-' : _, _)     emacs FILE -f end-of-buffer
 | |
| --                  Nothing               emacs           FILE
 | |
| --
 | |
| -- emacsclient      Just (line, Just col) emacsclient +LINE:COL FILE
 | |
| --                  Just (line, Nothing)  emacsclient +LINE     FILE
 | |
| --                  Just ('-' : _, _)     emacsclient           FILE
 | |
| --                  Nothing               emacsclient           FILE
 | |
| --
 | |
| -- nano             Just (line, Just col) nano +LINE:COL FILE
 | |
| --                  Just (line, Nothing)  nano +LINE     FILE
 | |
| --                  Just ('-' : _, _)     nano           FILE
 | |
| --                  Nothing               nano           FILE
 | |
| --
 | |
| -- vscode           Just (line, Just col) vscode --goto FILE:LINE:COL
 | |
| --                  Just (line, Nothing)  vscode --goto FILE:LINE
 | |
| --                  Just ('-' : _, _)     vscode        FILE
 | |
| --                  Nothing               vscode        FILE
 | |
| --
 | |
| -- kak              Just (line, Just col) kak +LINE:COL FILE
 | |
| --                  Just (line, Nothing)  kak +LINE     FILE
 | |
| --                  Just ('-' : _, _)     kak +:        FILE
 | |
| --                  Nothing               kak           FILE
 | |
| --
 | |
| -- vi & variants    Just (line, _)        vi +LINE FILE
 | |
| --                  Just ('-' : _, _)     vi +     FILE
 | |
| --                  Nothing               vi       FILE
 | |
| --
 | |
| -- (other PROG)     _                     PROG FILE
 | |
| --
 | |
| -- (not set)        Just (line, Just col) emacsclient -a '' -nw +LINE:COL FILE
 | |
| --                  Just (line, Nothing)  emacsclient -a '' -nw +LINE     FILE
 | |
| --                  Just ('-' : _, _)     emacsclient -a '' -nw           FILE
 | |
| --                  Nothing               emacsclient -a '' -nw           FILE
 | |
| -- @
 | |
| --
 | |
| editFileAtPositionCommand :: Maybe TextPosition -> FilePath -> IO String
 | |
| editFileAtPositionCommand mpos f = do
 | |
|   cmd <- getEditCommand
 | |
|   let editor = lowercase $ takeBaseName $ headDef "" $ words' cmd
 | |
|       f' = singleQuoteIfNeeded f
 | |
|       mpos' = Just . bimap show (fmap show) =<< mpos
 | |
|       join sep = intercalate sep . catMaybes
 | |
|       args = case editor of
 | |
|         "emacs" -> case mpos' of
 | |
|           Nothing -> [f']
 | |
|           Just ('-' : _, _) -> [f', "-f", "end-of-buffer"]
 | |
|           Just (l, mc) -> ['+' : join ":" [Just l, mc], f']
 | |
|         e | e `elem` ["emacsclient", "nano"] -> case mpos' of
 | |
|           Nothing -> [f']
 | |
|           Just ('-' : _, _) -> [f']
 | |
|           Just (l, mc) -> ['+' : join ":" [Just l, mc], f']
 | |
|         "vscode" -> case mpos' of
 | |
|           Nothing -> [f']
 | |
|           Just ('-' : _, _) -> [f']
 | |
|           Just (l, mc) -> ["--goto", join ":" [Just f', Just l, mc]]
 | |
|         "kak" -> case mpos' of
 | |
|           Nothing -> [f']
 | |
|           Just ('-' : _, _) -> ["+:", f']
 | |
|           Just (l, mc) -> ['+' : join ":" [Just l, mc], f']
 | |
|         e | e `elem` ["vi",  "vim", "view", "nvim", "evim", "eview",
 | |
|                       "gvim", "gview", "rvim", "rview",
 | |
|                       "rgvim", "rgview", "ex"] -> case mpos' of
 | |
|           Nothing -> [f']
 | |
|           Just ('-' : _, _) -> ["+", f']
 | |
|           Just (l, _) -> ['+' : l, f']
 | |
|         _ -> [f']
 | |
|   return $ unwords $ cmd:args
 | |
| 
 | |
| -- | Get the user's preferred edit command. This is the value of the
 | |
| -- $HLEDGER_UI_EDITOR environment variable, or of $EDITOR, or a
 | |
| -- default ("emacsclient -a '' -nw", which starts/connects to an emacs
 | |
| -- daemon in terminal mode).
 | |
| getEditCommand :: IO String
 | |
| getEditCommand = do
 | |
|   hledger_ui_editor_env <- lookupEnv "HLEDGER_UI_EDITOR"
 | |
|   editor_env            <- lookupEnv "EDITOR"
 | |
|   let Just cmd = hledger_ui_editor_env <|> editor_env <|> Just "emacsclient -a '' -nw"
 | |
|   return cmd
 | |
| 
 |