From 89526e8e6ae19c07a628ca9fceb7f2f9cb98f894 Mon Sep 17 00:00:00 2001 From: Frederic Bour Date: Wed, 11 Jan 2017 18:29:13 +0100 Subject: [PATCH] #606: reimplement merlin-phrase-{next,prev} --- emacs/merlin.el | 23 ++++++++++++++ src/analysis/jump.ml | 53 ++++++++++++++++++++++++++++++++ src/analysis/jump.mli | 5 +++ src/frontend/new/new_commands.ml | 27 ++++++++++++++++ src/frontend/query_commands.ml | 7 +++++ src/frontend/query_json.ml | 7 +++++ src/frontend/query_protocol.ml | 3 ++ vim/merlin/autoload/merlin.py | 24 ++++++++++----- vim/merlin/autoload/merlin.vim | 14 ++++++++- 9 files changed, 155 insertions(+), 8 deletions(-) diff --git a/emacs/merlin.el b/emacs/merlin.el index 7a402003b8..d3c9eed60f 100644 --- a/emacs/merlin.el +++ b/emacs/merlin.el @@ -1241,6 +1241,29 @@ Empty string defaults to jumping to all these." (interactive "sfun, let, module or match > ") (merlin--goto-file-and-point (merlin/jump target))) +(defun merlin/phrase (target) + "Move to next phrase (TARGET = 'next) or previous phrase (TARGET = 'prev)" + (if (or (not target) (equal target "")) + (setq target "fun let module match")) + (let ((result (merlin/call "phrase" + "-position" (merlin/unmake-point (point)) + "-target" target))) + (unless result + (error "Not found. (Check *Messages* for potential errors)")) + (unless (listp result) + (error result)) + result)) + +(defun merlin-phrase-next () + "Go to the beginning of the next phrase." + (interactive) + (merlin--goto-file-and-point (merlin/phrase 'next))) + +(defun merlin-phrase-prev () + "Go to the beginning of the previous phrase." + (interactive) + (merlin--goto-file-and-point (merlin/phrase 'prev))) + ;;;;;;;;;;;;;; ;; DOCUMENT ;; ;;;;;;;;;;;;;; diff --git a/src/analysis/jump.ml b/src/analysis/jump.ml index 65a3f22545..214ecd0c6d 100644 --- a/src/analysis/jump.ml +++ b/src/analysis/jump.ml @@ -165,3 +165,56 @@ let get typed_tree pos target = | No_matching_target -> `Error "No matching target" +let phrase typed_tree pos target = + let roots = Mbrowse.of_typedtree typed_tree in + (* Select nodes around cursor. + If the cursor is around a module expression, also search inside it. *) + let enclosing = match Mbrowse.enclosing pos [roots] with + | (env, (Browse_raw.Module_expr _ as node)) :: enclosing -> + Browse_raw.fold_node (fun env node enclosing -> (env,node) :: enclosing) + env node enclosing + | enclosing -> enclosing + in + (* Drop environment, they are of no use here *) + let enclosing = List.map ~f:snd enclosing in + let find_item x xs = match target with + | `Prev -> List.rev (List.take_while ~f:((!=)x) xs) + | `Next -> match List.drop_while ~f:((!=)x) xs with _::xs -> xs | [] -> [] + in + let find_pos prj xs = + match target with + | `Prev -> + let f x = Location_aux.compare_pos pos (prj x) > 0 in + List.rev (List.take_while ~f xs) + | `Next -> + let f x = Location_aux.compare_pos pos (prj x) >= 0 in + List.drop_while ~f xs + in + let rec seek_item = function + | [] -> None + | Browse_raw.Signature xs :: tail -> + begin match find_pos (fun x -> x.Typedtree.sig_loc) xs.Typedtree.sig_items with + | [] -> seek_item tail + | y :: _ -> Some y.Typedtree.sig_loc + end + | Browse_raw.Structure xs :: tail -> + begin match find_pos (fun x -> x.Typedtree.str_loc) xs.Typedtree.str_items with + | [] -> seek_item tail + | y :: _ -> Some y.Typedtree.str_loc + end + | Browse_raw.Signature_item (x,_) :: Browse_raw.Signature xs :: tail -> + begin match find_item x xs.Typedtree.sig_items with + | [] -> seek_item tail + | y :: _ -> Some y.Typedtree.sig_loc + end + | Browse_raw.Structure_item (x,_) :: Browse_raw.Structure xs :: tail -> + begin match find_item x xs.Typedtree.str_items with + | [] -> seek_item tail + | y :: _ -> Some y.Typedtree.str_loc + end + | _ :: xs -> seek_item xs + in + match seek_item enclosing, target with + | Some loc, _ -> `Logical (Lexing.split_pos loc.Location.loc_start) + | None, `Prev -> `Start + | None, `Next -> `End diff --git a/src/analysis/jump.mli b/src/analysis/jump.mli index aac08fa0c7..f42a950e93 100644 --- a/src/analysis/jump.mli +++ b/src/analysis/jump.mli @@ -31,3 +31,8 @@ val get : Mtyper.typedtree -> Std.Lexing.position -> string -> [> `Error of string | `Found of Lexing.position ] + +val phrase : + Mtyper.typedtree -> + Std.Lexing.position -> + [< `Next | `Prev ] -> [> `End | `Logical of int * int | `Start ] diff --git a/src/frontend/new/new_commands.ml b/src/frontend/new/new_commands.ml index c86a596f62..0f58ac908d 100644 --- a/src/frontend/new/new_commands.ml +++ b/src/frontend/new/new_commands.ml @@ -242,6 +242,33 @@ let all_commands = [ end ; + command "phrase" + ~doc:"phrase -target [next|prev] -position pos\n\t\ + TODO" + ~spec: [ + ("-target", + " Entity to jump to", + Marg.param "string" (fun target (_,pos) -> + match target with + | "next" -> (`Next,pos) + | "prev" -> (`Prev,pos) + | _ -> failwith "-target should be one of 'next' or 'prev'" + ) + ); + ("-position", + " Position to complete", + marg_position (fun pos (target,_pos) -> (target,pos)) + ); + ] + ~default:(`Next,`None) + begin fun buffer (target,pos) -> + match pos with + | `None -> failwith "-position is mandatory" + | #Msource.position as pos -> + run buffer (Query_protocol.Phrase (target,pos)) + end + ; + command "list-modules" ~doc:"list-modules -ext .ml -ext .mli ...\n\t\ looks into project source paths for files with an extension \ diff --git a/src/frontend/query_commands.ml b/src/frontend/query_commands.ml index bedf2b02dd..198926d9f5 100644 --- a/src/frontend/query_commands.ml +++ b/src/frontend/query_commands.ml @@ -437,6 +437,13 @@ let dispatch buffer (type a) : a Query_protocol.t -> a = let pos = Msource.get_lexing_pos (Mpipeline.input_source pipeline) pos in Jump.get typedtree pos target + | Phrase (target, pos) -> + with_typer buffer @@ fun pipeline typer -> + let source = Mpipeline.input_source pipeline in + let typedtree = Mtyper.get_typedtree typer in + let pos = Msource.get_lexing_pos source pos in + Msource.get_lexing_pos source (Jump.phrase typedtree pos target) + | Case_analysis (pos_start, pos_end) -> with_typer buffer @@ fun pipeline typer -> let source = Mpipeline.input_source pipeline in diff --git a/src/frontend/query_json.ml b/src/frontend/query_json.ml index d50734aed0..6cbf41a397 100644 --- a/src/frontend/query_json.ml +++ b/src/frontend/query_json.ml @@ -104,6 +104,11 @@ let dump (type a) : a t -> json = "target", `String target; "position", mk_position pos; ] + | Phrase (target, pos) -> + mk "phrase" [ + "target", `String (match target with `Next -> "next" | `Prev -> "prev"); + "position", mk_position pos; + ] | Case_analysis (pos_start,pos_end) -> mk "case-analysis" [ "start", mk_position pos_start; @@ -280,6 +285,8 @@ let json_of_response (type a) (query : a t) (response : a) : json = | `Found pos -> `Assoc ["pos", Lexing.json_of_position pos] end + | Phrase _, pos -> + `Assoc ["pos", Lexing.json_of_position pos] | Case_analysis _, ({ Location. loc_start ; loc_end }, str) -> let assoc = `Assoc [ diff --git a/src/frontend/query_protocol.ml b/src/frontend/query_protocol.ml index c9a9761712..2274d259e4 100644 --- a/src/frontend/query_protocol.ml +++ b/src/frontend/query_protocol.ml @@ -119,6 +119,9 @@ type _ t = -> [ `Found of Lexing.position | `Error of string ] t + | Phrase(* *) + : [`Next | `Prev] * Msource.position + -> Lexing.position t | Case_analysis(* *) : Msource.position * Msource.position -> (Location.t * string) t | Outline(* *) diff --git a/vim/merlin/autoload/merlin.py b/vim/merlin/autoload/merlin.py index 29d2e18d4f..c792bac5c5 100644 --- a/vim/merlin/autoload/merlin.py +++ b/vim/merlin/autoload/merlin.py @@ -134,7 +134,7 @@ def merlin_exec(*args, input=""): def command(*args, context=None): (filename, content) = context or current_context() - cmdline = ["server"] + list(args) + ["--","-filename",filename] + \ + cmdline = ["server"] + list(args) + ["-filename",filename] + \ concat_map(lambda ext: ("-extension",ext), vim_list_if_set("b:merlin_extensions")) + \ concat_map(lambda pkg: ("-package",pkg), vim_list_if_set("b:merlin_packages")) + \ vim.eval('g:merlin_binary_flags') + \ @@ -250,9 +250,9 @@ def command_locate(path, pos): except MerlinExc as e: try_print_error(e) -def command_jump(target, pos): +def command_motion(cmd, target, pos): try: - pos_or_err = command("jump", "-target", target, "-position", fmtpos(pos)) + pos_or_err = command(cmd, "-target", target, "-position", fmtpos(pos)) if not isinstance(pos_or_err, dict): print(pos_or_err) else: @@ -261,7 +261,10 @@ def command_jump(target, pos): # save the current position in the jump list vim.command("normal! m'") # TODO: move the cursor using vimscript, so we can :keepjumps? - vim.current.window.cursor = (l, c) + try: + vim.current.window.cursor = (l, c) + except: + vim.command("$") except MerlinExc as e: try_print_error(e) @@ -358,13 +361,19 @@ def vim_locate_at_cursor(path): def vim_locate_under_cursor(): vim_locate_at_cursor(None) -# Jump +# Jump and Phrase motion def vim_jump_to(target): - command_jump(target, vim.current.window.cursor) + command_motion("jump", target, vim.current.window.cursor) def vim_jump_default(): vim_jump_to("fun let module match") +def vim_phrase_prev(): + command_motion("phrase", "prev", vim.current.window.cursor) + +def vim_phrase_next(): + command_motion("phrase", "next", vim.current.window.cursor) + # Document def vim_document_at_cursor(path): command_document(path, vim.current.window.cursor) @@ -611,11 +620,12 @@ def vim_which(name,exts): return command('path-of-source', *files) def vim_which_ext(exts,vimvar): - files = command('list-modules', *concat_map(lambda ext: ("-ext",ext))) + files = command('list-modules', *concat_map(lambda ext: ("-ext",ext), exts)) vim.command("let %s = []" % vimvar) for f in sorted(set(files)): vim.command("call add(%s, '%s')" % (vimvar, f)) +# Options listing def vim_flags_list(vimvar): for x in command('flags-list'): vim.command("call add(%s, '%s')" % (vimvar, x)) diff --git a/vim/merlin/autoload/merlin.vim b/vim/merlin/autoload/merlin.vim index 01ffbdd2a2..118df586da 100644 --- a/vim/merlin/autoload/merlin.vim +++ b/vim/merlin/autoload/merlin.vim @@ -348,6 +348,14 @@ function! merlin#Jump(...) endif endfunction +function! merlin#PhrasePrev() + MerlinPy merlin.vim_phrase_prev() +endfunction + +function! merlin#PhraseNext() + MerlinPy merlin.vim_phrase_next() +endfunction + function! merlin#Document(...) if (a:0 > 1) echoerr "Document: to many arguments (expected 0 or 1)" @@ -519,8 +527,12 @@ function! merlin#Register() nmap gd :MerlinLocate endif - """ Jump ------------------------------------------------------------------ + """ Jump and Phrase motion --------------------------------------------------- command! -buffer -complete=customlist,merlin#ExpandPrefix -nargs=? MerlinJump call merlin#Jump() + command! -buffer MerlinPhrasePrev call merlin#PhrasePrev() + command! -buffer MerlinPhraseNext call merlin#PhraseNext() + nmap [[ :MerlinPhrasePrev + nmap ]] :MerlinPhraseNext """ Document ---------------------------------------------------------------- command! -buffer -complete=customlist,merlin#ExpandPrefix -nargs=? MerlinDocument call merlin#Document()