-(* Copyright (C) 2000-2003, HELM Team.
+(* Copyright (C) 2000-2004, HELM Team.
*
* This file is part of HELM, an Hypertextual, Electronic
* Library of Mathematics, developed at the Computer Science
let xlinkns = Gdome.domString "http://www.w3.org/1999/xlink";;
-let htmlheader =
- "<html>" ^
- " <body bgColor=\"white\">"
-;;
-
-let htmlfooter =
- " </body>" ^
- "</html>"
-;;
-
let prooffile =
try
Sys.getenv "GTOPLEVEL_PROOFFILE"
(* GLOBAL REFERENCES (USED BY CALLBACKS) *)
-let htmlheader_and_content = ref htmlheader;;
-
let check_term = ref (fun _ _ _ -> assert false);;
exception RenderingWindowsNotInitialized;;
let set_outputhtml,outputhtml =
let outputhtml_ref = ref None in
- (function rw -> outputhtml_ref := Some rw),
+ (function (rw: Ui_logger.html_logger) -> outputhtml_ref := Some rw),
(function () ->
match !outputhtml_ref with
- None -> raise OutputHtmlNotInitialized
- | Some outputhtml -> outputhtml
+ | None -> raise OutputHtmlNotInitialized
+ | Some outputhtml -> (outputhtml: Ui_logger.html_logger)
)
;;
String.sub uri' 4 (String.length uri' - 4)
;;
-let output_html outputhtml msg =
- outputhtml#log msg
-;;
+let output_html ?(append_NL = true) (outputhtml: Ui_logger.html_logger) =
+ outputhtml#log ~append_NL
(* UTILITY FUNCTIONS TO DISAMBIGUATE AN URI *)
(* Check window *)
-let check_window outputhtml uris =
+let check_window (outputhtml: Ui_logger.html_logger) uris =
let window =
GWindow.window
~width:800 ~modal:true ~title:"Check" ~border_width:2 () in
mmlwidget#load_sequent [] (111,[],expr)
with
e ->
- output_html outputhtml
- (`Error (`T (Printexc.to_string e)))
+ output_html outputhtml (`Error (`T (Printexc.to_string e)))
)
) uris
in
let decompose_uris_choice_callback = decompose_uris_choice_callback
let mk_fresh_name_callback = mk_fresh_name_callback
- let output_html msg = output_html (outputhtml ()) (`Msg (`T msg))
+ let output_html msg = output_html (outputhtml ()) msg
end
;;
module InvokeTactics' = InvokeTactics.Make (InvokeTacticsCallbacks);;
-
+(*
(* Just to initialize the Hbugs module *)
module Ignore = Hbugs.Initialize (InvokeTactics');;
Hbugs.set_describe_hint_callback (fun hint ->
check_window outputhtml [term]
| _ -> ())
;;
-
+*)
let dummy_uri = "/dummy.con"
(** load an unfinished proof from filesystem *)
let edit_aliases () =
let inputt = ((rendering_window ())#inputt : TermEditor.term_editor) in
- let id_to_uris = inputt#id_to_uris in
+ let id_to_uris = inputt#environment in
let chosen = ref false in
let window =
GWindow.window
ignore (cancelb#connect#clicked window#destroy) ;
ignore
(okb#connect#clicked (function () -> chosen := true ; window#destroy ())) ;
- let dom,resolve_id = !id_to_uris in
ignore
(input#buffer#insert ~iter:(input#buffer#get_iter_at_char 0)
- (String.concat "\n"
- (List.map
- (function v ->
- let uri =
- match resolve_id v with
- None -> assert false
- | Some (CicTextualParser0.Uri uri) -> uri
- | Some (CicTextualParser0.Term _)
- | Some CicTextualParser0.Implicit -> assert false
- in
- "alias " ^
- (match v with
- CicTextualParser0.Id id -> id
- | CicTextualParser0.Symbol (descr,_) ->
- (* CSC: To be implemented *)
- assert false
- )^ " " ^ (string_of_cic_textual_parser_uri uri)
- ) dom))) ;
+ (DisambiguatingParser.EnvironmentP3.to_string !id_to_uris)) ;
window#show () ;
GtkThread.main ();
if !chosen then
- let dom,resolve_id =
- let inputtext = input#buffer#get_text () in
- let regexpr =
- let alfa = "[a-zA-Z_-]" in
- let digit = "[0-9]" in
- let ident = alfa ^ "\(" ^ alfa ^ "\|" ^ digit ^ "\)*" in
- let blanks = "\( \|\t\|\n\)+" in
- let nonblanks = "[^ \t\n]+" in
- let uri = "/\(" ^ ident ^ "/\)*" ^ nonblanks in (* not very strict check *)
- Str.regexp
- ("alias" ^ blanks ^ "\(" ^ ident ^ "\)" ^ blanks ^ "\(" ^ uri ^ "\)")
- in
- let rec aux n =
- try
- let n' = Str.search_forward regexpr inputtext n in
- let id = CicTextualParser0.Id (Str.matched_group 2 inputtext) in
- let uri =
- MQueryMisc.cic_textual_parser_uri_of_string
- ("cic:" ^ (Str.matched_group 5 inputtext))
- in
- let dom,resolve_id = aux (n' + 1) in
- if List.mem id dom then
- dom,resolve_id
- else
- id::dom,
- (function id' ->
- if id = id' then
- Some (CicTextualParser0.Uri uri)
- else resolve_id id')
- with
- Not_found -> TermEditor.empty_id_to_uris
- in
- aux 0
- in
- id_to_uris := (dom,resolve_id)
+ id_to_uris :=
+ DisambiguatingParser.EnvironmentP3.of_string (input#buffer#get_text ())
;;
let proveit () =
Cic2acic.acic_object_of_cic_object obj
in
let mml =
- ApplyStylesheets.mml_of_cic_object
+ ChosenTransformer.mml_of_cic_object
~explode_all:false uri acic ids_to_inner_sorts ids_to_inner_types
in
window#set_title (UriManager.string_of_uri uri) ;
(* A WIDGET TO ENTER CIC TERMS *)
-module ChosenTermEditor = TexTermEditor;;
-module ChosenTextualParser0 = TexCicTextualParser0;;
-(*
-module ChosenTermEditor = TermEditor;;
-module ChosenTextualParser0 = CicTextualParser0;;
-*)
-
module Callbacks =
struct
- let get_metasenv () = !ChosenTextualParser0.metasenv
- let set_metasenv metasenv = ChosenTextualParser0.metasenv := metasenv
-
- let output_html msg = output_html (outputhtml ()) (`Msg (`T msg));;
+ let output_html ?append_NL = output_html ?append_NL (outputhtml ())
let interactive_user_uri_choice =
fun ~selection_mode ?ok ?enable_button_for_non_vars ~title ~msg ~id ->
interactive_user_uri_choice ~selection_mode ?ok
- ?enable_button_for_non_vars ~title ~msg;;
- let interactive_interpretation_choice = interactive_interpretation_choice;;
- let input_or_locate_uri = input_or_locate_uri;;
+ ?enable_button_for_non_vars ~title ~msg
+ let interactive_interpretation_choice = interactive_interpretation_choice
+ let input_or_locate_uri = input_or_locate_uri
end
;;
TexTermEditor'.term_editor
mqi_handle
~width:400 ~height:20 ~packing:scrolled_window#add
- ~share_id_to_uris_with:inputt ()
+ ~share_environment_with:inputt ()
~isnotempty_callback:
(function b ->
(*non_empty_type := b ;*)
TexTermEditor'.term_editor
mqi_handle
~width:400 ~height:20 ~packing:scrolled_window#add
- ~share_id_to_uris_with:inputt ()
+ ~share_environment_with:inputt ()
~isnotempty_callback:
(function b ->
(* (*non_empty_type := b ;*)
TexTermEditor'.term_editor
mqi_handle
~width:400 ~height:100 ~packing:scrolled_window#add
- ~share_id_to_uris_with:inputt ()
+ ~share_environment_with:inputt ()
~isnotempty_callback:
(function b ->
non_empty_type := b ;
okb#misc#set_sensitive (b && uri_entry#text <> ""))
in
let _ =
-let xxx = inputt#get_as_string in
-prerr_endline ("######################## " ^ xxx) ;
- newinputt#set_term xxx ;
-(*
- newinputt#set_term inputt#get_as_string ;
-*)
+ newinputt#set_term inputt#get_as_string ;
inputt#reset in
let _ =
uri_entry#connect#changed
let choose_selection mmlwidget (element : Gdome.element option) =
let module G = Gdome in
- prerr_endline "Il bandolo" ;
let rec aux element =
if element#hasAttributeNS
~namespaceURI:Misc.helmns
close_out oc
with exc ->
output_html (outputhtml ())
- (`Error (`T (Printf.sprintf
- "<h1 color=\"red\">Dump failure, uncaught exception:%s</h1>"
+ (`Error (`T (Printf.sprintf "Dump failure, uncaught exception:%s"
(Printexc.to_string exc))))
;;
let restore_environment () =
try
let ic = open_in environmentfile in
- output_html (outputhtml ()) (`Msg (`L [`T "Restoring environment ... " ; `BR]));
+ output_html (outputhtml ()) (`Msg (`T "Restoring environment ... "));
CicEnvironment.restore_from_channel
- ~callback:(fun uri -> output_html (outputhtml ()) (`Msg (`L [`T uri ; `BR])))
+ ~callback:(fun uri -> output_html (outputhtml ()) (`Msg (`T uri)))
ic;
output_html (outputhtml ()) (`Msg (`T "... done!"));
close_in ic
with exc ->
output_html (outputhtml ())
- (`Error (`T (Printf.sprintf
- "<h1 color=\"red\">Restore failure, uncaught exception:%s</h1>"
+ (`Error (`T (Printf.sprintf "Restore failure, uncaught exception:%s"
(Printexc.to_string exc))))
;;
-(* HTML simulator (first in its kind) *)
-
-type log_msg =
- [ `T of string
- | `L of log_msg list
- | `BR
- ]
-;;
-
-class logger ~width ~height ~packing ~show () =
- let scrolled_window =
- GBin.scrolled_window ~packing ~show () in
- let vadj = scrolled_window#vadjustment in
- let tv =
- GText.view ~editable:false ~cursor_visible:false
- ~width ~height ~packing:(scrolled_window#add) () in
- let green =
- tv#buffer#create_tag
- [`FOREGROUND_SET true ;
- `FOREGROUND_GDK
- (Gdk.Color.alloc (Gdk.Color.get_system_colormap ()) (`NAME "green"))] in
- let red =
- tv#buffer#create_tag
- [`FOREGROUND_SET true ;
- `FOREGROUND_GDK
- (Gdk.Color.alloc (Gdk.Color.get_system_colormap ()) (`NAME "red"))] in
- object
- method log (m : [`Msg of log_msg | `Error of log_msg]) =
- let process_msg tags =
- let rec aux =
- function
- `T s -> tv#buffer#insert ~tags s
- | `L l -> List.iter aux l
- | `BR -> tv#buffer#insert ~tags "\n"
- in
- aux
- in
- begin
- match m with
- `Msg m -> process_msg [green] m
- | `Error m -> process_msg [red] m
- end ;
- vadj#set_value (vadj#upper)
- end
-;;
-
(* Main window *)
class rendering_window output (notebook : notebook) =
factory3#add_item "Reload Stylesheets"
~callback:
(function _ ->
- ApplyStylesheets.reload_stylesheets () ;
+ ChosenTransformer.reload_stylesheets () ;
if ProofEngine.get_proof () <> None then
try
refresh_goals notebook ;
GBin.frame ~shadow_type:`IN ~packing:(vboxl#pack ~expand:true ~padding:5) ()
in
let outputhtml =
- new logger
+ new Ui_logger.html_logger
~width:400 ~height: 100
~packing:frame#add
~show:true () in
set_settings_window settings_window ;
set_outputhtml outputhtml ;
ignore(window#event#connect#delete (fun _ -> GMain.Main.quit () ; true )) ;
- Logger.log_callback :=
- (Logger.log_to_html
- ~print_and_flush:(fun m -> (output_html outputhtml (`Msg (`T m)))))
-end;;
+ CicLogger.log_callback := (outputhtml#log_cic_msg ~append_NL:true)
+end
(* MAIN *)
projects / helm.git / blobdiff