diff --git a/src/lsp/cobol_lsp/lsp_data_info_printer.ml b/src/lsp/cobol_lsp/lsp_data_info_printer.ml index 1c62761d..ae010d38 100644 --- a/src/lsp/cobol_lsp/lsp_data_info_printer.ml +++ b/src/lsp/cobol_lsp/lsp_data_info_printer.ml @@ -249,10 +249,10 @@ let pp_record_renaming': record_renaming with_loc Pretty.printer = fun ppf -> let pp_data_definition ppf = function | Data_field { def; _ } -> - Fmt.const pp_field_definition' def ppf () + pp_field_definition' ppf def | Data_renaming { def; _ } -> - Fmt.const pp_record_renaming' def ppf () + pp_record_renaming' ppf def | Data_condition { def; field; _ } -> Fmt.pf ppf "%a\n\n%a" pp_condition_name ~&def pp_field_definition ~&field | Table_index { table; _ } -> - Fmt.const pp_table_definition' table ppf () + pp_table_definition' ppf table diff --git a/src/lsp/cobol_lsp/lsp_request.ml b/src/lsp/cobol_lsp/lsp_request.ml index f23092e7..9c67ec06 100644 --- a/src/lsp/cobol_lsp/lsp_request.ml +++ b/src/lsp/cobol_lsp/lsp_request.ml @@ -454,6 +454,23 @@ let handle_semtoks_full, (** {3 Hover} *) +let documetation_of_datadef ~(comments: Cobol_preproc.Text.comments) ~filename data_def = + let loc = Cobol_data.Item.def_loc data_def in + let def_range = Lsp_position.range_of_srcloc_in ~filename loc in + let comments = List.rev @@ + List.filter_map begin fun ({ comment_loc; comment_kind; comment_contents }: Cobol_preproc.Text.comment) -> + let com_range = Lsp_position.range_of_lexloc comment_loc in + if def_range.start.line = com_range.start.line + || def_range.start.line = com_range.start.line + 1 + && comment_kind == `Line + then Some comment_contents + else None + end comments in + if List.length comments == 0 + then "" + else Pretty.to_string "\n```cobol\n%a\n```" + Fmt.(list ~sep:(any "\n") string) comments + let lookup_data_definition_for_hover cu_name element_at_pos group = let { payload = cu; _ } = CUs.find_by_name cu_name group in let named_data_defs = cu.unit_data.data_items.named in @@ -467,7 +484,7 @@ let lookup_data_definition_for_hover cu_name element_at_pos group = with Cobol_unit.Qualmap.Ambiguous _ -> raise Not_found let data_definition_on_hover - ?(always_show_hover_text_in_data_div = false) + ?(always_show_hover_text_in_data_div = false) ~comments ~uri position Cobol_typeck.Outputs.{ group; _ } = let filename = Lsp.Uri.to_path uri in match Lsp_lookup.element_at_position ~uri position group with @@ -479,11 +496,12 @@ let data_definition_on_hover try let data_def, hover_loc = lookup_data_definition_for_hover cu_name ele_at_pos group in + let doc_comments = documetation_of_datadef ~comments ~filename data_def in if always_show_hover_text_in_data_div || not (Lsp_position.is_in_srcloc ~filename position @@ Cobol_data.Item.def_loc data_def) - then Some (Pretty.to_string - "%a" Lsp_data_info_printer.pp_data_definition data_def, + then Some (Pretty.to_string "%a%s" + Lsp_data_info_printer.pp_data_definition data_def doc_comments, hover_loc) else None with Not_found -> @@ -536,9 +554,11 @@ let handle_hover ?always_show_hover_text_in_data_div registry HoverParams.{ textDocument = doc; position; _ } = let filename = Lsp.Uri.to_path doc.uri in try_with_main_document_data registry doc - ~f:begin fun ~doc:{ artifacts = { pplog; _ }; _ } checked_doc -> + ~f:begin fun + ~doc:{ artifacts = { pplog; rev_comments = comments; _ }; _ } + checked_doc -> match data_definition_on_hover ~uri:doc.uri position checked_doc - ?always_show_hover_text_in_data_div, + ?always_show_hover_text_in_data_div ~comments, preproc_info_on_hover ~filename position pplog with | None, None -> None diff --git a/test/lsp/lsp_hover.ml b/test/lsp/lsp_hover.ml index 7ee599d0..22da4281 100644 --- a/test/lsp/lsp_hover.ml +++ b/test/lsp/lsp_hover.ml @@ -1141,3 +1141,120 @@ let%expect_test "hover-typedef-communication-section" = Hovering nothing worthy (line 10, character 17): Hovering nothing worthy |}];; + +let%expect_test "hover-comment" = + let { projdir; end_with_postproc }, server = make_lsp_project () in + print_hovered server ~projdir @@ extract_position_markers {cobol| +>>source format is fixed + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + * full line comment + 01 STRUCT. *> inline comment + 02 VAL-1 PIC X. *> val1 inline comment + 02 VAL-2 PIC X. + PROCEDURE DIVISION. + DISPLAY S_|_TRUCT V_|_AL-1 V_|_AL-2. + STOP RUN. + |cobol}; + end_with_postproc [%expect.output]; + [%expect {| + {"params":{"diagnostics":[],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + (line 11, character 18): + __rootdir__/prog.cob:12.17-12.23: + 9 02 VAL-1 PIC X. *> val1 inline comment + 10 02 VAL-2 PIC X. + 11 PROCEDURE DIVISION. + 12 > DISPLAY STRUCT VAL-1 VAL-2. + ---- ^^^^^^ + 13 STOP RUN. + 14 + ```cobol + STRUCT + ``` + Group of 2 subfields + Size: 16 bits + ```cobol + * full line comment + *> inline comment + ``` + (line 11, character 25): + __rootdir__/prog.cob:12.24-12.29: + 9 02 VAL-1 PIC X. *> val1 inline comment + 10 02 VAL-2 PIC X. + 11 PROCEDURE DIVISION. + 12 > DISPLAY STRUCT VAL-1 VAL-2. + ---- ^^^^^ + 13 STOP RUN. + 14 + ```cobol + VAL-1 IN STRUCT + ``` + ```cobol + PIC X USAGE DISPLAY + ``` + ALPHANUMERIC(1) + ```cobol + *> val1 inline comment + ``` + (line 11, character 31): + __rootdir__/prog.cob:12.30-12.35: + 9 02 VAL-1 PIC X. *> val1 inline comment + 10 02 VAL-2 PIC X. + 11 PROCEDURE DIVISION. + 12 > DISPLAY STRUCT VAL-1 VAL-2. + ---- ^^^^^ + 13 STOP RUN. + 14 + ```cobol + VAL-2 IN STRUCT + ``` + ```cobol + PIC X USAGE DISPLAY + ``` + ALPHANUMERIC(1) |}];; + + +let%expect_test "hover-comment-copy" = + let { projdir; end_with_postproc }, server = make_lsp_project () in + let server, _ = add_cobol_doc server ~projdir "lib.cpy" {cobol| + * copy full line comment + 01 FIELD PIC X. *> copy inline comment + |cobol} in + print_hovered server ~projdir @@ extract_position_markers {cobol| + >>source format is fixed + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + * full line comment + COPY lib. *> inline comment + PROCEDURE DIVISION. + DISPLAY F_|_IELD + STOP RUN. + |cobol}; + end_with_postproc [%expect.output]; + [%expect {| + {"params":{"diagnostics":[],"uri":"file://__rootdir__/lib.cpy"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + {"params":{"diagnostics":[],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + (line 9, character 19): + __rootdir__/prog.cob:10.18-10.23: + 7 * full line comment + 8 COPY lib. *> inline comment + 9 PROCEDURE DIVISION. + 10 > DISPLAY FIELD + ---- ^^^^^ + 11 STOP RUN. + 12 + ```cobol + FIELD + ``` + ```cobol + PIC X USAGE DISPLAY + ``` + ALPHANUMERIC(1) + ```cobol + * full line comment + *> inline comment + ``` |}]