diff options
Diffstat (limited to 'ide/ideutils.ml')
| -rw-r--r-- | ide/ideutils.ml | 70 |
1 files changed, 40 insertions, 30 deletions
diff --git a/ide/ideutils.ml b/ide/ideutils.ml index 06a13273..bdb39e94 100644 --- a/ide/ideutils.ml +++ b/ide/ideutils.ml @@ -1,9 +1,11 @@ (************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) (* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) (************************************************************************) @@ -35,17 +37,6 @@ let flash_info = let flash_context = status#new_context ~name:"Flash" in (fun ?(delay=5000) s -> flash_context#flash ~delay s) -let xml_to_string xml = - let open Xml_datatype in - let buf = Buffer.create 1024 in - let rec iter = function - | PCData s -> Buffer.add_string buf s - | Element (_, _, children) -> - List.iter iter children - in - let () = iter (Richpp.repr xml) in - Buffer.contents buf - let insert_with_tags (buf : #GText.buffer_skel) mark rmark tags text = (** FIXME: LablGTK2 does not export the C insert_with_tags function, so that it has to reimplement its own helper function. Unluckily, it relies on @@ -58,7 +49,7 @@ let insert_with_tags (buf : #GText.buffer_skel) mark rmark tags text = let () = buf#insert ~iter:(buf#get_iter_at_mark mark) text in let start = buf#get_iter_at_mark mark in let stop = buf#get_iter_at_mark rmark in - let iter tag = buf#apply_tag tag start stop in + let iter tag = buf#apply_tag tag ~start ~stop in List.iter iter tags let insert_xml ?(mark = `INSERT) ?(tags = []) (buf : #GText.buffer_skel) msg = @@ -75,11 +66,17 @@ let insert_xml ?(mark = `INSERT) ?(tags = []) (buf : #GText.buffer_skel) msg = let tags = try tag t :: tags with Not_found -> tags in List.iter (fun xml -> insert tags xml) children in - let () = try insert tags (Richpp.repr msg) with _ -> () in + let () = try insert tags msg with _ -> () in buf#delete_mark rmark let set_location = ref (function s -> failwith "not ready") +let display_location ins = + let line = ins#line + 1 in + let off = ins#line_offset + 1 in + let msg = Printf.sprintf "Line: %5d Char: %3d" line off in + !set_location msg + (** A utf8 char is either a single byte (ascii char, 0xxxxxxx) or multi-byte (with a leading byte 11xxxxxx and extra bytes 10xxxxxx) *) @@ -294,18 +291,20 @@ let coqtop_path () = match cmd_coqtop#get with | Some s -> s | None -> - let prog = String.copy Sys.executable_name in try - let pos = String.length prog - 6 in - let i = Str.search_backward (Str.regexp_string "coqide") prog pos + let old_prog = Sys.executable_name in + let pos = String.length old_prog - 6 in + let i = Str.search_backward (Str.regexp_string "coqide") old_prog pos in - String.blit "coqtop" 0 prog i 6; - if Sys.file_exists prog then prog + let new_prog = Bytes.of_string old_prog in + Bytes.blit_string "coqtop" 0 new_prog i 6; + let new_prog = Bytes.to_string new_prog in + if Sys.file_exists new_prog then new_prog else let in_macos_bundle = Filename.concat - (Filename.dirname prog) - (Filename.concat "../Resources/bin" (Filename.basename prog)) + (Filename.dirname new_prog) + (Filename.concat "../Resources/bin" (Filename.basename new_prog)) in if Sys.file_exists in_macos_bundle then in_macos_bundle else "coqtop" with Not_found -> "coqtop" @@ -325,7 +324,7 @@ let textview_width (view : #GText.view_skel) = let char_width = GPango.to_pixels metrics#approx_char_width in pixel_width / char_width -type logger = Feedback.level -> Richpp.richpp -> unit +type logger = Feedback.level -> Pp.t -> unit let default_logger level message = let level = match level with @@ -335,7 +334,7 @@ let default_logger level message = | Feedback.Warning -> `WARNING | Feedback.Error -> `ERROR in - Minilib.log ~level (xml_to_string message) + Minilib.log_pp ~level message (** {6 File operations} *) @@ -357,7 +356,7 @@ let stat f = let maxread = 4096 -let read_string = String.create maxread +let read_string = Bytes.create maxread let read_buffer = Buffer.create maxread (** Read the content of file [f] and add it to buffer [b]. @@ -368,7 +367,7 @@ let read_file name buf = let len = ref 0 in try while len := input ic read_string 0 maxread; !len > 0 do - Buffer.add_substring buf read_string 0 !len + Buffer.add_subbytes buf read_string 0 !len done; close_in ic with e -> close_in ic; raise e @@ -382,7 +381,7 @@ let io_read_all chan = Buffer.clear read_buffer; let read_once () = let len = Glib.Io.read_chars ~buf:read_string ~pos:0 ~len:maxread chan in - Buffer.add_substring read_buffer read_string 0 len + Buffer.add_subbytes read_buffer read_string 0 len in begin try while true do read_once () done @@ -430,7 +429,7 @@ let browse prerr url = let doc_url () = if doc_url#get = use_default_doc_url || doc_url#get = "" then - let addr = List.fold_left Filename.concat (Coq_config.docdir) + let addr = List.fold_left Filename.concat (Envars.docdir ()) ["html";"refman";"index.html"] in if Sys.file_exists addr then "file://"^addr else Coq_config.wwwrefman @@ -475,3 +474,14 @@ let browse_keyword prerr text = browse prerr (doc_url() ^ u) with Not_found -> prerr ("No documentation found for \""^text^"\".\n") +let rec is_valid (s : Pp.t) = match Pp.repr s with + | Pp.Ppcmd_empty + | Pp.Ppcmd_print_break _ + | Pp.Ppcmd_force_newline -> true + | Pp.Ppcmd_glue l -> List.for_all is_valid l + | Pp.Ppcmd_string s -> Glib.Utf8.validate s + | Pp.Ppcmd_box (_,s) + | Pp.Ppcmd_tag (_,s) -> is_valid s + | Pp.Ppcmd_comment s -> List.for_all Glib.Utf8.validate s +let validate s = + if is_valid s then s else Pp.str "This error massage can't be printed." |