diff options
Diffstat (limited to 'ide')
49 files changed, 2546 insertions, 6859 deletions
diff --git a/ide/.merlin b/ide/.merlin index 3f3d9d275d..953b5dce4c 100644 --- a/ide/.merlin +++ b/ide/.merlin @@ -1,4 +1,4 @@ -PKG lablgtk2.sourceview2 +PKG unix laglgtk2 lablgtk2.sourceview2 S utils B utils diff --git a/ide/coq.ml b/ide/coq.ml index fa0adf979c..6d44ca59e3 100644 --- a/ide/coq.ml +++ b/ide/coq.ml @@ -227,7 +227,7 @@ type coqtop = { (* non quoted command-line arguments of coqtop *) mutable sup_args : string list; (* called whenever coqtop dies *) - mutable reset_handler : reset_kind -> unit task; + mutable reset_handler : unit task; (* called whenever coqtop sends a feedback message *) mutable feedback_handler : Feedback.feedback -> unit; (* actual coqtop process and its status *) @@ -290,23 +290,20 @@ let rec check_errors = function | `NVAL :: _ -> raise (TubeError "NVAL") | `OUT :: _ -> raise (TubeError "OUT") -let handle_intermediate_message handle xml = - let message = Pp.to_message xml in - let level = message.Pp.message_level in - let content = message.Pp.message_content in - let logger = match handle.waiting_for with - | Some (_, l) -> l +let handle_intermediate_message handle level content = + let logger = match handle.waiting_for with + | Some (_, l) -> l | None -> function - | Pp.Error -> fun s -> Minilib.log ~level:`ERROR (xml_to_string s) - | Pp.Info -> fun s -> Minilib.log ~level:`INFO (xml_to_string s) - | Pp.Notice -> fun s -> Minilib.log ~level:`NOTICE (xml_to_string s) - | Pp.Warning -> fun s -> Minilib.log ~level:`WARNING (xml_to_string s) - | Pp.Debug _ -> fun s -> Minilib.log ~level:`DEBUG (xml_to_string s) + | Feedback.Error -> fun s -> Minilib.log ~level:`ERROR (xml_to_string s) + | Feedback.Info -> fun s -> Minilib.log ~level:`INFO (xml_to_string s) + | Feedback.Notice -> fun s -> Minilib.log ~level:`NOTICE (xml_to_string s) + | Feedback.Warning -> fun s -> Minilib.log ~level:`WARNING (xml_to_string s) + | Feedback.Debug -> fun s -> Minilib.log ~level:`DEBUG (xml_to_string s) in - logger level (Richpp.richpp_of_xml content) + logger level content let handle_feedback feedback_processor xml = - let feedback = Feedback.to_feedback xml in + let feedback = Xmlprotocol.to_feedback xml in feedback_processor feedback let handle_final_answer handle xml = @@ -335,15 +332,18 @@ let unsafe_handle_input handle feedback_processor state conds ~read_all = let l_end = Lexing.lexeme_end lex in state.fragment <- String.sub s l_end (String.length s - l_end); state.lexerror <- None; - if Pp.is_message xml then begin - handle_intermediate_message handle xml; + match Xmlprotocol.is_message xml with + | Some (lvl, _loc, msg) -> + handle_intermediate_message handle lvl msg; loop () - end else if Feedback.is_feedback xml then begin - handle_feedback feedback_processor xml; - loop () - end else begin - ignore (handle_final_answer handle xml) - end + | None -> + if Xmlprotocol.is_feedback xml then begin + handle_feedback feedback_processor xml; + loop () + end else + begin + ignore (handle_final_answer handle xml) + end in try loop () with Xml_parser.Error _ as e -> @@ -357,7 +357,9 @@ let unsafe_handle_input handle feedback_processor state conds ~read_all = let print_exception = function | Xml_parser.Error e -> Xml_parser.error e - | Serialize.Marshal_error -> "Protocol violation" + | Serialize.Marshal_error(expected,actual) -> + "Protocol violation. Expected: " ^ expected ^ " Actual: " + ^ Xml_printer.to_string actual | e -> Printexc.to_string e let input_watch handle respawner feedback_processor = @@ -419,6 +421,7 @@ let mkready coqtop = fun () -> coqtop.status <- Ready; Void let rec respawn_coqtop ?(why=Unexpected) coqtop = + if why = Unexpected then warning "Coqtop died badly. Resetting."; clear_handle coqtop.handle; ignore_error (fun () -> coqtop.handle <- @@ -430,7 +433,7 @@ let rec respawn_coqtop ?(why=Unexpected) coqtop = If not, there isn't much we can do ... *) assert (coqtop.handle.alive = true); coqtop.status <- New; - ignore (coqtop.reset_handler why coqtop.handle (mkready coqtop)) + ignore (coqtop.reset_handler coqtop.handle (mkready coqtop)) let spawn_coqtop sup_args = bind_self_as (fun this -> { @@ -438,7 +441,7 @@ let spawn_coqtop sup_args = (fun () -> respawn_coqtop (this ())) (fun msg -> (this ()).feedback_handler msg); sup_args = sup_args; - reset_handler = (fun _ _ k -> k ()); + reset_handler = (fun _ k -> k ()); feedback_handler = (fun _ -> ()); status = New; }) diff --git a/ide/coq.mli b/ide/coq.mli index 7cef6a4d0a..8a1fa3ed15 100644 --- a/ide/coq.mli +++ b/ide/coq.mli @@ -60,7 +60,7 @@ val is_computing : coqtop -> bool val spawn_coqtop : string list -> coqtop (** Create a coqtop process with some command-line arguments. *) -val set_reset_handler : coqtop -> (reset_kind -> unit task) -> unit +val set_reset_handler : coqtop -> unit task -> unit (** Register a handler called when a coqtop dies (badly or on purpose) *) val set_feedback_handler : coqtop -> (Feedback.feedback -> unit) -> unit diff --git a/ide/coqOps.ml b/ide/coqOps.ml index aa1a75db60..1563c7ffb4 100644 --- a/ide/coqOps.ml +++ b/ide/coqOps.ml @@ -12,15 +12,19 @@ open Ideutils open Interface open Feedback -type flag = [ `INCOMPLETE | `UNSAFE | `PROCESSING | `ERROR of string ] -type mem_flag = [ `INCOMPLETE | `UNSAFE | `PROCESSING | `ERROR ] +let b2c = byte_offset_to_char_offset + +type flag = [ `INCOMPLETE | `UNSAFE | `PROCESSING | `ERROR of Loc.t * string | `WARNING of Loc.t * string ] +type mem_flag = [ `INCOMPLETE | `UNSAFE | `PROCESSING | `ERROR | `WARNING ] let mem_flag_of_flag : flag -> mem_flag = function | `ERROR _ -> `ERROR + | `WARNING _ -> `WARNING | (`INCOMPLETE | `UNSAFE | `PROCESSING) as mem_flag -> mem_flag let str_of_flag = function | `UNSAFE -> "U" | `PROCESSING -> "P" | `ERROR _ -> "E" + | `WARNING _ -> "W" | `INCOMPLETE -> "I" class type signals = @@ -44,12 +48,9 @@ module SentenceId : sig val mk_sentence : start:GText.mark -> stop:GText.mark -> flag list -> sentence - val set_flags : sentence -> flag list -> unit val add_flag : sentence -> flag -> unit val has_flag : sentence -> mem_flag -> bool val remove_flag : sentence -> mem_flag -> unit - val same_sentence : sentence -> sentence -> bool - val hidden_edit_id : unit -> int val find_all_tooltips : sentence -> int -> string list val add_tooltip : sentence -> int -> int -> string -> unit val set_index : sentence -> int -> unit @@ -87,18 +88,15 @@ end = struct index = -1; changed_sig = new GUtil.signal (); } - let hidden_edit_id () = decr id; !id let changed s = s.changed_sig#call (s.index, List.map mem_flag_of_flag s.flags) - let set_flags s f = s.flags <- f; changed s let add_flag s f = s.flags <- CList.add_set (=) f s.flags; changed s let has_flag s mf = List.exists (fun f -> mem_flag_of_flag f = mf) s.flags let remove_flag s mf = s.flags <- List.filter (fun f -> mem_flag_of_flag f <> mf) s.flags; changed s - let same_sentence s1 s2 = s1.edit_id = s2.edit_id let find_all_tooltips s off = CList.map_filter (fun (start,stop,t) -> if start <= off && off <= stop then Some t else None) @@ -140,7 +138,7 @@ object method tactic_wizard : string list -> unit task method process_next_phrase : unit task method process_until_end_or_error : unit task - method handle_reset_initial : Coq.reset_kind -> unit task + method handle_reset_initial : unit task method raw_coq_query : string -> unit task method show_goals : unit task method backtrack_last_phrase : unit task @@ -341,8 +339,11 @@ object(self) method private show_goals_aux ?(move_insert=false) () = Coq.PrintOpt.set_printing_width proof#width; if move_insert then begin - buffer#place_cursor ~where:self#get_start_of_input; - script#recenter_insert; + let dest = self#get_start_of_input in + if (buffer#get_iter_at_mark `INSERT)#compare dest <= 0 then begin + buffer#place_cursor ~where:dest; + script#recenter_insert + end end; Coq.bind (Coq.goals ~logger:messages#push ()) (function | Fail x -> self#handle_failure_aux ~move_insert x @@ -402,8 +403,8 @@ object(self) let start_sentence, stop_sentence, phrase = self#get_sentence sentence in let pre_chars, post_chars = if Loc.is_ghost loc then 0, String.length phrase else Loc.unloc loc in - let pre = Ideutils.glib_utf8_pos_to_offset phrase ~off:pre_chars in - let post = Ideutils.glib_utf8_pos_to_offset phrase ~off:post_chars in + let pre = b2c phrase pre_chars in + let post = b2c phrase post_chars in let start = start_sentence#forward_chars pre in let stop = start_sentence#forward_chars post in let markup = Glib.Markup.escape_text text in @@ -446,7 +447,6 @@ object(self) | Processed, Some (id,sentence) -> log "Processed" id; remove_flag sentence `PROCESSING; - remove_flag sentence `ERROR; self#mark_as_needed sentence | ProcessingIn _, Some (id,sentence) -> log "ProcessingIn" id; @@ -464,14 +464,25 @@ object(self) log "GlobRef" id; self#attach_tooltip sentence loc (Printf.sprintf "%s %s %s" filepath ident ty) - | ErrorMsg(loc, msg), Some (id,sentence) -> + | Message(Error, loc, msg), Some (id,sentence) -> + let loc = Option.default Loc.ghost loc in + let msg = Richpp.raw_print msg in log "ErrorMsg" id; remove_flag sentence `PROCESSING; - add_flag sentence (`ERROR msg); + add_flag sentence (`ERROR (loc, msg)); self#mark_as_needed sentence; self#attach_tooltip sentence loc msg; if not (Loc.is_ghost loc) then self#position_error_tag_at_sentence sentence (Some (Loc.unloc loc)) + | Message(Warning, loc, msg), Some (id,sentence) -> + let loc = Option.default Loc.ghost loc in + let msg = Richpp.raw_print msg in + log "WarningMsg" id; + add_flag sentence (`WARNING (loc, msg)); + self#attach_tooltip sentence loc msg; + self#position_warning_tag_at_sentence sentence loc + | Message((Info|Notice|Debug as lvl), _, msg), _ -> + messages#push lvl msg | InProgress n, _ -> if n < 0 then processed <- processed + abs n else to_process <- to_process + n @@ -506,13 +517,25 @@ object(self) | None -> () | Some (start, stop) -> buffer#apply_tag Tags.Script.error - ~start:(iter#forward_chars (byte_offset_to_char_offset phrase start)) - ~stop:(iter#forward_chars (byte_offset_to_char_offset phrase stop)) + ~start:(iter#forward_chars (b2c phrase start)) + ~stop:(iter#forward_chars (b2c phrase stop)) method private position_error_tag_at_sentence sentence loc = let start, _, phrase = self#get_sentence sentence in self#position_error_tag_at_iter start phrase loc + method private position_warning_tag_at_iter iter_start iter_stop phrase loc = + if Loc.is_ghost loc then + buffer#apply_tag Tags.Script.warning ~start:iter_start ~stop:iter_stop + else + buffer#apply_tag Tags.Script.warning + ~start:(iter_start#forward_chars (b2c phrase loc.Loc.bp)) + ~stop:(iter_stop#forward_chars (b2c phrase loc.Loc.ep)) + + method private position_warning_tag_at_sentence sentence loc = + let start, stop, phrase = self#get_sentence sentence in + self#position_warning_tag_at_iter start stop phrase loc + method private process_interp_error queue sentence loc msg tip id = Coq.bind (Coq.return ()) (function () -> let start, stop, phrase = self#get_sentence sentence in @@ -523,7 +546,7 @@ object(self) self#position_error_tag_at_iter start phrase loc; buffer#place_cursor ~where:stop; messages#clear; - messages#push Pp.Error msg; + messages#push Feedback.Error msg; self#show_goals end else self#show_goals_aux ~move_insert:true () @@ -539,13 +562,19 @@ object(self) condition returns true; it is fed with the number of phrases read and the iters enclosing the current sentence. *) method private fill_command_queue until queue = + let topstack = + if Doc.focused document then fst (Doc.context document) else [] in let rec loop n iter = match Sentence.find buffer iter with | None -> () | Some (start, stop) -> if until n start stop then begin () - end else if stop#backward_char#has_tag Tags.Script.processed then begin + end else if + List.exists (fun (_, s) -> + start#equal (buffer#get_iter_at_mark s.start) && + stop#equal (buffer#get_iter_at_mark s.stop)) topstack + then begin Queue.push (`Skip (start, stop)) queue; loop n stop end else begin @@ -599,7 +628,8 @@ object(self) if Queue.is_empty queue then conclude topstack else match Queue.pop queue, topstack with | `Skip(start,stop), [] -> - logger Pp.Error (Richpp.richpp_of_string "You must close the proof with Qed or Admitted"); + + logger Feedback.Error (Richpp.richpp_of_string "You must close the proof with Qed or Admitted"); self#discard_command_queue queue; conclude [] | `Skip(start,stop), (_,s) :: topstack -> @@ -615,7 +645,7 @@ object(self) let handle_answer = function | Good (id, (Util.Inl (* NewTip *) (), msg)) -> Doc.assign_tip_id document id; - logger Pp.Notice (Richpp.richpp_of_string msg); + logger Feedback.Notice (Richpp.richpp_of_string msg); self#commit_queue_transaction sentence; loop id [] | Good (id, (Util.Inr (* Unfocus *) tip, msg)) -> @@ -623,7 +653,7 @@ object(self) let topstack, _ = Doc.context document in self#exit_focus; self#cleanup (Doc.cut_at document tip); - logger Pp.Notice (Richpp.richpp_of_string msg); + logger Feedback.Notice (Richpp.richpp_of_string msg); self#mark_as_needed sentence; if Queue.is_empty queue then loop tip [] else loop tip (List.rev topstack) @@ -642,7 +672,7 @@ object(self) let next = function | Good _ -> messages#clear; - messages#push Pp.Info (Richpp.richpp_of_string "All proof terms checked by the kernel"); + messages#push Feedback.Info (Richpp.richpp_of_string "All proof terms checked by the kernel"); Coq.return () | Fail x -> self#handle_failure x in Coq.bind (Coq.status ~logger:messages#push true) next @@ -658,7 +688,15 @@ object(self) method get_errors = let extract_error s = match List.find (function `ERROR _ -> true | _ -> false) s.flags with - | `ERROR msg -> (buffer#get_iter_at_mark s.start)#line + 1, msg + | `ERROR (loc, msg) -> + let iter = + if Loc.is_ghost loc then + buffer#get_iter_at_mark s.start + else + let (iter, _, phrase) = self#get_sentence s in + let (start, _) = Loc.unloc loc in + iter#forward_chars (b2c phrase start) in + iter#line + 1, msg | _ -> assert false in List.rev (Doc.fold_all document [] (fun acc _ _ s -> @@ -736,8 +774,8 @@ object(self) self#cleanup (Doc.cut_at document to_id); conclusion () | Fail (safe_id, loc, msg) -> - if loc <> None then messages#push Pp.Error (Richpp.richpp_of_string "Fixme LOC"); - messages#push Pp.Error msg; +(* if loc <> None then messages#push Feedback.Error (Richpp.richpp_of_string "Fixme LOC"); *) + messages#push Feedback.Error msg; if Stateid.equal safe_id Stateid.dummy then self#show_goals else undo safe_id (Doc.focused document && Doc.is_in_focus document safe_id)) @@ -754,8 +792,7 @@ object(self) method private handle_failure_aux ?(move_insert=false) (safe_id, (loc : (int * int) option), msg) = - messages#clear; - messages#push Pp.Error msg; + messages#push Feedback.Error msg; ignore(self#process_feedback ()); if Stateid.equal safe_id Stateid.dummy then Coq.lift (fun () -> ()) else @@ -837,10 +874,8 @@ object(self) in loop l - method handle_reset_initial why = + method handle_reset_initial = let action () = - if why = Coq.Unexpected then warning "Coqtop died badly. Resetting." - else (* clear the stack *) if Doc.focused document then Doc.unfocus document; while not (Doc.is_empty document) do diff --git a/ide/coqOps.mli b/ide/coqOps.mli index 4a37a1fa55..332c18f2f0 100644 --- a/ide/coqOps.mli +++ b/ide/coqOps.mli @@ -15,7 +15,7 @@ object method tactic_wizard : string list -> unit task method process_next_phrase : unit task method process_until_end_or_error : unit task - method handle_reset_initial : Coq.reset_kind -> unit task + method handle_reset_initial : unit task method raw_coq_query : string -> unit task method show_goals : unit task method backtrack_last_phrase : unit task diff --git a/ide/coqide.ml b/ide/coqide.ml index 1fe393d2b9..450bfcdfb1 100644 --- a/ide/coqide.ml +++ b/ide/coqide.ml @@ -677,12 +677,18 @@ let searchabout sn = let searchabout () = on_current_term searchabout +let doquery query sn = + sn.messages#clear; + Coq.try_grab sn.coqtop (sn.coqops#raw_coq_query query) ignore + let otherquery command sn = - let word = get_current_word sn in - if word <> "" then - let query = command ^ " " ^ word ^ "." in - sn.messages#clear; - Coq.try_grab sn.coqtop (sn.coqops#raw_coq_query query) ignore + Option.iter (fun query -> doquery (query ^ ".") sn) + begin try + let i = CString.string_index_from command 0 "..." in + let word = get_current_word sn in + if word = "" then None + else Some (CString.sub command 0 i ^ " " ^ word) + with Not_found -> Some command end let otherquery command = cb_on_current_term (otherquery command) @@ -783,7 +789,7 @@ let coqtop_arguments sn = let args = String.concat " " args in let msg = Printf.sprintf "Invalid arguments: %s" args in let () = sn.messages#clear in - sn.messages#push Pp.Error (Richpp.richpp_of_string msg) + sn.messages#push Feedback.Error (Richpp.richpp_of_string msg) else dialog#destroy () in let _ = entry#connect#activate ok_cb in @@ -859,12 +865,12 @@ let toggle_items menu_name l = in List.iter f l +let no_under = Util.String.map (fun x -> if x = '_' then '-' else x) + (** Create alphabetical menu items with elements in sub-items. [l] is a list of lists, one per initial letter *) let alpha_items menu_name item_name l = - let no_under = Util.String.map (fun x -> if x = '_' then '-' else x) - in let mk_item text = let text' = let last = String.length text - 1 in @@ -911,6 +917,16 @@ let template_item (text, offset, len, key) = in item name ~label ~callback:(cb_on_current_term callback) ~accel:(modifier^key) +(** Create menu items for pairs (query, shortcut key). *) +let user_queries_items menu_name item_name l = + let mk_item (query, key) = + let callback = Query.query query in + let accel = if not (CString.is_empty key) then + Some (modifier_for_queries#get^key) else None in + item (item_name^" "^(no_under query)) ~label:query ?accel ~callback menu_name + in + List.iter mk_item l + let emit_to_focus window sgn = let focussed_widget = GtkWindow.Window.get_focus window#as_window in let obj = Gobject.unsafe_cast focussed_widget in @@ -921,7 +937,6 @@ let emit_to_focus window sgn = let build_ui () = let w = GWindow.window ~wm_class:"CoqIde" ~wm_name:"CoqIde" - ~allow_grow:true ~allow_shrink:true ~width:window_width#get ~height:window_height#get ~title:"CoqIde" () in @@ -1100,16 +1115,22 @@ let build_ui () = ]; alpha_items templates_menu "Template" Coq_commands.commands; - let qitem s accel = item s ~label:("_"^s) ?accel ~callback:(Query.query s) in + let qitem s sc ?(dots = true) = + let query = if dots then s ^ "..." else s in + item s ~label:("_"^s) + ~accel:(modifier_for_queries#get^sc) + ~callback:(Query.query query) + in menu queries_menu [ item "Queries" ~label:"_Queries"; - qitem "Search" (Some "<Ctrl><Shift>K"); - qitem "Check" (Some "<Ctrl><Shift>C"); - qitem "Print" (Some "<Ctrl><Shift>P"); - qitem "About" (Some "<Ctrl><Shift>A"); - qitem "Locate" (Some "<Ctrl><Shift>L"); - qitem "Print Assumptions" (Some "<Ctrl><Shift>N"); + qitem "Search" "K" ~dots:false; + qitem "Check" "C"; + qitem "Print" "P"; + qitem "About" "A"; + qitem "Locate" "L"; + qitem "Print Assumptions" "N"; ]; + user_queries_items queries_menu "User-Query" user_queries#get; menu tools_menu [ item "Tools" ~label:"_Tools"; diff --git a/ide/coqide_ui.ml b/ide/coqide_ui.ml index edfe28b261..2ae18593ac 100644 --- a/ide/coqide_ui.ml +++ b/ide/coqide_ui.ml @@ -18,6 +18,15 @@ let list_items menu li = let () = List.iter (fun b -> Buffer.add_buffer res_buf (tactic_item b)) li in res_buf +let list_queries menu li = + let res_buf = Buffer.create 500 in + let query_item (q, _) = + let s = "<menuitem action='"^menu^" "^(no_under q)^"' />\n" in + Buffer.add_string res_buf s + in + let () = List.iter query_item li in + res_buf + let init () = let theui = Printf.sprintf "<ui> <menubar name='CoqIde MenuBar'> @@ -119,6 +128,8 @@ let init () = <menuitem action='About' /> <menuitem action='Locate' /> <menuitem action='Print Assumptions' /> + <separator /> + %s </menu> <menu name='Tools' action='Tools'> <menuitem action='Comment' /> @@ -162,5 +173,6 @@ let init () = (if Coq_config.gtk_platform <> `QUARTZ then "<menuitem action='Quit' />" else "") (Buffer.contents (list_items "Tactic" Coq_commands.tactics)) (Buffer.contents (list_items "Template" Coq_commands.commands)) + (Buffer.contents (list_queries "User-Query" Preferences.user_queries#get)) in ignore (ui_m#add_ui_from_string theui); diff --git a/ide/coqidetop.mllib b/ide/coqidetop.mllib index 92301dc30e..ed1fa465d2 100644 --- a/ide/coqidetop.mllib +++ b/ide/coqidetop.mllib @@ -1,2 +1,9 @@ +Xml_lexer +Xml_parser +Xml_printer +Serialize +Richprinter Xmlprotocol +Texmacspp +Document Ide_slave diff --git a/ide/ide.mllib b/ide/ide.mllib index 83b3142839..72a14134bf 100644 --- a/ide/ide.mllib +++ b/ide/ide.mllib @@ -1,12 +1,7 @@ Minilib -Okey -Config_file -Configwin_keys -Configwin_types Configwin_messages Configwin_ihm Configwin -Editable_cells Config_parser Tags Wg_Notebook @@ -14,8 +9,13 @@ Config_lexer Utf8_convert Preferences Project_file -Ideutils +Serialize +Richprinter +Xml_lexer +Xml_parser +Xml_printer Xmlprotocol +Ideutils Coq Coq_lex Sentence diff --git a/ide/ide_slave.ml b/ide/ide_slave.ml index 9a3e85e47d..48fd0a93e4 100644 --- a/ide/ide_slave.ml +++ b/ide/ide_slave.ml @@ -1,4 +1,5 @@ (************************************************************************) + (* v * The Coq Proof Assistant / The Coq Development Team *) (* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) (* \VV/ **************************************************************) @@ -7,11 +8,15 @@ (************************************************************************) open Vernacexpr -open Errors +open CErrors open Util open Pp open Printer +module RelDecl = Context.Rel.Declaration +module NamedDecl = Context.Named.Declaration +module CompactedDecl = Context.Compacted.Declaration + (** Ide_slave : an implementation of [Interface], i.e. mainly an interp function and a rewind function. This specialized loop is triggered when the -ideslave option is passed to Coqtop. Currently CoqIDE is @@ -47,6 +52,7 @@ let init_stdout, read_stdout = let pr_with_pid s = Printf.eprintf "[pid %d] %s\n%!" (Unix.getpid ()) s +let pr_error s = pr_with_pid s let pr_debug s = if !Flags.debug then pr_with_pid s let pr_debug_call q = @@ -94,15 +100,15 @@ let is_undo cmd = match cmd with (** Check whether a command is forbidden by CoqIDE *) let coqide_cmd_checks (loc,ast) = - let user_error s = Errors.user_err_loc (loc, "CoqIde", str s) in + let user_error s = CErrors.user_err ~loc ~hdr:"CoqIde" (str s) in if is_debug ast then user_error "Debug mode not available within CoqIDE"; if is_known_option ast then - msg_warning (strbrk"This will not work. Use CoqIDE display menu instead"); + Feedback.msg_warning (strbrk"This will not work. Use CoqIDE view menu instead"); if Vernac.is_navigation_vernac ast || is_undo ast then - msg_warning (strbrk "Rather use CoqIDE navigation instead"); + Feedback.msg_warning (strbrk "Rather use CoqIDE navigation instead"); if is_query ast then - msg_warning (strbrk "Query commands should not be inserted in scripts") + Feedback.msg_warning (strbrk "Query commands should not be inserted in scripts") (** Interpretation (cf. [Ide_intf.interp]) *) @@ -131,7 +137,8 @@ let annotate phrase = (** Goal display *) let hyp_next_tac sigma env decl = - let (id,_,ast) = Context.Named.Declaration.to_tuple decl in + let id = NamedDecl.get_id decl in + let ast = NamedDecl.get_type decl in let id_s = Names.Id.to_string id in let type_s = string_of_ppcmds (pr_ltype_env env sigma ast) in [ @@ -188,16 +195,12 @@ let process_goal sigma g = Richpp.richpp_of_pp (pr_goal_concl_style_env env sigma norm_constr) in let process_hyp d (env,l) = - let d = Context.NamedList.Declaration.map_constr (Reductionops.nf_evar sigma) d in - let d' = List.map (fun name -> let open Context.Named.Declaration in - match pi2 d with - | None -> LocalAssum (name, pi3 d) - | Some value -> LocalDef (name, value, pi3 d)) - (pi1 d) in + let d = CompactedDecl.map_constr (Reductionops.nf_evar sigma) d in + let d' = CompactedDecl.to_named_context d in (List.fold_right Environ.push_named d' env, - (Richpp.richpp_of_pp (pr_var_list_decl env sigma d)) :: l) in + (Richpp.richpp_of_pp (pr_compacted_decl env sigma d)) :: l) in let (_env, hyps) = - Context.NamedList.fold process_hyp + Context.Compacted.fold process_hyp (Termops.compact_named_context (Environ.named_context env)) ~init:(min_env,[]) in { Interface.goal_hyp = List.rev hyps; Interface.goal_ccl = ccl; Interface.goal_id = id; } @@ -212,7 +215,7 @@ let export_pre_goals pgs = let goals () = Stm.finish (); let s = read_stdout () in - if not (String.is_empty s) then msg_info (str s); + if not (String.is_empty s) then Feedback.msg_info (str s); try let pfts = Proof_global.give_me_the_proof () in Some (export_pre_goals (Proof.map_structured_proof pfts process_goal)) @@ -222,7 +225,7 @@ let evars () = try Stm.finish (); let s = read_stdout () in - if not (String.is_empty s) then msg_info (str s); + if not (String.is_empty s) then Feedback.msg_info (str s); let pfts = Proof_global.give_me_the_proof () in let { Evd.it = all_goals ; sigma = sigma } = Proof.V82.subgoals pfts in let exl = Evar.Map.bindings (Evarutil.non_instantiated sigma) in @@ -255,7 +258,7 @@ let status force = Stm.finish (); if force then Stm.join (); let s = read_stdout () in - if not (String.is_empty s) then msg_info (str s); + if not (String.is_empty s) then Feedback.msg_info (str s); let path = let l = Names.DirPath.repr (Lib.cwd ()) in List.rev_map Names.Id.to_string l @@ -281,11 +284,33 @@ let export_coq_object t = { Interface.coq_object_object = t.Search.coq_object_object } +let pattern_of_string ?env s = + let env = + match env with + | None -> Global.env () + | Some e -> e + in + let constr = Pcoq.parse_string Pcoq.Constr.lconstr_pattern s in + let (_, pat) = Constrintern.intern_constr_pattern env constr in + pat + +let dirpath_of_string_list s = + let path = String.concat "." s in + let m = Pcoq.parse_string Pcoq.Constr.global path in + let (_, qid) = Libnames.qualid_of_reference m in + let id = + try Nametab.full_name_module qid + with Not_found -> + CErrors.user_err ~hdr:"Search.interface_search" + (str "Module " ++ str path ++ str " not found.") + in + id + let import_search_constraint = function - | Interface.Name_Pattern s -> Search.Name_Pattern s - | Interface.Type_Pattern s -> Search.Type_Pattern s - | Interface.SubType_Pattern s -> Search.SubType_Pattern s - | Interface.In_Module ms -> Search.In_Module ms + | Interface.Name_Pattern s -> Search.Name_Pattern (Str.regexp s) + | Interface.Type_Pattern s -> Search.Type_Pattern (pattern_of_string s) + | Interface.SubType_Pattern s -> Search.SubType_Pattern (pattern_of_string s) + | Interface.In_Module ms -> Search.In_Module (dirpath_of_string_list ms) | Interface.Include_Blacklist -> Search.Include_Blacklist let search flags = @@ -341,12 +366,12 @@ let handle_exn (e, info) = | _ -> None in let mk_msg () = let msg = read_stdout () in - let msg = str msg ++ fnl () ++ Errors.print ~info e in + let msg = str msg ++ fnl () ++ CErrors.print ~info e in Richpp.richpp_of_pp msg in match e with - | Errors.Drop -> dummy, None, Richpp.richpp_of_string "Drop is not allowed by coqide!" - | Errors.Quit -> dummy, None, Richpp.richpp_of_string "Quit is not allowed by coqide!" + | CErrors.Drop -> dummy, None, Richpp.richpp_of_string "Drop is not allowed by coqide!" + | CErrors.Quit -> dummy, None, Richpp.richpp_of_string "Quit is not allowed by coqide!" | e -> match Stateid.get info with | Some (valid, _) -> valid, loc_of info, mk_msg () @@ -361,8 +386,6 @@ let init = match file with | None -> Stm.get_current_state () | Some file -> - if not (Filename.check_suffix file ".v") then - error "A file with suffix .v is expected."; let dir = Filename.dirname file in let open Loadpath in let open CUnix in let initial_id, _ = @@ -393,6 +416,15 @@ let interp ((_raw, verbose), s) = let quit = ref false +(** Serializes the output of Stm.get_ast *) +let print_ast id = + match Stm.get_ast id with + | Some (expr, loc) -> begin + try Texmacspp.tmpp expr loc + with e -> Xml_datatype.PCData ("ERROR " ^ Printexc.to_string e) + end + | None -> Xml_datatype.PCData "ERROR" + (** Grouping all call handlers together + error handling *) let eval_call xml_oc log c = @@ -423,7 +455,7 @@ let eval_call xml_oc log c = Interface.interp = interruptible interp; Interface.handle_exn = handle_exn; Interface.stop_worker = Stm.stop_worker; - Interface.print_ast = Stm.print_ast; + Interface.print_ast = print_ast; Interface.annotate = interruptible annotate; } in Xmlprotocol.abstract_eval_call handler c @@ -438,22 +470,18 @@ let print_xml = fun oc xml -> Mutex.lock m; try Xml_printer.print oc xml; Mutex.unlock m - with e -> let e = Errors.push e in Mutex.unlock m; iraise e + with e -> let e = CErrors.push e in Mutex.unlock m; iraise e -let slave_logger xml_oc level message = +let slave_logger xml_oc ?loc level message = (* convert the message into XML *) let msg = hov 0 message in - let message = { - Pp.message_level = level; - Pp.message_content = (Richpp.repr (Richpp.richpp_of_pp msg)); - } in - let () = pr_debug (Printf.sprintf "-> %S" (string_of_ppcmds msg)) in - let xml = Pp.of_message message in + let () = pr_debug (Printf.sprintf "-> %S" (string_of_ppcmds msg)) in + let xml = Xmlprotocol.of_message level loc (Richpp.richpp_of_pp message) in print_xml xml_oc xml let slave_feeder xml_oc msg = - let xml = Feedback.of_feedback msg in + let xml = Xmlprotocol.of_feedback msg in print_xml xml_oc xml (** The main loop *) @@ -471,8 +499,8 @@ let loop () = CThread.thread_friendly_read in_ch s ~off:0 ~len) in let xml_ic = Xml_parser.make (Xml_parser.SLexbuf in_lb) in let () = Xml_parser.check_eof xml_ic false in - set_logger (slave_logger xml_oc); - set_feeder (slave_feeder xml_oc); + Feedback.set_logger (slave_logger xml_oc); + Feedback.add_feeder (slave_feeder xml_oc); (* We'll handle goal fetching and display in our own way *) Vernacentries.enable_goal_printing := false; Vernacentries.qed_display_script := false; @@ -482,7 +510,7 @@ let loop () = (* pr_with_pid (Xml_printer.to_string_fmt xml_query); *) let Xmlprotocol.Unknown q = Xmlprotocol.to_call xml_query in let () = pr_debug_call q in - let r = eval_call xml_oc (slave_logger xml_oc Pp.Notice) q in + let r = eval_call xml_oc (slave_logger xml_oc Feedback.Notice) q in let () = pr_debug_answer q r in (* pr_with_pid (Xml_printer.to_string_fmt (Xmlprotocol.of_answer q r)); *) print_xml xml_oc (Xmlprotocol.of_answer q r); @@ -492,11 +520,11 @@ let loop () = pr_debug "End of input, exiting gracefully."; exit 0 | Xml_parser.Error (err, loc) -> - pr_debug ("Syntax error in query: " ^ Xml_parser.error_msg err); - exit 1 - | Serialize.Marshal_error -> - pr_debug "Incorrect query."; - exit 1 + pr_error ("XML syntax error: " ^ Xml_parser.error_msg err) + | Serialize.Marshal_error (msg,node) -> + pr_error "Unexpected XML message"; + pr_error ("Expected XML node: " ^ msg); + pr_error ("XML tree received: " ^ Xml_printer.to_string_fmt node) | any -> pr_debug ("Fatal exception in coqtop:\n" ^ Printexc.to_string any); exit 1 diff --git a/ide/ideutils.ml b/ide/ideutils.ml index 508881cad8..06a1327320 100644 --- a/ide/ideutils.ml +++ b/ide/ideutils.ml @@ -46,23 +46,37 @@ let xml_to_string xml = let () = iter (Richpp.repr xml) in Buffer.contents buf -let translate s = s - -let insert_xml ?(tags = []) (buf : #GText.buffer_skel) msg = +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 + a slow algorithm, so that we have to have our own quicker version here. + Alas, it is still much slower than the native version... *) + if CList.is_empty tags then buf#insert ~iter:(buf#get_iter_at_mark mark) text + else + let it = buf#get_iter_at_mark mark in + let () = buf#move_mark rmark ~where:it in + 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 + List.iter iter tags + +let insert_xml ?(mark = `INSERT) ?(tags = []) (buf : #GText.buffer_skel) msg = let open Xml_datatype in let tag name = - let name = translate name in match GtkText.TagTable.lookup buf#tag_table name with | None -> raise Not_found | Some tag -> new GText.tag tag in + let rmark = `MARK (buf#create_mark buf#start_iter) in let rec insert tags = function - | PCData s -> buf#insert ~tags:(List.rev tags) s + | PCData s -> insert_with_tags buf mark rmark tags s | Element (t, _, children) -> let tags = try tag t :: tags with Not_found -> tags in List.iter (fun xml -> insert tags xml) children in - insert tags (Richpp.repr msg) + let () = try insert tags (Richpp.repr msg) with _ -> () in + buf#delete_mark rmark let set_location = ref (function s -> failwith "not ready") @@ -112,6 +126,24 @@ let try_convert s = "(* Fatal error: wrong encoding in input. \ Please choose a correct encoding in the preference panel.*)";; +let export file_name s = + let oc = open_out_bin file_name in + let ending = line_ending#get in + let is_windows = ref false in + for i = 0 to String.length s - 1 do + match s.[i] with + | '\r' -> is_windows := true + | '\n' -> + begin match ending with + | `DEFAULT -> + if !is_windows then (output_char oc '\r'; output_char oc '\n') + else output_char oc '\n' + | `WINDOWS -> output_char oc '\r'; output_char oc '\n' + | `UNIX -> output_char oc '\n' + end + | c -> output_char oc c + done; + close_out oc let try_export file_name s = let s = @@ -134,11 +166,7 @@ let try_export file_name s = Minilib.log ("Error ("^str^") in transcoding: falling back to UTF-8"); s in - try - let oc = open_out file_name in - output_string oc s; - close_out oc; - true + try export file_name s; true with e -> Minilib.log (Printexc.to_string e);false type timer = { run : ms:int -> callback:(unit->bool) -> unit; @@ -297,15 +325,15 @@ let textview_width (view : #GText.view_skel) = let char_width = GPango.to_pixels metrics#approx_char_width in pixel_width / char_width -type logger = Pp.message_level -> Richpp.richpp -> unit +type logger = Feedback.level -> Richpp.richpp -> unit let default_logger level message = let level = match level with - | Pp.Debug _ -> `DEBUG - | Pp.Info -> `INFO - | Pp.Notice -> `NOTICE - | Pp.Warning -> `WARNING - | Pp.Error -> `ERROR + | Feedback.Debug -> `DEBUG + | Feedback.Info -> `INFO + | Feedback.Notice -> `NOTICE + | Feedback.Warning -> `WARNING + | Feedback.Error -> `ERROR in Minilib.log ~level (xml_to_string message) diff --git a/ide/ideutils.mli b/ide/ideutils.mli index 4e35a6f9fa..e32a4d9e38 100644 --- a/ide/ideutils.mli +++ b/ide/ideutils.mli @@ -54,7 +54,7 @@ val flash_info : ?delay:int -> string -> unit val xml_to_string : Richpp.richpp -> string -val insert_xml : ?tags:GText.tag list -> +val insert_xml : ?mark:GText.mark -> ?tags:GText.tag list -> #GText.buffer_skel -> Richpp.richpp -> unit val set_location : (string -> unit) ref @@ -69,7 +69,7 @@ val requote : string -> string val textview_width : #GText.view_skel -> int (** Returns an approximate value of the character width of a textview *) -type logger = Pp.message_level -> Richpp.richpp -> unit +type logger = Feedback.level -> Richpp.richpp -> unit val default_logger : logger (** Default logger. It logs messages that the casual user should not see. *) diff --git a/ide/preferences.ml b/ide/preferences.ml index addea9074a..f0fd45d77f 100644 --- a/ide/preferences.ml +++ b/ide/preferences.ml @@ -33,6 +33,7 @@ type obj = { } let preferences : obj Util.String.Map.t ref = ref Util.String.Map.empty +let unknown_preferences : string list Util.String.Map.t ref = ref Util.String.Map.empty class type ['a] repr = object @@ -121,6 +122,18 @@ let inputenc_of_string s = else if s = "LOCALE" then Elocale else Emanual s) +type line_ending = [ `DEFAULT | `WINDOWS | `UNIX ] + +let line_end_of_string = function +| "unix" -> `UNIX +| "windows" -> `WINDOWS +| _ -> `DEFAULT + +let line_end_to_string = function +| `UNIX -> "unix" +| `WINDOWS -> "windows" +| `DEFAULT -> "default" + let use_default_doc_url = "(automatic)" module Repr = @@ -144,6 +157,18 @@ object method into s = Some s end +let string_pair_list (sep : char) : (string * string) list repr = +object + val sep' = String.make 1 sep + method from = CList.map (fun (s1, s2) -> CString.concat sep' [s1; s2]) + method into l = + try + Some (CList.map (fun s -> + let split = CString.split sep s in + CList.nth split 0, CList.nth split 1) l) + with Failure _ -> None +end + let bool : bool repr = object method from s = [string_of_bool s] @@ -303,10 +328,14 @@ let modifier_for_tactics = let modifier_for_display = new preference ~name:["modifier_for_display"] ~init:"<Alt><Shift>" ~repr:Repr.(string) +let modifier_for_queries = + new preference ~name:["modifier_for_queries"] ~init:"<Control><Shift>" ~repr:Repr.(string) + let _ = attach_modifiers modifier_for_navigation "<Actions>/Navigation/" let _ = attach_modifiers modifier_for_templates "<Actions>/Templates/" let _ = attach_modifiers modifier_for_tactics "<Actions>/Tactics/" let _ = attach_modifiers modifier_for_display "<Actions>/View/" +let _ = attach_modifiers modifier_for_queries "<Actions>/Queries/" let modifiers_valid = new preference ~name:["modifiers_valid"] ~init:"<Alt><Control><Shift>" ~repr:Repr.(string) @@ -365,6 +394,10 @@ let stop_before = let reset_on_tab_switch = new preference ~name:["reset_on_tab_switch"] ~init:false ~repr:Repr.(bool) +let line_ending = + let repr = Repr.custom line_end_to_string line_end_of_string in + new preference ~name:["line_ending"] ~init:`DEFAULT ~repr + let vertical_tabs = new preference ~name:["vertical_tabs"] ~init:false ~repr:Repr.(bool) @@ -386,14 +419,6 @@ let processing_color = let _ = attach_bg processing_color Tags.Script.to_process let _ = attach_bg processing_color Tags.Script.incomplete -let default_tag = { - tag_fg_color = None; - tag_bg_color = None; - tag_bold = false; - tag_italic = false; - tag_underline = false; -} - let tags = ref Util.String.Map.empty let list_tags () = !tags @@ -443,7 +468,7 @@ let create_tag name default = let iter table = let tag = GText.tag ~name () in table#add tag#as_tag; - pref#connect#changed (fun _ -> set_tag tag); + ignore (pref#connect#changed (fun _ -> set_tag tag)); set_tag tag; in List.iter iter [Tags.Script.table; Tags.Proof.table; Tags.Message.table]; @@ -515,6 +540,9 @@ let highlight_current_line = let nanoPG = new preference ~name:["nanoPG"] ~init:false ~repr:Repr.(bool) +let user_queries = + new preference ~name:["user_queries"] ~init:[] ~repr:Repr.(string_pair_list '$') + class tag_button (box : Gtk.box Gtk.obj) = object (self) @@ -590,19 +618,19 @@ let save_pref () = then Unix.mkdir (Minilib.coqide_config_home ()) 0o700; let () = try GtkData.AccelMap.save accel_file with _ -> () in let add = Util.String.Map.add in - let (++) x f = f x in let fold key obj accu = add key (obj.get ()) accu in - - (Util.String.Map.fold fold !preferences Util.String.Map.empty) ++ - Config_lexer.print_file pref_file + let prefs = Util.String.Map.fold fold !preferences Util.String.Map.empty in + let prefs = Util.String.Map.fold Util.String.Map.add !unknown_preferences prefs in + Config_lexer.print_file pref_file prefs let load_pref () = let () = try GtkData.AccelMap.load loaded_accel_file with _ -> () in let m = Config_lexer.load_file loaded_pref_file in let iter name v = - try (Util.String.Map.find name !preferences).set v - with _ -> () + if Util.String.Map.mem name !preferences then + try (Util.String.Map.find name !preferences).set v with _ -> () + else unknown_preferences := Util.String.Map.add name v !unknown_preferences in Util.String.Map.iter iter m @@ -807,6 +835,15 @@ let configure ?(apply=(fun () -> ())) () = (string_of_inputenc encoding#get) in + let line_ending = + combo + "EOL character" + ~f:(fun s -> line_ending#set (line_end_of_string s)) + ~new_allowed:false + ["unix"; "windows"; "default"] + (line_end_to_string line_ending#get) + in + let source_style = combo "Highlighting style:" ~f:source_style#set ~new_allowed:false @@ -845,6 +882,9 @@ let configure ?(apply=(fun () -> ())) () = let modifier_for_display = pmodifiers "Modifiers for View Menu" modifier_for_display in + let modifier_for_queries = + pmodifiers "Modifiers for Queries Menu" modifier_for_queries + in let modifiers_valid = pmodifiers ~all:true "Allowed modifiers" modifiers_valid in @@ -878,7 +918,7 @@ let configure ?(apply=(fun () -> ())) () = in let doc_url = let predefined = [ - "file://"^(List.fold_left Filename.concat (Coq_config.docdir) ["html";"refman";""]); + "file://"^(List.fold_left Filename.concat (Coq_config.docdir) ["refman";"html"]); Coq_config.wwwrefman; use_default_doc_url ] in @@ -891,7 +931,7 @@ let configure ?(apply=(fun () -> ())) () = doc_url#get in let library_url = let predefined = [ - "file://"^(List.fold_left Filename.concat (Coq_config.docdir) ["html";"stdlib";""]); + "file://"^(List.fold_left Filename.concat (Coq_config.docdir) ["stdlib";"html"]); Coq_config.wwwstdlib ] in combo @@ -916,6 +956,36 @@ let configure ?(apply=(fun () -> ())) () = let misc = [contextual_menus_on_goal;stop_before;reset_on_tab_switch; vertical_tabs;opposite_tabs] in + let add_user_query () = + let input_string l v = + match GToolbox.input_string ~title:l v with + | None -> "" + | Some s -> s + in + let q = input_string "User query" "Your query" in + let k = input_string "Shortcut key" "Shortcut (a single letter)" in + let q = CString.map (fun c -> if c = '$' then ' ' else c) q in + (* Anything that is not a simple letter will be ignored. *) + let k = + if Int.equal (CString.length k) 1 && Util.is_letter k.[0] then k + else "" in + let k = CString.uppercase k in + [q, k] + in + + let user_queries = + list + ~f:user_queries#set + (* Disallow same query, key or empty query. *) + ~eq:(fun (q1, k1) (q2, k2) -> k1 = k2 || q1 = "" || q2 = "" || q1 = q2) + ~add:add_user_query + ~titles:["User query"; "Shortcut key"] + "User queries" + (fun (q, s) -> [q; s]) + user_queries#get + + in + (* ATTENTION !!!!! L'onglet Fonts doit etre en premier pour eviter un bug !!!! (shame on Benjamin) *) let cmds = @@ -929,7 +999,7 @@ let configure ?(apply=(fun () -> ())) () = Section("Files", Some `DIRECTORY, [global_auto_revert;global_auto_revert_delay; auto_save; auto_save_delay; (* auto_save_name*) - encodings; + encodings; line_ending; ]); Section("Project", Some (`STOCK "gtk-page-setup"), [project_file_name;read_project; @@ -945,9 +1015,10 @@ let configure ?(apply=(fun () -> ())) () = [automatic_tactics]); Section("Shortcuts", Some `PREFERENCES, [modifiers_valid; modifier_for_tactics; - modifier_for_templates; modifier_for_display; modifier_for_navigation]); + modifier_for_templates; modifier_for_display; modifier_for_navigation; + modifier_for_queries; user_queries]); Section("Misc", Some `ADD, - misc)] + misc)] in (* Format.printf "before edit: current.text_font = %s@." (Pango.Font.to_string current.text_font); diff --git a/ide/preferences.mli b/ide/preferences.mli index 1733091a58..801869d1dc 100644 --- a/ide/preferences.mli +++ b/ide/preferences.mli @@ -11,6 +11,7 @@ val style_manager : GSourceView2.source_style_scheme_manager type project_behavior = Ignore_args | Append_args | Subst_args type inputenc = Elocale | Eutf8 | Emanual of string +type line_ending = [ `DEFAULT | `WINDOWS | `UNIX ] type tag = { tag_fg_color : string option; @@ -65,6 +66,7 @@ val modifier_for_navigation : string preference val modifier_for_templates : string preference val modifier_for_tactics : string preference val modifier_for_display : string preference +val modifier_for_queries : string preference val modifiers_valid : string preference val cmd_browse : string preference val cmd_editor : string preference @@ -78,6 +80,7 @@ val window_height : int preference val auto_complete : bool preference val stop_before : bool preference val reset_on_tab_switch : bool preference +val line_ending : line_ending preference val vertical_tabs : bool preference val opposite_tabs : bool preference val background_color : string preference @@ -95,6 +98,7 @@ val spaces_instead_of_tabs : bool preference val tab_length : int preference val highlight_current_line : bool preference val nanoPG : bool preference +val user_queries : (string * string) list preference val save_pref : unit -> unit val load_pref : unit -> unit diff --git a/ide/project_file.ml4 b/ide/project_file.ml4 index 081094e2b6..de0720e033 100644 --- a/ide/project_file.ml4 +++ b/ide/project_file.ml4 @@ -56,24 +56,24 @@ let rec process_cmd_line orig_dir ((project_file,makefile,install,opt) as opts) | ("-full"|"-opt") :: r -> process_cmd_line orig_dir (project_file,makefile,install,true) l r | "-impredicative-set" :: r -> - Pp.msg_warning (Pp.str "Please now use \"-arg -impredicative-set\" instead of \"-impredicative-set\" alone to be more uniform."); + Feedback.msg_warning (Pp.str "Please now use \"-arg -impredicative-set\" instead of \"-impredicative-set\" alone to be more uniform."); process_cmd_line orig_dir opts (Arg "-impredicative-set" :: l) r | "-no-install" :: r -> - Pp.msg_warning (Pp.(++) (Pp.str "Option -no-install is deprecated.") (Pp.(++) (Pp.spc ()) (Pp.str "Use \"-install none\" instead"))); + Feedback.msg_warning (Pp.(++) (Pp.str "Option -no-install is deprecated.") (Pp.(++) (Pp.spc ()) (Pp.str "Use \"-install none\" instead"))); process_cmd_line orig_dir (project_file,makefile,NoInstall,opt) l r | "-install" :: d :: r -> - if install <> UnspecInstall then Pp.msg_warning (Pp.str "-install sets more than once."); + if install <> UnspecInstall then Feedback.msg_warning (Pp.str "-install sets more than once."); let install = match d with | "user" -> UserInstall | "none" -> NoInstall | "global" -> TraditionalInstall - | _ -> Pp.msg_warning (Pp.(++) (Pp.str "invalid option '") (Pp.(++) (Pp.str d) (Pp.str "' passed to -install."))); + | _ -> Feedback.msg_warning (Pp.(++) (Pp.str "invalid option '") (Pp.(++) (Pp.str d) (Pp.str "' passed to -install."))); install in process_cmd_line orig_dir (project_file,makefile,install,opt) l r | "-custom" :: com :: dependencies :: file :: r -> - Pp.msg_warning (Pp.app + Feedback.msg_warning (Pp.app (Pp.str "Please now use \"-extra[-phony] result deps command\" instead of \"-custom command deps result\".") (Pp.pr_arg Pp.str "It follows makefile target declaration order and has a clearer semantic.") ); @@ -94,7 +94,7 @@ let rec process_cmd_line orig_dir ((project_file,makefile,install,opt) as opts) let file = CUnix.remove_path_dot (CUnix.correct_path file orig_dir) in let () = match project_file with | None -> () - | Some _ -> Pp.msg_warning (Pp.str + | Some _ -> Feedback.msg_warning (Pp.str "Several features will not work with multiple project files.") in let (opts',l') = process_cmd_line (Filename.dirname file) (Some file,makefile,install,opt) l (parse file) in @@ -109,7 +109,7 @@ let rec process_cmd_line orig_dir ((project_file,makefile,install,opt) as opts) let () = match makefile with |None -> () |Some f -> - Pp.msg_warning (Pp.(++) (Pp.str "Only one output file is genererated. ") (Pp.(++) (Pp.str f) (Pp.str " will not be."))) + Feedback.msg_warning (Pp.(++) (Pp.str "Only one output file is genererated. ") (Pp.(++) (Pp.str f) (Pp.str " will not be."))) in process_cmd_line orig_dir (project_file,Some file,install,opt) l r end | v :: "=" :: def :: r -> diff --git a/ide/richprinter.ml b/ide/richprinter.ml new file mode 100644 index 0000000000..995cef1ac5 --- /dev/null +++ b/ide/richprinter.ml @@ -0,0 +1,23 @@ +open Richpp + +module RichppConstr = Ppconstr.Richpp +module RichppVernac = Ppvernac.Richpp + +type rich_pp = + Ppannotation.t Richpp.located Xml_datatype.gxml + * Xml_datatype.xml + +let get_annotations obj = Pp.Tag.prj obj Ppannotation.tag + +let make_richpp pr ast = + let rich_pp = + rich_pp get_annotations (pr ast) + in + let xml = Ppannotation.( + xml_of_rich_pp tag_of_annotation attributes_of_annotation rich_pp + ) + in + (rich_pp, xml) + +let richpp_vernac = make_richpp RichppVernac.pr_vernac +let richpp_constr = make_richpp RichppConstr.pr_constr_expr diff --git a/ide/richprinter.mli b/ide/richprinter.mli new file mode 100644 index 0000000000..c9e84e3eb4 --- /dev/null +++ b/ide/richprinter.mli @@ -0,0 +1,36 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(** This module provides an entry point to "rich" pretty-printers that + produce pretty-printing as done by {!Printer} but with additional + annotations represented as a semi-structured document. + + To understand what are these annotations and how they are represented + as standard XML attributes, please refer to {!Ppannotation}. + + In addition to these annotations, each node of the semi-structured + document contains a [startpos] and an [endpos] attribute that + relate this node to the raw pretty-printing. + Please refer to {!Richpp} for more details. *) + +(** A rich pretty-print is composed of: *) +type rich_pp = + + (** - a generalized semi-structured document whose attributes are + annotations ; *) + Ppannotation.t Richpp.located Xml_datatype.gxml + + (** - an XML document, representing annotations as usual textual + XML attributes. *) + * Xml_datatype.xml + +(** [richpp_vernac phrase] produces a rich pretty-printing of [phrase]. *) +val richpp_vernac : Vernacexpr.vernac_expr -> rich_pp + +(** [richpp_constr constr] produces a rich pretty-printing of [constr]. *) +val richpp_constr : Constrexpr.constr_expr -> rich_pp diff --git a/ide/sentence.ml b/ide/sentence.ml index 6897779e80..e332682dd0 100644 --- a/ide/sentence.ml +++ b/ide/sentence.ml @@ -16,6 +16,7 @@ let split_slice_lax (buffer:GText.buffer) start stop = buffer#remove_tag ~start ~stop Tags.Script.sentence; buffer#remove_tag ~start ~stop Tags.Script.error; + buffer#remove_tag ~start ~stop Tags.Script.warning; buffer#remove_tag ~start ~stop Tags.Script.error_bg; let slice = buffer#get_text ~start ~stop () in let apply_tag off tag = diff --git a/ide/serialize.ml b/ide/serialize.ml new file mode 100644 index 0000000000..7b568501ed --- /dev/null +++ b/ide/serialize.ml @@ -0,0 +1,121 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +open Xml_datatype + +exception Marshal_error of string * xml + +(** Utility functions *) + +let rec get_attr attr = function + | [] -> raise Not_found + | (k, v) :: l when CString.equal k attr -> v + | _ :: l -> get_attr attr l + +let massoc x l = + try get_attr x l + with Not_found -> raise (Marshal_error("attribute " ^ x,PCData "not there")) + +let constructor t c args = Element (t, ["val", c], args) +let do_match t mf = function + | Element (s, attrs, args) when CString.equal s t -> + let c = massoc "val" attrs in + mf c args + | x -> raise (Marshal_error (t,x)) + +let singleton = function + | [x] -> x + | l -> raise (Marshal_error + ("singleton",PCData ("list of length " ^ string_of_int (List.length l)))) + +let raw_string = function + | [] -> "" + | [PCData s] -> s + | x::_ -> raise (Marshal_error("raw string",x)) + +(** Base types *) + +let of_unit () = Element ("unit", [], []) +let to_unit : xml -> unit = function + | Element ("unit", [], []) -> () + | x -> raise (Marshal_error ("unit",x)) + +let of_bool (b : bool) : xml = + if b then constructor "bool" "true" [] + else constructor "bool" "false" [] +let to_bool : xml -> bool = do_match "bool" (fun s _ -> match s with + | "true" -> true + | "false" -> false + | x -> raise (Marshal_error("bool",PCData x))) + +let of_list (f : 'a -> xml) (l : 'a list) = + Element ("list", [], List.map f l) +let to_list (f : xml -> 'a) : xml -> 'a list = function + | Element ("list", [], l) -> List.map f l + | x -> raise (Marshal_error("list",x)) + +let of_option (f : 'a -> xml) : 'a option -> xml = function + | None -> Element ("option", ["val", "none"], []) + | Some x -> Element ("option", ["val", "some"], [f x]) +let to_option (f : xml -> 'a) : xml -> 'a option = function + | Element ("option", ["val", "none"], []) -> None + | Element ("option", ["val", "some"], [x]) -> Some (f x) + | x -> raise (Marshal_error("option",x)) + +let of_string (s : string) : xml = Element ("string", [], [PCData s]) +let to_string : xml -> string = function + | Element ("string", [], l) -> raw_string l + | x -> raise (Marshal_error("string",x)) + +let of_int (i : int) : xml = Element ("int", [], [PCData (string_of_int i)]) +let to_int : xml -> int = function + | Element ("int", [], [PCData s]) -> + (try int_of_string s with Failure _ -> raise(Marshal_error("int",PCData s))) + | x -> raise (Marshal_error("int",x)) + +let of_pair (f : 'a -> xml) (g : 'b -> xml) (x : 'a * 'b) : xml = + Element ("pair", [], [f (fst x); g (snd x)]) +let to_pair (f : xml -> 'a) (g : xml -> 'b) : xml -> 'a * 'b = function + | Element ("pair", [], [x; y]) -> (f x, g y) + | x -> raise (Marshal_error("pair",x)) + +let of_union (f : 'a -> xml) (g : 'b -> xml) : ('a,'b) CSig.union -> xml = function + | CSig.Inl x -> Element ("union", ["val","in_l"], [f x]) + | CSig.Inr x -> Element ("union", ["val","in_r"], [g x]) +let to_union (f : xml -> 'a) (g : xml -> 'b) : xml -> ('a,'b) CSig.union = function + | Element ("union", ["val","in_l"], [x]) -> CSig.Inl (f x) + | Element ("union", ["val","in_r"], [x]) -> CSig.Inr (g x) + | x -> raise (Marshal_error("union",x)) + +(** More elaborate types *) + +let of_edit_id i = Element ("edit_id",["val",string_of_int i],[]) +let to_edit_id = function + | Element ("edit_id",["val",i],[]) -> + let id = int_of_string i in + assert (id <= 0 ); + id + | x -> raise (Marshal_error("edit_id",x)) + +let of_loc loc = + let start, stop = Loc.unloc loc in + Element ("loc",[("start",string_of_int start);("stop",string_of_int stop)],[]) +let to_loc xml = + match xml with + | Element ("loc", l,[]) -> + let start = massoc "start" l in + let stop = massoc "stop" l in + (try + Loc.make_loc (int_of_string start, int_of_string stop) + with Not_found | Invalid_argument _ -> raise (Marshal_error("loc",PCData(start^":"^stop)))) + | x -> raise (Marshal_error("loc",x)) + +let of_xml x = Element ("xml", [], [x]) +let to_xml xml = match xml with +| Element ("xml", [], [x]) -> x +| x -> raise (Marshal_error("xml",x)) diff --git a/ide/serialize.mli b/ide/serialize.mli new file mode 100644 index 0000000000..bf9e184ebb --- /dev/null +++ b/ide/serialize.mli @@ -0,0 +1,39 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +open Xml_datatype + +exception Marshal_error of string * xml + +val massoc: string -> (string * string) list -> string +val constructor: string -> string -> xml list -> xml +val do_match: string -> (string -> xml list -> 'b) -> xml -> 'b +val singleton: 'a list -> 'a +val raw_string: xml list -> string +val of_unit: unit -> xml +val to_unit: xml -> unit +val of_bool: bool -> xml +val to_bool: xml -> bool +val of_list: ('a -> xml) -> 'a list -> xml +val to_list: (xml -> 'a) -> xml -> 'a list +val of_option: ('a -> xml) -> 'a option -> xml +val to_option: (xml -> 'a) -> xml -> 'a option +val of_string: string -> xml +val to_string: xml -> string +val of_int: int -> xml +val to_int: xml -> int +val of_pair: ('a -> xml) -> ('b -> xml) -> 'a * 'b -> xml +val to_pair: (xml -> 'a) -> (xml -> 'b) -> xml -> 'a * 'b +val of_union: ('a -> xml) -> ('b -> xml) -> ('a, 'b) CSig.union -> xml +val to_union: (xml -> 'a) -> (xml -> 'b) -> xml -> ('a, 'b) CSig.union +val of_edit_id: int -> xml +val to_edit_id: xml -> int +val of_loc : Loc.t -> xml +val to_loc : xml -> Loc.t +val of_xml : xml -> xml +val to_xml : xml -> xml diff --git a/ide/session.ml b/ide/session.ml index cdec392ecc..fc6340d283 100644 --- a/ide/session.ml +++ b/ide/session.ml @@ -108,10 +108,10 @@ let set_buffer_handlers let id = ref 0 in fun () -> incr id; !id in let running_action = ref None in - let cancel_signal reason = + let cancel_signal ?(stop_emit=true) reason = Minilib.log ("user_action cancelled: "^reason); action_was_cancelled := true; - GtkSignal.stop_emit () in + if stop_emit then GtkSignal.stop_emit () in let del_mark () = try buffer#delete_mark (`NAME "target") with GText.No_such_mark _ -> () in @@ -124,7 +124,7 @@ let set_buffer_handlers fun () -> (* If Coq is busy due to the current action, we don't cancel *) match !running_action with | Some aid when aid = action -> () - | _ -> cancel_signal "Coq busy" in + | _ -> cancel_signal ~stop_emit:false "Coq busy" in Coq.try_grab coqtop action fallback in let get_start () = buffer#get_iter_at_mark (`NAME "start_of_input") in let get_stop () = buffer#get_iter_at_mark (`NAME "stop_of_input") in @@ -195,12 +195,8 @@ let set_buffer_handlers to a point indicated by coq. *) if !no_coq_action_required then begin let start, stop = get_start (), get_stop () in - buffer#remove_tag Tags.Script.error ~start ~stop; - buffer#remove_tag Tags.Script.error_bg ~start ~stop; - buffer#remove_tag Tags.Script.tooltip ~start ~stop; - buffer#remove_tag Tags.Script.processed ~start ~stop; - buffer#remove_tag Tags.Script.to_process ~start ~stop; - buffer#remove_tag Tags.Script.incomplete ~start ~stop; + List.iter (fun tag -> buffer#remove_tag tag ~start ~stop) + Tags.Script.ephemere; Sentence.tag_on_insert buffer end; end in diff --git a/ide/tags.ml b/ide/tags.ml index 9ccff9fb51..e4510e7af4 100644 --- a/ide/tags.ml +++ b/ide/tags.ml @@ -18,6 +18,7 @@ struct let table = GText.tag_table () let comment = make_tag table ~name:"comment" [] let error = make_tag table ~name:"error" [`UNDERLINE `SINGLE] + let warning = make_tag table ~name:"warning" [`UNDERLINE `SINGLE; `FOREGROUND "blue"] let error_bg = make_tag table ~name:"error_bg" [] let to_process = make_tag table ~name:"to_process" [] let processed = make_tag table ~name:"processed" [] @@ -29,9 +30,11 @@ struct let sentence = make_tag table ~name:"sentence" [] let tooltip = make_tag table ~name:"tooltip" [] (* debug:`BACKGROUND "blue" *) + let ephemere = + [error; warning; error_bg; tooltip; processed; to_process; incomplete; unjustified] + let all = - [comment; error; error_bg; to_process; processed; incomplete; unjustified; - found; sentence; tooltip] + comment :: found :: sentence :: ephemere let edit_zone = let t = make_tag table ~name:"edit_zone" [`UNDERLINE `SINGLE] in diff --git a/ide/tags.mli b/ide/tags.mli index 5a932f3300..02e15a5ae4 100644 --- a/ide/tags.mli +++ b/ide/tags.mli @@ -11,6 +11,7 @@ sig val table : GText.tag_table val comment : GText.tag val error : GText.tag + val warning : GText.tag val error_bg : GText.tag val to_process : GText.tag val processed : GText.tag @@ -20,6 +21,7 @@ sig val sentence : GText.tag val tooltip : GText.tag val edit_zone : GText.tag (* for debugging *) + val ephemere : GText.tag list val all : GText.tag list end diff --git a/ide/texmacspp.ml b/ide/texmacspp.ml new file mode 100644 index 0000000000..6fbed38fb4 --- /dev/null +++ b/ide/texmacspp.ml @@ -0,0 +1,764 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +open Xml_datatype +open Vernacexpr +open Constrexpr +open Names +open Misctypes +open Bigint +open Decl_kinds +open Extend +open Libnames + +let unlock loc = + let start, stop = Loc.unloc loc in + (string_of_int start, string_of_int stop) + +let xmlWithLoc loc ename attr xml = + let start, stop = unlock loc in + Element(ename, [ "begin", start; "end", stop ] @ attr, xml) + +let get_fst_attr_in_xml_list attr xml_list = + let attrs_list = + List.map (function + | Element (_, attrs, _) -> (List.filter (fun (a,_) -> a = attr) attrs) + | _ -> []) + xml_list in + match List.flatten attrs_list with + | [] -> (attr, "") + | l -> (List.hd l) + +let backstep_loc xmllist = + let start_att = get_fst_attr_in_xml_list "begin" xmllist in + let stop_att = get_fst_attr_in_xml_list "end" (List.rev xmllist) in + [start_att ; stop_att] + +let compare_begin_att xml1 xml2 = + let att1 = get_fst_attr_in_xml_list "begin" [xml1] in + let att2 = get_fst_attr_in_xml_list "begin" [xml2] in + match att1, att2 with + | (_, s1), (_, s2) when s1 == "" || s2 == "" -> 0 + | (_, s1), (_, s2) when int_of_string s1 > int_of_string s2 -> 1 + | (_, s1), (_, s2) when int_of_string s1 < int_of_string s2 -> -1 + | _ -> 0 + +let xmlBeginSection loc name = xmlWithLoc loc "beginsection" ["name", name] [] + +let xmlEndSegment loc name = xmlWithLoc loc "endsegment" ["name", name] [] + +let xmlThm typ name loc xml = + xmlWithLoc loc "theorem" ["type", typ; "name", name] xml + +let xmlDef typ name loc xml = + xmlWithLoc loc "definition" ["type", typ; "name", name] xml + +let xmlNotation attr name loc xml = + xmlWithLoc loc "notation" (("name", name) :: attr) xml + +let xmlReservedNotation attr name loc = + xmlWithLoc loc "reservednotation" (("name", name) :: attr) [] + +let xmlCst name ?(attr=[]) loc = + xmlWithLoc loc "constant" (("name", name) :: attr) [] + +let xmlOperator name ?(attr=[]) ?(pprules=[]) loc = + xmlWithLoc loc "operator" + (("name", name) :: List.map (fun (a,b) -> "format"^a,b) pprules @ attr) [] + +let xmlApply loc ?(attr=[]) xml = xmlWithLoc loc "apply" attr xml + +let xmlToken loc ?(attr=[]) xml = xmlWithLoc loc "token" attr xml + +let xmlTyped xml = Element("typed", (backstep_loc xml), xml) + +let xmlReturn ?(attr=[]) xml = Element("return", attr, xml) + +let xmlCase xml = Element("case", [], xml) + +let xmlScrutinee ?(attr=[]) xml = Element("scrutinee", attr, xml) + +let xmlWith xml = Element("with", [], xml) + +let xmlAssign id xml = Element("assign", ["target",string_of_id id], [xml]) + +let xmlInductive kind loc xml = xmlWithLoc loc "inductive" ["kind",kind] xml + +let xmlCoFixpoint xml = Element("cofixpoint", [], xml) + +let xmlFixpoint xml = Element("fixpoint", [], xml) + +let xmlCheck loc xml = xmlWithLoc loc "check" [] xml + +let xmlAssumption kind loc xml = xmlWithLoc loc "assumption" ["kind",kind] xml + +let xmlComment loc xml = xmlWithLoc loc "comment" [] xml + +let xmlCanonicalStructure attr loc = xmlWithLoc loc "canonicalstructure" attr [] + +let xmlQed ?(attr=[]) loc = xmlWithLoc loc "qed" attr [] + +let xmlPatvar id loc = xmlWithLoc loc "patvar" ["id", id] [] + +let xmlReference ref = + let name = Libnames.string_of_reference ref in + let i, j = Loc.unloc (Libnames.loc_of_reference ref) in + let b, e = string_of_int i, string_of_int j in + Element("reference",["name", name; "begin", b; "end", e] ,[]) + +let xmlRequire loc ?(attr=[]) xml = xmlWithLoc loc "require" attr xml +let xmlImport loc ?(attr=[]) xml = xmlWithLoc loc "import" attr xml + +let xmlAddLoadPath loc ?(attr=[]) xml = xmlWithLoc loc "addloadpath" attr xml +let xmlRemoveLoadPath loc ?(attr=[]) = xmlWithLoc loc "removeloadpath" attr +let xmlAddMLPath loc ?(attr=[]) = xmlWithLoc loc "addmlpath" attr + +let xmlExtend loc xml = xmlWithLoc loc "extend" [] xml + +let xmlScope loc action ?(attr=[]) name xml = + xmlWithLoc loc "scope" (["name",name;"action",action] @ attr) xml + +let xmlProofMode loc name = xmlWithLoc loc "proofmode" ["name",name] [] + +let xmlProof loc xml = xmlWithLoc loc "proof" [] xml + +let xmlSectionSubsetDescr name ssd = + Element("sectionsubsetdescr",["name",name], + [PCData (Proof_using.to_string ssd)]) + +let xmlDeclareMLModule loc s = + xmlWithLoc loc "declarexmlmodule" [] + (List.map (fun x -> Element("path",["value",x],[])) s) + +(* tactics *) +let xmlLtac loc xml = xmlWithLoc loc "ltac" [] xml + +(* toplevel commands *) +let xmlGallina loc xml = xmlWithLoc loc "gallina" [] xml + +let xmlTODO loc x = + xmlWithLoc loc "todo" [] [PCData (Pp.string_of_ppcmds (Ppvernac.pr_vernac x))] + +let string_of_name n = + match n with + | Anonymous -> "_" + | Name id -> Id.to_string id + +let string_of_glob_sort s = + match s with + | GProp -> "Prop" + | GSet -> "Set" + | GType _ -> "Type" + +let string_of_cast_sort c = + match c with + | CastConv _ -> "CastConv" + | CastVM _ -> "CastVM" + | CastNative _ -> "CastNative" + | CastCoerce -> "CastCoerce" + +let string_of_case_style s = + match s with + | LetStyle -> "Let" + | IfStyle -> "If" + | LetPatternStyle -> "LetPattern" + | MatchStyle -> "Match" + | RegularStyle -> "Regular" + +let attribute_of_syntax_modifier sm = +match sm with + | SetItemLevel (sl, NumLevel n) -> + List.map (fun s -> ("itemlevel", s)) sl @ ["level", string_of_int n] + | SetItemLevel (sl, NextLevel) -> + List.map (fun s -> ("itemlevel", s)) sl @ ["level", "next"] + | SetLevel i -> ["level", string_of_int i] + | SetAssoc a -> + begin match a with + | NonA -> ["",""] + | RightA -> ["associativity", "right"] + | LeftA -> ["associativity", "left"] + end + | SetEntryType (s, _) -> ["entrytype", s] + | SetOnlyPrinting -> ["onlyprinting", ""] + | SetOnlyParsing -> ["onlyparsing", ""] + | SetCompatVersion v -> ["compat", Flags.pr_version v] + | SetFormat (system, (loc, s)) -> + let start, stop = unlock loc in + ["format-"^system, s; "begin", start; "end", stop] + +let string_of_assumption_kind l a many = + match l, a, many with + | (Discharge, Logical, true) -> "Hypotheses" + | (Discharge, Logical, false) -> "Hypothesis" + | (Discharge, Definitional, true) -> "Variables" + | (Discharge, Definitional, false) -> "Variable" + | (Global, Logical, true) -> "Axioms" + | (Global, Logical, false) -> "Axiom" + | (Global, Definitional, true) -> "Parameters" + | (Global, Definitional, false) -> "Parameter" + | (Local, Logical, true) -> "Local Axioms" + | (Local, Logical, false) -> "Local Axiom" + | (Local, Definitional, true) -> "Local Parameters" + | (Local, Definitional, false) -> "Local Parameter" + | (Global, Conjectural, _) -> "Conjecture" + | ((Discharge | Local), Conjectural, _) -> assert false + +let rec pp_bindlist bl = + let tlist = + List.flatten + (List.map + (fun (loc_names, _, e) -> + let names = + (List.map + (fun (loc, name) -> + xmlCst (string_of_name name) loc) loc_names) in + match e with + | CHole _ -> names + | _ -> names @ [pp_expr e]) + bl) in + match tlist with + | [e] -> e + | l -> xmlTyped l +and pp_decl_notation ((_, s), ce, sc) = (* don't know what it is for now *) + Element ("decl_notation", ["name", s], [pp_expr ce]) +and pp_local_binder lb = (* don't know what it is for now *) + match lb with + | LocalRawDef ((_, nam), ce) -> + let attrs = ["name", string_of_name nam] in + pp_expr ~attr:attrs ce + | LocalRawAssum (namll, _, ce) -> + let ppl = + List.map (fun (loc, nam) -> (xmlCst (string_of_name nam) loc)) namll in + xmlTyped (ppl @ [pp_expr ce]) + | LocalPattern _ -> + assert false +and pp_local_decl_expr lde = (* don't know what it is for now *) + match lde with + | AssumExpr (_, ce) -> pp_expr ce + | DefExpr (_, ce, _) -> pp_expr ce +and pp_inductive_expr ((_, ((l, id),_)), lbl, ceo, _, cl_or_rdexpr) = + (* inductive_expr *) + let b,e = Loc.unloc l in + let location = ["begin", string_of_int b; "end", string_of_int e] in + [Element ("lident", ["name", Id.to_string id] @ location, [])] @ (* inductive name *) + begin match cl_or_rdexpr with + | Constructors coel -> List.map (fun (_, (_, ce)) -> pp_expr ce) coel + | RecordDecl (_, ldewwwl) -> + List.map (fun (((_, x), _), _) -> pp_local_decl_expr x) ldewwwl + end @ + begin match ceo with (* don't know what it is for now *) + | Some ce -> [pp_expr ce] + | None -> [] + end @ + (List.map pp_local_binder lbl) +and pp_recursion_order_expr optid roe = (* don't know what it is for now *) + let attrs = + match optid with + | None -> [] + | Some (loc, id) -> + let start, stop = unlock loc in + ["begin", start; "end", stop ; "name", Id.to_string id] in + let kind, expr = + match roe with + | CStructRec -> "struct", [] + | CWfRec e -> "rec", [pp_expr e] + | CMeasureRec (e, None) -> "mesrec", [pp_expr e] + | CMeasureRec (e, Some rel) -> "mesrec", [pp_expr e] @ [pp_expr rel] in + Element ("recursion_order", ["kind", kind] @ attrs, expr) +and pp_fixpoint_expr (((loc, id), pl), (optid, roe), lbl, ce, ceo) = + (* fixpoint_expr *) + let start, stop = unlock loc in + let id = Id.to_string id in + [Element ("lident", ["begin", start; "end", stop ; "name", id], [])] @ + (* fixpoint name *) + [pp_recursion_order_expr optid roe] @ + (List.map pp_local_binder lbl) @ + [pp_expr ce] @ + begin match ceo with (* don't know what it is for now *) + | Some ce -> [pp_expr ce] + | None -> [] + end +and pp_cofixpoint_expr (((loc, id), pl), lbl, ce, ceo) = (* cofixpoint_expr *) + (* Nota: it is like fixpoint_expr without (optid, roe) + * so could be merged if there is no more differences *) + let start, stop = unlock loc in + let id = Id.to_string id in + [Element ("lident", ["begin", start; "end", stop ; "name", id], [])] @ + (* cofixpoint name *) + (List.map pp_local_binder lbl) @ + [pp_expr ce] @ + begin match ceo with (* don't know what it is for now *) + | Some ce -> [pp_expr ce] + | None -> [] + end +and pp_lident (loc, id) = xmlCst (Id.to_string id) loc +and pp_simple_binder (idl, ce) = List.map pp_lident idl @ [pp_expr ce] +and pp_cases_pattern_expr cpe = + match cpe with + | CPatAlias (loc, cpe, id) -> + xmlApply loc + (xmlOperator "alias" ~attr:["name", string_of_id id] loc :: + [pp_cases_pattern_expr cpe]) + | CPatCstr (loc, ref, None, cpel2) -> + xmlApply loc + (xmlOperator "reference" + ~attr:["name", Libnames.string_of_reference ref] loc :: + [Element ("impargs", [], []); + Element ("args", [], (List.map pp_cases_pattern_expr cpel2))]) + | CPatCstr (loc, ref, Some cpel1, cpel2) -> + xmlApply loc + (xmlOperator "reference" + ~attr:["name", Libnames.string_of_reference ref] loc :: + [Element ("impargs", [], (List.map pp_cases_pattern_expr cpel1)); + Element ("args", [], (List.map pp_cases_pattern_expr cpel2))]) + | CPatAtom (loc, optr) -> + let attrs = match optr with + | None -> [] + | Some r -> ["name", Libnames.string_of_reference r] in + xmlApply loc (xmlOperator "atom" ~attr:attrs loc :: []) + | CPatOr (loc, cpel) -> + xmlApply loc (xmlOperator "or" loc :: List.map pp_cases_pattern_expr cpel) + | CPatNotation (loc, n, (subst_constr, subst_rec), cpel) -> + xmlApply loc + (xmlOperator "notation" loc :: + [xmlOperator n loc; + Element ("subst", [], + [Element ("subterms", [], + List.map pp_cases_pattern_expr subst_constr); + Element ("recsubterms", [], + List.map + (fun (cpel) -> + Element ("recsubterm", [], + List.map pp_cases_pattern_expr cpel)) + subst_rec)]); + Element ("args", [], (List.map pp_cases_pattern_expr cpel))]) + | CPatPrim (loc, tok) -> pp_token loc tok + | CPatRecord (loc, rcl) -> + xmlApply loc + (xmlOperator "record" loc :: + List.map (fun (r, cpe) -> + Element ("field", + ["reference", Libnames.string_of_reference r], + [pp_cases_pattern_expr cpe])) + rcl) + | CPatDelimiters (loc, delim, cpe) -> + xmlApply loc + (xmlOperator "delimiter" ~attr:["name", delim] loc :: + [pp_cases_pattern_expr cpe]) + | CPatCast _ -> assert false +and pp_case_expr (e, name, pat) = + match name, pat with + | None, None -> xmlScrutinee [pp_expr e] + | Some (loc, name), None -> + let start, stop= unlock loc in + xmlScrutinee ~attr:["name", string_of_name name; + "begin", start; "end", stop] [pp_expr e] + | Some (loc, name), Some p -> + let start, stop= unlock loc in + xmlScrutinee ~attr:["name", string_of_name name; + "begin", start; "end", stop] + [Element ("in", [], [pp_cases_pattern_expr p]) ; pp_expr e] + | None, Some p -> + xmlScrutinee [Element ("in", [], [pp_cases_pattern_expr p]) ; pp_expr e] +and pp_branch_expr_list bel = + xmlWith + (List.map + (fun (_, cpel, e) -> + let ppcepl = + List.map pp_cases_pattern_expr (List.flatten (List.map snd cpel)) in + let ppe = [pp_expr e] in + xmlCase (ppcepl @ ppe)) + bel) +and pp_token loc tok = + let tokstr = + match tok with + | String s -> PCData s + | Numeral n -> PCData (to_string n) in + xmlToken loc [tokstr] +and pp_local_binder_list lbl = + let l = (List.map pp_local_binder lbl) in + Element ("recurse", (backstep_loc l), l) +and pp_const_expr_list cel = + let l = List.map pp_expr cel in + Element ("recurse", (backstep_loc l), l) +and pp_expr ?(attr=[]) e = + match e with + | CRef (r, _) -> + xmlCst ~attr + (Libnames.string_of_reference r) (Libnames.loc_of_reference r) + | CProdN (loc, bl, e) -> + xmlApply loc + (xmlOperator "forall" loc :: [pp_bindlist bl] @ [pp_expr e]) + | CApp (loc, (_, hd), args) -> + xmlApply ~attr loc (pp_expr hd :: List.map (fun (e,_) -> pp_expr e) args) + | CAppExpl (loc, (_, r, _), args) -> + xmlApply ~attr loc + (xmlCst (Libnames.string_of_reference r) + (Libnames.loc_of_reference r) :: List.map pp_expr args) + | CNotation (loc, notation, ([],[],[])) -> + xmlOperator notation loc + | CNotation (loc, notation, (args, cell, lbll)) -> + let fmts = Notation.find_notation_extra_printing_rules notation in + let oper = xmlOperator notation loc ~pprules:fmts in + let cels = List.map pp_const_expr_list cell in + let lbls = List.map pp_local_binder_list lbll in + let args = List.map pp_expr args in + xmlApply loc (oper :: (List.sort compare_begin_att (args @ cels @ lbls))) + | CSort(loc, s) -> + xmlOperator (string_of_glob_sort s) loc + | CDelimiters (loc, scope, ce) -> + xmlApply loc (xmlOperator "delimiter" ~attr:["name", scope] loc :: + [pp_expr ce]) + | CPrim (loc, tok) -> pp_token loc tok + | CGeneralization (loc, kind, _, e) -> + let kind= match kind with + | Explicit -> "explicit" + | Implicit -> "implicit" in + xmlApply loc + (xmlOperator "generalization" ~attr:["kind", kind] loc :: [pp_expr e]) + | CCast (loc, e, tc) -> + begin match tc with + | CastConv t | CastVM t |CastNative t -> + xmlApply loc + (xmlOperator ":" loc ~attr:["kind", (string_of_cast_sort tc)] :: + [pp_expr e; pp_expr t]) + | CastCoerce -> + xmlApply loc + (xmlOperator ":" loc ~attr:["kind", "CastCoerce"] :: + [pp_expr e]) + end + | CEvar (loc, ek, cel) -> + let ppcel = List.map (fun (id,e) -> xmlAssign id (pp_expr e)) cel in + xmlApply loc + (xmlOperator "evar" loc ~attr:["id", string_of_id ek] :: + ppcel) + | CPatVar (loc, id) -> xmlPatvar (string_of_id id) loc + | CHole (loc, _, _, _) -> xmlCst ~attr "_" loc + | CIf (loc, test, (_, ret), th, el) -> + let return = match ret with + | None -> [] + | Some r -> [xmlReturn [pp_expr r]] in + xmlApply loc + (xmlOperator "if" loc :: + return @ [pp_expr th] @ [pp_expr el]) + | CLetTuple (loc, names, (_, ret), value, body) -> + let return = match ret with + | None -> [] + | Some r -> [xmlReturn [pp_expr r]] in + xmlApply loc + (xmlOperator "lettuple" loc :: + return @ + (List.map (fun (loc, var) -> xmlCst (string_of_name var) loc) names) @ + [pp_expr value; pp_expr body]) + | CCases (loc, sty, ret, cel, bel) -> + let return = match ret with + | None -> [] + | Some r -> [xmlReturn [pp_expr r]] in + xmlApply loc + (xmlOperator "match" loc ~attr:["style", (string_of_case_style sty)] :: + (return @ + [Element ("scrutinees", [], List.map pp_case_expr cel)] @ + [pp_branch_expr_list bel])) + | CRecord (_, _) -> assert false + | CLetIn (loc, (varloc, var), value, body) -> + xmlApply loc + (xmlOperator "let" loc :: + [xmlCst (string_of_name var) varloc; pp_expr value; pp_expr body]) + | CLambdaN (loc, bl, e) -> + xmlApply loc + (xmlOperator "lambda" loc :: [pp_bindlist bl] @ [pp_expr e]) + | CCoFix (_, _, _) -> assert false + | CFix (loc, lid, fel) -> + xmlApply loc + (xmlOperator "fix" loc :: + List.flatten (List.map + (fun (a,b,cl,c,d) -> pp_fixpoint_expr ((a,None),b,cl,c,Some d)) + fel)) + +let pp_comment (c) = + match c with + | CommentConstr e -> [pp_expr e] + | CommentString s -> [Element ("string", [], [PCData s])] + | CommentInt i -> [PCData (string_of_int i)] + +let rec tmpp v loc = + match v with + (* Control *) + | VernacLoad (verbose,f) -> + xmlWithLoc loc "load" ["verbose",string_of_bool verbose;"file",f] [] + | VernacTime (loc,e) -> + xmlApply loc (Element("time",[],[]) :: + [tmpp e loc]) + | VernacRedirect (s, (loc,e)) -> + xmlApply loc (Element("redirect",["path", s],[]) :: + [tmpp e loc]) + | VernacTimeout (s,e) -> + xmlApply loc (Element("timeout",["val",string_of_int s],[]) :: + [tmpp e loc]) + | VernacFail e -> xmlApply loc (Element("fail",[],[]) :: [tmpp e loc]) + | VernacError _ -> xmlWithLoc loc "error" [] [] + + (* Syntax *) + | VernacSyntaxExtension (_, ((_, name), sml)) -> + let attrs = List.flatten (List.map attribute_of_syntax_modifier sml) in + xmlReservedNotation attrs name loc + + | VernacOpenCloseScope (_,(true,name)) -> xmlScope loc "open" name [] + | VernacOpenCloseScope (_,(false,name)) -> xmlScope loc "close" name [] + | VernacDelimiters (name,Some tag) -> + xmlScope loc "delimit" name ~attr:["delimiter",tag] [] + | VernacDelimiters (name,None) -> + xmlScope loc "undelimit" name ~attr:[] [] + | VernacInfix (_,((_,name),sml),ce,sn) -> + let attrs = List.flatten (List.map attribute_of_syntax_modifier sml) in + let sc_attr = + match sn with + | Some scope -> ["scope", scope] + | None -> [] in + xmlNotation (sc_attr @ attrs) name loc [pp_expr ce] + | VernacNotation (_, ce, (lstr, sml), sn) -> + let name = snd lstr in + let attrs = List.flatten (List.map attribute_of_syntax_modifier sml) in + let sc_attr = + match sn with + | Some scope -> ["scope", scope] + | None -> [] in + xmlNotation (sc_attr @ attrs) name loc [pp_expr ce] + | VernacBindScope _ as x -> xmlTODO loc x + | VernacNotationAddFormat _ as x -> xmlTODO loc x + | VernacUniverse _ + | VernacConstraint _ + | VernacPolymorphic (_, _) as x -> xmlTODO loc x + (* Gallina *) + | VernacDefinition (ldk, ((_,id),_), de) -> + let l, dk = + match ldk with + | Some l, dk -> (l, dk) + | None, dk -> (Global, dk) in (* Like in ppvernac.ml, l 585 *) + let e = + match de with + | ProveBody (_, ce) -> ce + | DefineBody (_, Some _, ce, None) -> ce + | DefineBody (_, None , ce, None) -> ce + | DefineBody (_, Some _, ce, Some _) -> ce + | DefineBody (_, None , ce, Some _) -> ce in + let str_dk = Kindops.string_of_definition_kind (l, false, dk) in + let str_id = Id.to_string id in + (xmlDef str_dk str_id loc [pp_expr e]) + | VernacStartTheoremProof (tk, [ Some ((_,id),_), ([], statement, None) ], b) -> + let str_tk = Kindops.string_of_theorem_kind tk in + let str_id = Id.to_string id in + (xmlThm str_tk str_id loc [pp_expr statement]) + | VernacStartTheoremProof _ as x -> xmlTODO loc x + | VernacEndProof pe -> + begin + match pe with + | Admitted -> xmlQed loc + | Proved (_, Some ((_, id), Some tk)) -> + let nam = Id.to_string id in + let typ = Kindops.string_of_theorem_kind tk in + xmlQed ~attr:["name", nam; "type", typ] loc + | Proved (_, Some ((_, id), None)) -> + let nam = Id.to_string id in + xmlQed ~attr:["name", nam] loc + | Proved _ -> xmlQed loc + end + | VernacExactProof _ as x -> xmlTODO loc x + | VernacAssumption ((l, a), _, sbwcl) -> + let binders = List.map (fun (_, (id, c)) -> (List.map fst id, c)) sbwcl in + let many = + List.length (List.flatten (List.map fst binders)) > 1 in + let exprs = + List.flatten (List.map pp_simple_binder binders) in + let l = match l with Some x -> x | None -> Decl_kinds.Global in + let kind = string_of_assumption_kind l a many in + xmlAssumption kind loc exprs + | VernacInductive (_, _, iednll) -> + let kind = + let (_, _, _, k, _),_ = List.hd iednll in + begin + match k with + | Record -> "Record" + | Structure -> "Structure" + | Inductive_kw -> "Inductive" + | CoInductive -> "CoInductive" + | Class _ -> "Class" + | Variant -> "Variant" + end in + let exprs = + List.flatten (* should probably not be flattened *) + (List.map + (fun (ie, dnl) -> (pp_inductive_expr ie) @ + (List.map pp_decl_notation dnl)) iednll) in + xmlInductive kind loc exprs + | VernacFixpoint (_, fednll) -> + let exprs = + List.flatten (* should probably not be flattened *) + (List.map + (fun (fe, dnl) -> (pp_fixpoint_expr fe) @ + (List.map pp_decl_notation dnl)) fednll) in + xmlFixpoint exprs + | VernacCoFixpoint (_, cfednll) -> + (* Nota: it is like VernacFixpoint without so could be merged *) + let exprs = + List.flatten (* should probably not be flattened *) + (List.map + (fun (cfe, dnl) -> (pp_cofixpoint_expr cfe) @ + (List.map pp_decl_notation dnl)) cfednll) in + xmlCoFixpoint exprs + | VernacScheme _ as x -> xmlTODO loc x + | VernacCombinedScheme _ as x -> xmlTODO loc x + + (* Gallina extensions *) + | VernacBeginSection (_, id) -> xmlBeginSection loc (Id.to_string id) + | VernacEndSegment (_, id) -> xmlEndSegment loc (Id.to_string id) + | VernacNameSectionHypSet _ as x -> xmlTODO loc x + | VernacRequire (from, import, l) -> + let import = match import with + | None -> [] + | Some true -> ["export","true"] + | Some false -> ["import","true"] + in + let from = match from with + | None -> [] + | Some r -> ["from", Libnames.string_of_reference r] + in + xmlRequire loc ~attr:(from @ import) (List.map (fun ref -> + xmlReference ref) l) + | VernacImport (true,l) -> + xmlImport loc ~attr:["export","true"] (List.map (fun ref -> + xmlReference ref) l) + | VernacImport (false,l) -> + xmlImport loc (List.map (fun ref -> + xmlReference ref) l) + | VernacCanonical r -> + let attr = + match r with + | AN (Qualid (_, q)) -> ["qualid", string_of_qualid q] + | AN (Ident (_, id)) -> ["id", Id.to_string id] + | ByNotation (_, s, _) -> ["notation", s] in + xmlCanonicalStructure attr loc + | VernacCoercion _ as x -> xmlTODO loc x + | VernacIdentityCoercion _ as x -> xmlTODO loc x + + (* Type classes *) + | VernacInstance _ as x -> xmlTODO loc x + + | VernacContext _ as x -> xmlTODO loc x + + | VernacDeclareInstances _ as x -> xmlTODO loc x + + | VernacDeclareClass _ as x -> xmlTODO loc x + + (* Modules and Module Types *) + | VernacDeclareModule _ as x -> xmlTODO loc x + | VernacDefineModule _ as x -> xmlTODO loc x + | VernacDeclareModuleType _ as x -> xmlTODO loc x + | VernacInclude _ as x -> xmlTODO loc x + + (* Solving *) + + | (VernacSolveExistential _) as x -> + xmlLtac loc [PCData (Pp.string_of_ppcmds (Ppvernac.pr_vernac x))] + + (* Auxiliary file and library management *) + | VernacAddLoadPath (recf,name,None) -> + xmlAddLoadPath loc ~attr:["rec",string_of_bool recf;"path",name] [] + | VernacAddLoadPath (recf,name,Some dp) -> + xmlAddLoadPath loc ~attr:["rec",string_of_bool recf;"path",name] + [PCData (Names.DirPath.to_string dp)] + | VernacRemoveLoadPath name -> xmlRemoveLoadPath loc ~attr:["path",name] [] + | VernacAddMLPath (recf,name) -> + xmlAddMLPath loc ~attr:["rec",string_of_bool recf;"path",name] [] + | VernacDeclareMLModule sl -> xmlDeclareMLModule loc sl + | VernacChdir _ as x -> xmlTODO loc x + + (* State management *) + | VernacWriteState _ as x -> xmlTODO loc x + | VernacRestoreState _ as x -> xmlTODO loc x + + (* Resetting *) + | VernacResetName _ as x -> xmlTODO loc x + | VernacResetInitial as x -> xmlTODO loc x + | VernacBack _ as x -> xmlTODO loc x + | VernacBackTo _ -> PCData "VernacBackTo" + + (* Commands *) + | VernacCreateHintDb _ as x -> xmlTODO loc x + | VernacRemoveHints _ as x -> xmlTODO loc x + | VernacHints _ as x -> xmlTODO loc x + | VernacSyntacticDefinition ((_, name), (idl, ce), _, _) -> + let name = Id.to_string name in + let attrs = List.map (fun id -> ("id", Id.to_string id)) idl in + xmlNotation attrs name loc [pp_expr ce] + | VernacDeclareImplicits _ as x -> xmlTODO loc x + | VernacArguments _ as x -> xmlTODO loc x + | VernacArgumentsScope _ as x -> xmlTODO loc x + | VernacReserve _ as x -> xmlTODO loc x + | VernacGeneralizable _ as x -> xmlTODO loc x + | VernacSetOpacity _ as x -> xmlTODO loc x + | VernacSetStrategy _ as x -> xmlTODO loc x + | VernacUnsetOption _ as x -> xmlTODO loc x + | VernacSetOption _ as x -> xmlTODO loc x + | VernacSetAppendOption _ as x -> xmlTODO loc x + | VernacAddOption _ as x -> xmlTODO loc x + | VernacRemoveOption _ as x -> xmlTODO loc x + | VernacMemOption _ as x -> xmlTODO loc x + | VernacPrintOption _ as x -> xmlTODO loc x + | VernacCheckMayEval (_,_,e) -> xmlCheck loc [pp_expr e] + | VernacGlobalCheck _ as x -> xmlTODO loc x + | VernacDeclareReduction _ as x -> xmlTODO loc x + | VernacPrint _ as x -> xmlTODO loc x + | VernacSearch _ as x -> xmlTODO loc x + | VernacLocate _ as x -> xmlTODO loc x + | VernacRegister _ as x -> xmlTODO loc x + | VernacComments (cl) -> + xmlComment loc (List.flatten (List.map pp_comment cl)) + + (* Stm backdoor *) + | VernacStm _ as x -> xmlTODO loc x + + (* Proof management *) + | VernacGoal _ as x -> xmlTODO loc x + | VernacAbort _ as x -> xmlTODO loc x + | VernacAbortAll -> PCData "VernacAbortAll" + | VernacRestart as x -> xmlTODO loc x + | VernacUndo _ as x -> xmlTODO loc x + | VernacUndoTo _ as x -> xmlTODO loc x + | VernacBacktrack _ as x -> xmlTODO loc x + | VernacFocus _ as x -> xmlTODO loc x + | VernacUnfocus as x -> xmlTODO loc x + | VernacUnfocused as x -> xmlTODO loc x + | VernacBullet _ as x -> xmlTODO loc x + | VernacSubproof _ as x -> xmlTODO loc x + | VernacEndSubproof as x -> xmlTODO loc x + | VernacShow _ as x -> xmlTODO loc x + | VernacCheckGuard as x -> xmlTODO loc x + | VernacProof (tac,using) -> + let tac = None (** FIXME *) in + let using = Option.map (xmlSectionSubsetDescr "using") using in + xmlProof loc (Option.List.(cons tac (cons using []))) + | VernacProofMode name -> xmlProofMode loc name + + (* Toplevel control *) + | VernacToplevelControl _ as x -> xmlTODO loc x + + (* For extension *) + | VernacExtend _ as x -> + xmlExtend loc [PCData (Pp.string_of_ppcmds (Ppvernac.pr_vernac x))] + + (* Flags *) + | VernacProgram e -> xmlApply loc (Element("program",[],[]) :: [tmpp e loc]) + | VernacLocal (b,e) -> + xmlApply loc (Element("local",["flag",string_of_bool b],[]) :: + [tmpp e loc]) + +let tmpp v loc = + match tmpp v loc with + | Element("ltac",_,_) as x -> x + | xml -> xmlGallina loc [xml] diff --git a/ide/texmacspp.mli b/ide/texmacspp.mli new file mode 100644 index 0000000000..858847fb6a --- /dev/null +++ b/ide/texmacspp.mli @@ -0,0 +1,12 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +open Xml_datatype +open Vernacexpr + +val tmpp : vernac_expr -> Loc.t -> xml diff --git a/ide/utils/config_file.ml b/ide/utils/config_file.ml deleted file mode 100644 index 4d0aabeb6a..0000000000 --- a/ide/utils/config_file.ml +++ /dev/null @@ -1,640 +0,0 @@ -(*********************************************************************************) -(* Cameleon *) -(* *) -(* Copyright (C) 2005 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. *) -(* *) -(* This program is free software; you can redistribute it and/or modify *) -(* it under the terms of the GNU Library General Public License as *) -(* published by the Free Software Foundation; either version 2 of the *) -(* License, or any later version. *) -(* *) -(* This program is distributed in the hope that it will be useful, *) -(* but WITHOUT ANY WARRANTY; without even the implied warranty of *) -(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) -(* GNU Library General Public License for more details. *) -(* *) -(* You should have received a copy of the GNU Library General Public *) -(* License along with this program; if not, write to the Free Software *) -(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA *) -(* 02111-1307 USA *) -(* *) -(* Contact: Maxence.Guesdon@inria.fr *) -(* *) -(*********************************************************************************) - -(* TODO *) -(* section comments *) -(* better obsoletes: no "{}", line cuts *) - -(* possible improvements: *) -(* use lex/yacc instead of genlex to be more robust, efficient, allow arrays and other types, read comments. *) -(* description and help, level (beginner/advanced/...) for each cp *) -(* find an option from its name and group *) -(* class hooks *) -(* get the sections of a group / of a file *) -(* read file format from inifiles and ConfigParser *) - - -(* Read the mli before reading this file! *) - - -(* ******************************************************************************** *) -(* ******************************** misc utilities ******************************** *) -(* ******************************************************************************** *) -(* This code is intended to be usable without any dependencies. *) - -(* pipeline style, see for instance Raw.of_channel. *) -let (|>) x f = f x - -(* as List.assoc, but applies f to the element matching [key] and returns the list -where this element has been replaced by the result of f. *) -let rec list_assoc_remove key f = function - | [] -> raise Not_found - | (key',value) as elt :: tail -> - if key <> key' - then elt :: list_assoc_remove key f tail - else match f value with - | None -> tail - | Some a -> (key',a) :: tail - -(* reminiscent of String.concat. Same as [Queue.iter f1 queue] - but calls [f2 ()] between each calls to f1. - Does not call f2 before the first call nor after the last call to f2. - Could be more efficient with a richer module interface of Queue. -*) -let queue_iter_between f1 f2 queue = -(* let f flag elt = if flag then f2 (); (f1 elt:unit); true in *) - let f flag elt = if flag then f2 (); f1 elt; true in - ignore (Queue.fold f false queue) - -let list_iter_between f1 f2 = function - [] -> () - | a::[] -> f1 a - | a::tail -> f1 a; List.iter (fun elt -> (f2 ():unit); f1 elt) tail -(* | a::tail -> f1 a; List.iter (fun elt -> f2 (); f1 elt) tail *) -(* !! types ??? *) - -(* to ensure that strings will be parsed correctly by Genlex. -It's more comfortable not to have quotes around the string, but sometimes it's necessary. *) -exception Unsafe_string -let safe_string s = - if s = "" - then "\"\"" - else if ( - try match s.[0] with - | 'a'..'z' | 'A'..'Z' -> - for i = 1 to String.length s - 1 do - match s.[i] with - 'a'..'z' | 'A'..'Z' | '_' | '0'..'9' -> () - | _ -> raise Unsafe_string - done; - false - | _ -> - try - string_of_int (int_of_string s) <> s || - string_of_float (float_of_string s) <> s - with Failure "int_of_string" | Failure "float_of_string" -> true - with Unsafe_string -> true) - then Printf.sprintf "\"%s\"" (String.escaped s) - else s - - -(* ******************************************************************************** *) -(* ************************************* core ************************************* *) -(* ******************************************************************************** *) - -module Raw = struct - type cp = - | String of string - | Int of int - | Float of float - | List of cp list - | Tuple of cp list - | Section of (string * cp) list - -(* code generated by -camlp4 pa_o.cmo pa_op.cmo pr_o.cmo -- -o config_file_parser.ml -impl config_file_parser.ml4 -Unreadable on purpose, edit the file config_file_parser.ml4 rather than editing this (huge) lines. Then manually copy-paste here the content of config_file_parser.ml. -Could be one day rewritten with ocamllex/yacc to be more robust, efficient, allow arrays, read comments...*) - module Parse = struct - let lexer = Genlex.make_lexer ["="; "{"; "}"; "["; "]"; ";"; "("; ")"; ","] - let rec file l (strm__ : _ Stream.t) = match try Some (ident strm__) with Stream.Failure -> None with Some id -> begin match Stream.peek strm__ with Some (Genlex.Kwd "=") -> Stream.junk strm__; let v = try value strm__ with Stream.Failure -> raise (Stream.Error "") in begin try file ((id, v) :: l) strm__ with Stream.Failure -> raise (Stream.Error "") end | _ -> raise (Stream.Error "") end | _ -> List.rev l - and value (strm__ : _ Stream.t) = match Stream.peek strm__ with Some (Genlex.Kwd "{") -> Stream.junk strm__; let v = try file [] strm__ with Stream.Failure -> raise (Stream.Error "") in begin match Stream.peek strm__ with Some (Genlex.Kwd "}") -> Stream.junk strm__; Section v | _ -> raise (Stream.Error "") end | Some (Genlex.Ident s) -> Stream.junk strm__; String s | Some (Genlex.String s) -> Stream.junk strm__; String s | Some (Genlex.Int i) -> Stream.junk strm__; Int i | Some (Genlex.Float f) -> Stream.junk strm__; Float f | Some (Genlex.Char c) -> Stream.junk strm__; String (String.make 1 c) | Some (Genlex.Kwd "[") -> Stream.junk strm__; let v = try list [] strm__ with Stream.Failure -> raise (Stream.Error "") in List v | Some (Genlex.Kwd "(") -> Stream.junk strm__; let v = try list [] strm__ with Stream.Failure -> raise (Stream.Error "") in Tuple v | _ -> raise Stream.Failure - and ident (strm__ : _ Stream.t) = match Stream.peek strm__ with Some (Genlex.Ident s) -> Stream.junk strm__; s | Some (Genlex.String s) -> Stream.junk strm__; s | _ -> raise Stream.Failure - and list l (strm__ : _ Stream.t) = match Stream.peek strm__ with Some (Genlex.Kwd ";") -> Stream.junk strm__; begin try list l strm__ with Stream.Failure -> raise (Stream.Error "") end | Some (Genlex.Kwd ",") -> Stream.junk strm__; begin try list l strm__ with Stream.Failure -> raise (Stream.Error "") end | _ -> match try Some (value strm__) with Stream.Failure -> None with Some v -> begin try list (v :: l) strm__ with Stream.Failure -> raise (Stream.Error "") end | _ -> match Stream.peek strm__ with Some (Genlex.Kwd "]") -> Stream.junk strm__; List.rev l | Some (Genlex.Kwd ")") -> Stream.junk strm__; List.rev l | _ -> raise Stream.Failure - end - - open Format - (* formating convention: the caller has to open the box, close it and flush the output *) - (* remarks on Format: - set_margin forces a call to set_max_indent - sprintf et bprintf are flushed at each call*) - - (* pretty print a Raw.cp *) - let rec save formatter = function - | String s -> fprintf formatter "%s" (safe_string s) (* How can I cut lines and *) - | Int i -> fprintf formatter "%d" i (* print backslashes just before the \n? *) - | Float f -> fprintf formatter "%g" f - | List l -> - fprintf formatter "[@[<b0>"; - list_iter_between - (fun v -> fprintf formatter "@[<b2>"; save formatter v; fprintf formatter "@]") - (fun () -> fprintf formatter ";@ ") - l; - fprintf formatter "@]]" - | Tuple l -> - fprintf formatter "(@[<b0>"; - list_iter_between - (fun v -> fprintf formatter "@[<b2>"; save formatter v; fprintf formatter "@]") - (fun () -> fprintf formatter ",@ ") - l; - fprintf formatter "@])" - | Section l -> - fprintf formatter "{@;<0 2>@[<hv0>"; - list_iter_between - (fun (name,value) -> - fprintf formatter "@[<hov2>%s =@ @[<b2>" name; - save formatter value; - fprintf formatter "@]@]";) - (fun () -> fprintf formatter "@;<2 0>") - l; - fprintf formatter "@]}" - -(* let to_string r = save str_formatter r; flush_str_formatter () *) - let to_channel out_channel r = - let f = formatter_of_out_channel out_channel in - fprintf f "@[<b2>"; save f r; fprintf f "@]@?" - - let of_string s = s |> Stream.of_string |> Parse.lexer |> Parse.value - - let of_channel in_channel = - let result = in_channel |> Stream.of_channel |> Parse.lexer |> Parse.file [] in - close_in in_channel; - result -end - -(* print the given string in a way compatible with Format. - Truncate the lines when needed, indent the newlines.*) -let print_help formatter = - String.iter (function - | ' ' -> Format.pp_print_space formatter () - | '\n' -> Format.pp_force_newline formatter () - | c -> Format.pp_print_char formatter c) - -type 'a wrappers = { - to_raw : 'a -> Raw.cp; - of_raw : Raw.cp -> 'a} - -class type ['a] cp = object -(* method private to_raw = wrappers.to_raw *) -(* method private of_raw = wrappers.of_raw *) -(* method private set_string s = s |> Raw.of_string |> self#of_raw |> self#set *) - method add_hook : ('a -> 'a -> unit) -> unit - method get : 'a - method get_default : 'a - method set : 'a -> unit - method reset : unit - - method get_formatted : Format.formatter -> unit - method get_default_formatted : Format.formatter -> unit - method get_help_formatted : Format.formatter -> unit - - method get_name : string list - method get_short_name : string option - method set_short_name : string -> unit - method get_help : string - method get_spec : Arg.spec - - method set_raw : Raw.cp -> unit -end - -type groupable_cp = < - get_name : string list; - get_short_name : string option; - get_help : string; - - get_formatted : Format.formatter -> unit; - get_default_formatted : Format.formatter -> unit; - get_help_formatted : Format.formatter -> unit; - get_spec : Arg.spec; - - reset : unit; - set_raw : Raw.cp -> unit; > - -exception Double_name -exception Missing_cp of groupable_cp -exception Wrong_type of (out_channel -> unit) - -(* Two exceptions to stop the iteration on queues. *) -exception Found -exception Found_cp of groupable_cp - -(* The data structure to store the cps. -It's a tree, each node is a section, and a queue of sons with their name. -Each leaf contains a cp. *) -type 'a nametree = - | Immediate of 'a - | Subsection of ((string * 'a nametree) Queue.t) - (* this Queue must be nonempty for group.read.choose *) - -class group = object (self) - val mutable cps = Queue.create () (* hold all the added cps, in a nametree. *) - - method add : 'a. 'a cp -> unit = fun original_cp -> - let cp = (original_cp :> groupable_cp) in - (* function called when we reach the end of the list cp#get_name. *) - let add_immediate name cp queue = - Queue.iter (fun (name',_) -> if name = name' then raise Double_name) queue; - Queue.push (name, Immediate cp) queue in - (* adds the cp with name [first_name::last_name] in section [section]. *) - let rec add_in_section section first_name last_name cp queue = - let sub_add = match last_name with (* what to do once we have find the correct section *) - | [] -> add_immediate first_name - | middle_name :: last_name -> add_in_section first_name middle_name last_name in - try - Queue.iter - (function - | name, Subsection subsection when name = section -> - sub_add cp subsection; raise Found - | _ -> ()) - queue; - let sub_queue = Queue.create () in - sub_add cp sub_queue; - Queue.push (section, Subsection sub_queue) queue - with Found -> () in - (match cp#get_name with - | [] -> failwith "empty name" - | first_name :: [] -> add_immediate first_name cp cps - | first_name :: middle_name :: last_name -> - add_in_section first_name middle_name last_name cp cps) - - method write ?(with_help=true) filename = - let out_channel = open_out filename in - let formatter = Format.formatter_of_out_channel out_channel in - let print = Format.fprintf formatter in - print "@[<v>"; - let rec save_queue formatter = - queue_iter_between - (fun (name,nametree) -> save_nametree name nametree) - (Format.pp_print_cut formatter) - and save_nametree name = function - | Immediate cp -> - if with_help && cp#get_help <> "" then - (print "@[<hov3>(* "; cp#get_help_formatted formatter; - print "@ *)@]@,"); - Format.fprintf formatter "@[<hov2>%s =@ @[<b2>" (safe_string name); - cp#get_formatted formatter; - print "@]@]" - | Subsection queue -> - Format.fprintf formatter "%s = {@;<0 2>@[<v>" (safe_string name); - save_queue formatter queue; - print "@]@,}" in - save_queue formatter cps; - print "@]@."; close_out out_channel - - method read ?obsoletes ?(no_default=false) - ?(on_type_error = fun groupable_cp raw_cp output filename in_channel -> - close_in in_channel; - Printf.eprintf - "Type error while loading configuration parameter %s from file %s.\n%!" - (String.concat "." groupable_cp#get_name) filename; - output stderr; - exit 1) - filename = - (* [filename] is created if it doesn't exist. In this case there is no need to read it. *) - match Sys.file_exists filename with false -> self#write filename | true -> - let in_channel = open_in filename in - (* what to do when a cp is missing: *) - let missing cp default = if no_default then raise (Missing_cp cp) else default in - (* returns a cp contained in the nametree queue, which must be nonempty *) - let choose queue = - let rec iter q = Queue.iter (function - | _, Immediate cp -> raise (Found_cp cp) - | _, Subsection q -> iter q) q in - try iter queue; failwith "choose" with Found_cp cp -> cp in - (* [set_and_remove raw_cps nametree] sets the cp of [nametree] to their value - defined in [raw_cps] and returns the remaining raw_cps. *) - let set_cp cp value = - try cp#set_raw value - with Wrong_type output -> on_type_error cp value output filename in_channel in - let rec set_and_remove raw_cps = function - | name, Immediate cp -> - (try list_assoc_remove name (fun value -> set_cp cp value; None) raw_cps - with Not_found -> missing cp raw_cps) - | name, Subsection queue -> - (try list_assoc_remove name - (function - | Raw.Section l -> - (match remainings l queue with - | [] -> None - | l -> Some (Raw.Section l)) - | r -> missing (choose queue) (Some r)) - raw_cps - with Not_found -> missing (choose queue) raw_cps) - and remainings raw_cps queue = Queue.fold set_and_remove raw_cps queue in - let remainings = remainings (Raw.of_channel in_channel) cps in - (* Handling of cps defined in filename but not belonging to self. *) - if remainings <> [] then match obsoletes with - | Some filename -> - let out_channel = - open_out filename in -(* open_out_gen [Open_wronly; Open_creat; Open_append; Open_text] 0o666 filename in *) - let formatter = Format.formatter_of_out_channel out_channel in - Format.fprintf formatter "@[<v>"; - Raw.save formatter (Raw.Section remainings); - Format.fprintf formatter "@]@."; - close_out out_channel - | None -> () - - method command_line_args ~section_separator = - let print = Format.fprintf Format.str_formatter in (* shortcut *) - let result = ref [] in let push x = result := x :: !result in - let rec iter = function - | _, Immediate cp -> - let key = "-" ^ String.concat section_separator cp#get_name in - let spec = cp#get_spec in - let doc = ( - print "@[<hv5>"; - Format.pp_print_as Format.str_formatter (String.length key +3) ""; - if cp#get_help <> "" - then (print "@,@[<b2>"; cp#get_help_formatted Format.str_formatter; print "@]@ ") - else print "@,"; - print "@[<hv>@[current:@;<1 2>@[<hov1>"; cp#get_formatted Format.str_formatter; - print "@]@],@ @[default:@;<1 2>@[<b2>"; cp#get_default_formatted Format.str_formatter; - print "@]@]@]@]"; - Format.flush_str_formatter ()) in - (match cp#get_short_name with - | None -> () - | Some short_name -> push ("-" ^ short_name,spec,"")); - push (key,spec,doc) - | _, Subsection queue -> Queue.iter iter queue in - Queue.iter iter cps; - List.rev !result -end - - -(* Given wrappers for the type 'a, cp_custom_type defines a class 'a cp. *) -class ['a] cp_custom_type wrappers - ?group:(group:group option) name ?short_name default help = -object (self) - method private to_raw = wrappers.to_raw - method private of_raw = wrappers.of_raw - - val mutable value = default - (* output *) - method get = value - method get_default = default - method get_formatted formatter = self#get |> self#to_raw |> Raw.save formatter - method get_default_formatted formatter = self#get_default |> self#to_raw |> Raw.save formatter - (* input *) - method set v = let v' = value in value <- v; self#exec_hooks v' v - method set_raw v = self#of_raw v |> self#set - method private set_string s = s |> Raw.of_string |> self#of_raw |> self#set - method reset = self#set self#get_default - - (* name *) - val mutable shortname = short_name - method get_name = name - method get_short_name = shortname - method set_short_name s = shortname <- Some s - - (* help *) - method get_help = help - method get_help_formatted formatter = print_help formatter self#get_help - method get_spec = Arg.String self#set_string - - (* hooks *) - val mutable hooks = [] - method add_hook f = hooks <- (f:'a->'a->unit) :: hooks - method private exec_hooks v' v = List.iter (fun f -> f v' v) hooks - - initializer match group with Some g -> g#add (self :> 'a cp) | None -> () -end - - -(* ******************************************************************************** *) -(* ****************************** predefined classes ****************************** *) -(* ******************************************************************************** *) - -let int_wrappers = { - to_raw = (fun v -> Raw.Int v); - of_raw = function - | Raw.Int v -> v - | r -> raise (Wrong_type (fun outchan -> Printf.fprintf outchan - "Raw.Int expected, got %a\n%!" Raw.to_channel r))} -class int_cp ?group name ?short_name default help = object (self) - inherit [int] cp_custom_type int_wrappers ?group name ?short_name default help - method get_spec = Arg.Int self#set -end - -let float_wrappers = { - to_raw = (fun v -> Raw.Float v); - of_raw = function - | Raw.Float v -> v - | Raw.Int v -> float v - | r -> raise (Wrong_type (fun outchan -> Printf.fprintf outchan - "Raw.Float expected, got %a\n%!" Raw.to_channel r)) -} -class float_cp ?group name ?short_name default help = object (self) - inherit [float] cp_custom_type float_wrappers ?group name ?short_name default help - method get_spec = Arg.Float self#set -end - -(* The Pervasives version is too restrictive *) -let bool_of_string s = - match String.lowercase s with - | "false" | "no" | "n" | "0" -> false (* "0" and "1" aren't used. *) - | "true" | "yes" | "y" | "1" -> true - | r -> raise (Wrong_type (fun outchan -> Printf.fprintf outchan - "Raw.Bool expected, got %s\n%!" r)) -let bool_wrappers = { - to_raw = (fun v -> Raw.String (string_of_bool v)); - of_raw = function - | Raw.String v -> bool_of_string v - | Raw.Int v -> v <> 0 - | r -> raise (Wrong_type (fun outchan -> Printf.fprintf outchan - "Raw.Bool expected, got %a\n%!" Raw.to_channel r)) -} -class bool_cp ?group name ?short_name default help = object (self) - inherit [bool] cp_custom_type bool_wrappers ?group name ?short_name default help - method get_spec = Arg.Bool self#set -end - -let string_wrappers = { - to_raw = (fun v -> Raw.String v); - of_raw = function - | Raw.String v -> v - | Raw.Int v -> string_of_int v - | Raw.Float v -> string_of_float v - | r -> raise (Wrong_type (fun outchan -> Printf.fprintf outchan - "Raw.String expected, got %a\n%!" Raw.to_channel r)) -} -class string_cp ?group name ?short_name default help = object (self) - inherit [string] cp_custom_type string_wrappers ?group name ?short_name default help - method private of_string s = s - method get_spec = Arg.String self#set -end - -let list_wrappers wrappers = { - to_raw = (fun l -> Raw.List (List.map wrappers.to_raw l)); - of_raw = function - | Raw.List l -> List.map wrappers.of_raw l - | r -> raise (Wrong_type (fun outchan -> Printf.fprintf outchan - "Raw.List expected, got %a\n%!" Raw.to_channel r)) -} -class ['a] list_cp wrappers = ['a list] cp_custom_type (list_wrappers wrappers) - -let option_wrappers wrappers = { - to_raw = (function - | Some v -> wrappers.to_raw v - | None -> Raw.String ""); - of_raw = function - | Raw.String s as v -> ( - if s = "" || s = "None" then None - else if String.length s >= 5 && String.sub s 0 5 = "Some " - then Some (wrappers.of_raw (Raw.String (String.sub s 5 (String.length s -5)))) - else Some (wrappers.of_raw v)) - | r -> Some (wrappers.of_raw r)} -class ['a] option_cp wrappers = ['a option] cp_custom_type (option_wrappers wrappers) - -let enumeration_wrappers enum = - let switched = List.map (fun (string,cons) -> cons,string) enum in - {to_raw = (fun v -> Raw.String (List.assq v switched)); - of_raw = function - | Raw.String s -> - (try List.assoc s enum - with Not_found -> failwith (Printf.sprintf "%s isn't a known constructor" s)) - | r -> raise (Wrong_type (fun outchan -> Printf.fprintf outchan - "Raw enumeration expected, got %a\n%!" Raw.to_channel r)) -} -class ['a] enumeration_cp enum ?group name ?short_name default help = object (self) - inherit ['a] cp_custom_type (enumeration_wrappers enum) - ?group name ?short_name default help - method get_spec = Arg.Symbol (List.map fst enum, (fun s -> self#set (List.assoc s enum))) -end - -let tuple2_wrappers wrapa wrapb = { - to_raw = (fun (a,b) -> Raw.Tuple [wrapa.to_raw a; wrapb.to_raw b]); - of_raw = function - | Raw.Tuple [a;b] -> wrapa.of_raw a, wrapb.of_raw b - | r -> raise (Wrong_type (fun outchan -> Printf.fprintf outchan - "Raw.Tuple 2 expected, got %a\n%!" Raw.to_channel r)) -} -class ['a, 'b] tuple2_cp wrapa wrapb = ['a*'b] cp_custom_type (tuple2_wrappers wrapa wrapb) - -let tuple3_wrappers wrapa wrapb wrapc = { - to_raw = (fun (a,b,c) -> Raw.Tuple[wrapa.to_raw a; wrapb.to_raw b; wrapc.to_raw c]); - of_raw = function - | Raw.Tuple [a;b;c] -> wrapa.of_raw a, wrapb.of_raw b, wrapc.of_raw c - | r -> raise (Wrong_type (fun outchan -> Printf.fprintf outchan - "Raw.Tuple 3 expected, got %a\n%!" Raw.to_channel r)) -} -class ['a,'b,'c] tuple3_cp wrapa wrapb wrapc = - ['a*'b*'c] cp_custom_type (tuple3_wrappers wrapa wrapb wrapc) - -let tuple4_wrappers wrapa wrapb wrapc wrapd = { - to_raw=(fun (a,b,c,d)->Raw.Tuple[wrapa.to_raw a;wrapb.to_raw b;wrapc.to_raw c;wrapd.to_raw d]); - of_raw = function - | Raw.Tuple [a;b;c;d] -> wrapa.of_raw a, wrapb.of_raw b, wrapc.of_raw c, wrapd.of_raw d - | r -> raise (Wrong_type (fun outchan -> Printf.fprintf outchan - "Raw.Tuple 4 expected, got %a\n%!" Raw.to_channel r)) -} -class ['a,'b,'c,'d] tuple4_cp wrapa wrapb wrapc wrapd = - ['a*'b*'c*'d] cp_custom_type (tuple4_wrappers wrapa wrapb wrapc wrapd) - -class string2_cp = [string,string] tuple2_cp string_wrappers string_wrappers -(* class color_cp = string_cp *) -class font_cp = string_cp -class filename_cp = string_cp - - -(* ******************************************************************************** *) -(******************** Backward compatibility with module Flags.****************** *) -(* ******************************************************************************** *) - -type 'a option_class = 'a wrappers -type 'a option_record = 'a cp -type options_file = {mutable filename:string; group:group} - -let create_options_file filename = {filename = filename; group = new group} -let set_options_file options_file filename = options_file.filename <- filename -let load {filename=f; group = g} = g#read f -let append {group=g} filename = g#read filename -let save {filename=f; group = g} = g#write ~with_help:false f -let save_with_help {filename=f; group = g} = g#write ~with_help:true f -let define_option {group=group} name help option_class default = - (new cp_custom_type option_class ~group name default help) -let option_hook cp f = cp#add_hook (fun _ _ -> f ()) - -let string_option = string_wrappers -let color_option = string_wrappers -let font_option = string_wrappers -let int_option = int_wrappers -let bool_option = bool_wrappers -let float_option = float_wrappers -let string2_option = tuple2_wrappers string_wrappers string_wrappers - -let option_option = option_wrappers -let list_option = list_wrappers -let sum_option = enumeration_wrappers -let tuple2_option (a,b) = tuple2_wrappers a b -let tuple3_option (a,b,c) = tuple3_wrappers a b c -let tuple4_option (a,b,c,d) = tuple4_wrappers a b c d - -let ( !! ) cp = cp#get -let ( =:= ) cp value = cp#set value - -let shortname cp = String.concat ":" cp#get_name -let get_help cp = cp#get_help - -type option_value = - Module of option_module -| StringValue of string -| IntValue of int -| FloatValue of float -| List of option_value list -| SmallList of option_value list -and option_module = (string * option_value) list - -let rec value_to_raw = function - | Module a -> Raw.Section (List.map (fun (name,value) -> name, value_to_raw value) a) - | StringValue a -> Raw.String a - | IntValue a -> Raw.Int a - | FloatValue a -> Raw.Float a - | List a -> Raw.List (List.map value_to_raw a) - | SmallList a -> Raw.Tuple (List.map value_to_raw a) -let rec raw_to_value = function - | Raw.String a -> StringValue a - | Raw.Int a -> IntValue a - | Raw.Float a -> FloatValue a - | Raw.List a -> List (List.map raw_to_value a) - | Raw.Tuple a -> SmallList (List.map raw_to_value a) - | Raw.Section a -> Module (List.map (fun (name,value) -> name, raw_to_value value) a) - -let define_option_class _ of_option_value to_option_value = - {to_raw = (fun a -> a |> to_option_value |> value_to_raw); - of_raw = (fun a -> a |> raw_to_value |> of_option_value)} - -let to_value {to_raw = to_raw} a = a |> to_raw |> raw_to_value -let from_value {of_raw = of_raw} a = a |> value_to_raw |> of_raw - -let of_value_w wrappers a = a |> value_to_raw |> wrappers.of_raw -let to_value_w wrappers a = a |> wrappers.to_raw |> raw_to_value -(* fancy indentation when finishing this stub code, not good style :-) *) -let value_to_string : option_value -> string = of_value_w string_option -let string_to_value = to_value_w string_option -let value_to_int = of_value_w int_option -let int_to_value = to_value_w int_option -let value_to_bool = of_value_w bool_option -let bool_to_value = to_value_w bool_option -let value_to_float = of_value_w float_option -let float_to_value = to_value_w float_option -let value_to_string2 = of_value_w string2_option -let string2_to_value = to_value_w string2_option -let value_to_list of_value = - let wrapper = define_option_class "" of_value (fun _ -> failwith "value_to_list") in - of_value_w (list_option wrapper) -let list_to_value to_value = - let wrapper = define_option_class "" (fun _ -> failwith "value_to_list") to_value in - to_value_w (list_option wrapper) diff --git a/ide/utils/config_file.mli b/ide/utils/config_file.mli deleted file mode 100644 index 22328e7f1f..0000000000 --- a/ide/utils/config_file.mli +++ /dev/null @@ -1,352 +0,0 @@ -(*********************************************************************************) -(* Cameleon *) -(* *) -(* Copyright (C) 2005 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. *) -(* *) -(* This program is free software; you can redistribute it and/or modify *) -(* it under the terms of the GNU Library General Public License as *) -(* published by the Free Software Foundation; either version 2 of the *) -(* License, or any later version. *) -(* *) -(* This program is distributed in the hope that it will be useful, *) -(* but WITHOUT ANY WARRANTY; without even the implied warranty of *) -(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) -(* GNU Library General Public License for more details. *) -(* *) -(* You should have received a copy of the GNU Library General Public *) -(* License along with this program; if not, write to the Free Software *) -(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA *) -(* 02111-1307 USA *) -(* *) -(* Contact: Maxence.Guesdon@inria.fr *) -(* *) -(*********************************************************************************) - -(** - This module implements a mechanism to handle configuration files. - A configuration file is defined as a set of [variable = value] lines, - where value can be - a simple string (types int, string, bool...), - a list of values between brackets (lists) or parentheses (tuples), - or a set of [variable = value] lines between braces. - The configuration file is automatically loaded and saved, - and configuration parameters are manipulated inside the program as easily as references. - - Object implementation by Jean-Baptiste Rouquier. -*) - -(** {1:lowlevelinterface Low level interface} *) -(** Skip this section on a first reading... *) - -(** The type of cp freshly parsed from configuration file, -not yet wrapped in their proper type. *) -module Raw : sig - type cp = - | String of string (** base types, reproducing the tokens of Genlex *) - | Int of int - | Float of float - | List of cp list (** compound types *) - | Tuple of cp list - | Section of (string * cp) list - - (** A parser. *) - val of_string : string -> cp - - (** Used to print the values into a log file for instance. *) - val to_channel : out_channel -> cp -> unit -end - -(** A type used to specialize polymorphics classes and define new classes. - {!Config_file.predefinedwrappers} are provided. - *) -type 'a wrappers = { to_raw : 'a -> Raw.cp; of_raw : Raw.cp -> 'a; } - -(** An exception raised by {!Config_file.cp.set_raw} - when the argument doesn't have a suitable {!Config_file.Raw.cp} type. - The function explains the problem and flush the output.*) -exception Wrong_type of (out_channel -> unit) - -(* (\** {2 Miscellaneous functions} *\) *) - -(* val bool_of_string : string -> bool *) - -(** {1 High level interface} *) -(** {2 The two main classes} *) - -(** A Configuration Parameter, in short cp, ie - a value we can store in and read from a configuration file. *) -class type ['a] cp = object - (** {1 Accessing methods} *) - - method get : 'a - method set : 'a -> unit - method get_default : 'a - method get_help : string - method get_name : string list - - (** Resets to the default value. *) - method reset : unit - - (** {1 Miscellaneous} *) - - (** All the hooks are executed each time the method set is called, - just after setting the new value.*) - method add_hook : ('a -> 'a -> unit) -> unit - - (** Used to generate command line arguments in {!Config_file.group.command_line_args} *) - method set_short_name : string -> unit - - (** [None] if no optional short_name was provided during object creation - and [set_short_name] was never called.*) - method get_short_name : string option - - (** {1 Methods for internal use} *) - - method get_formatted : Format.formatter -> unit - method get_default_formatted : Format.formatter -> unit - method get_help_formatted : Format.formatter -> unit - - method get_spec : Arg.spec - method set_raw : Raw.cp -> unit -end - -(** Unification over all possible ['a cp]: - contains the main methods of ['a cp] except the methods using the type ['a]. - A [group] manipulates only [groupable_cp] for homogeneity. *) -type groupable_cp = < - get_name : string list; - get_short_name : string option; - get_help : string; - - get_formatted : Format.formatter -> unit; - get_default_formatted : Format.formatter -> unit; - get_help_formatted : Format.formatter -> unit; - get_spec : Arg.spec; - - reset : unit; - set_raw : Raw.cp -> unit; > - -(** Raised in case a name is already used. - See {!Config_file.group.add} *) -exception Double_name - -(** An exception possibly raised if we want to check that - every cp is defined in a configuration file. - See {!Config_file.group.read}. -*) -exception Missing_cp of groupable_cp - -(** A group of cps, that can be loaded and saved, -or used to generate command line arguments. - -The basic usage is to have only one group and one configuration file, -but this mechanism allows having more, -for instance having another smaller group for the options to pass on the command line. -*) -class group : object - (** Adds a cp to the group. - Note that the type ['a] must be lost - to allow cps of different types to belong to the same group. - @raise Double_name if [cp#get_name] is already used. *) -(* method add : 'a cp -> 'a cp *) - method add : 'a cp -> unit - - (**[write filename] saves all the cps into the configuration file [filename].*) - method write : ?with_help:bool -> string -> unit - - (** [read filename] reads [filename] - and stores the values it specifies into the cps belonging to this group. - The file is created (and not read) if it doesn't exists. - In the default behaviour, no warning is issued - if not all cps are updated or if some values of [filename] aren't used. - - If [obsoletes] is specified, - then prints in this file all the values that are - in [filename] but not in this group. - Those cps are likely to be erroneous or obsolete. - Opens this file only if there is something to write in it. - - If [no_default] is [true], then raises [Missing_cp foo] if - the cp [foo] isn't defined in [filename] but belongs to this group. - - [on_type_error groupable_cp value output filename in_channel] - is called if the file doesn't give suitable value - (string instead of int for instance, or a string not belonging to the expected enumeration) - for the cp [groupable_cp]. - [value] is the value read from the file, - [output] is the argument of {!Config_file.Wrong_type}, - [filename] is the same argument as the one given to read, - and [in_channel] refers to [filename] to allow a function to close it if needed. - Default behaviour is to print an error message and call [exit 1]. -*) - method read : ?obsoletes:string -> ?no_default:bool -> - ?on_type_error : (groupable_cp -> Raw.cp -> (out_channel -> unit) -> - string -> in_channel -> unit) -> - string -> unit - - (** Interface with module Arg. - @param section_separator the string used to concatenate the name of a cp, - to get the command line option name. - ["-"] is a good default. - @return a list that can be used with [Arg.parse] and [Arg.usage].*) - method command_line_args : section_separator:string -> (string * Arg.spec * string) list - end - -(** {2 Predefined cp classes} *) - -(** The last three non-optional arguments are always - [name] (of type string list), [default_value] and [help] (of type string). - - [name] is the path to the cp: [["section";"subsection"; ...; "foo"]]. - It can consists of a single element but must not be empty. - - [short_name] will be added a "-" and used in - {!Config_file.group.command_line_args}. - - [group], if provided, adds the freshly defined option to it - (something like [initializer group#add self]). - - [help] needs not contain newlines, it will be automatically truncated where needed. - It is mandatory but can be [""]. -*) - -class int_cp : ?group:group -> string list -> ?short_name:string -> int -> string -> [int] cp -class float_cp : ?group:group -> string list -> ?short_name:string -> float -> string -> [float] cp -class bool_cp : ?group:group -> string list -> ?short_name:string -> bool -> string -> [bool] cp -class string_cp : ?group:group -> string list -> ?short_name:string -> string -> string -> [string] cp -class ['a] list_cp : 'a wrappers -> ?group:group -> string list -> ?short_name:string -> 'a list -> string -> ['a list] cp -class ['a] option_cp : 'a wrappers -> ?group:group -> string list -> ?short_name:string -> 'a option -> string -> ['a option] cp -class ['a] enumeration_cp : (string * 'a) list -> ?group:group -> string list -> ?short_name:string -> 'a -> string -> ['a] cp -class ['a, 'b] tuple2_cp : 'a wrappers -> 'b wrappers -> ?group:group -> string list -> ?short_name:string -> 'a * 'b -> string -> ['a * 'b] cp -class ['a, 'b, 'c] tuple3_cp : 'a wrappers -> 'b wrappers -> 'c wrappers -> ?group:group -> string list -> ?short_name:string -> 'a * 'b * 'c -> string -> ['a * 'b * 'c] cp -class ['a, 'b, 'c, 'd] tuple4_cp : 'a wrappers -> 'b wrappers -> 'c wrappers -> 'd wrappers -> ?group:group -> string list -> ?short_name:string -> 'a * 'b * 'c * 'd -> string -> ['a * 'b * 'c * 'd] cp -class string2_cp : ?group:group -> string list -> ?short_name:string -> string * string -> string -> [string, string] tuple2_cp -(* class color_cp : ?group:group -> string list -> ?short_name:string -> string -> string -> string_cp *) -class font_cp : ?group:group -> string list -> ?short_name:string -> string -> string -> string_cp -class filename_cp : ?group:group -> string list -> ?short_name:string -> string -> string -> string_cp - -(** {2:predefinedwrappers Predefined wrappers} *) - -val int_wrappers : int wrappers -val float_wrappers : float wrappers -val bool_wrappers : bool wrappers -val string_wrappers : string wrappers -val list_wrappers : 'a wrappers -> 'a list wrappers -val option_wrappers : 'a wrappers -> 'a option wrappers - -(** If you have a [type suit = Spades | Hearts | Diamond | Clubs], then -{[enumeration_wrappers ["spades",Spades; "hearts",Hearts; "diamond",Diamond; "clubs",Clubs]]} -will allow you to use cp of this type. -For sum types with not only constant constructors, -you will need to define your own cp class. *) -val enumeration_wrappers : (string * 'a) list -> 'a wrappers -val tuple2_wrappers : 'a wrappers -> 'b wrappers -> ('a * 'b) wrappers -val tuple3_wrappers : 'a wrappers -> 'b wrappers -> 'c wrappers -> ('a * 'b * 'c) wrappers -val tuple4_wrappers : 'a wrappers -> 'b wrappers -> 'c wrappers -> 'd wrappers -> ('a * 'b * 'c * 'd) wrappers - -(** {2 Defining new cp classes} *) - -(** To define a new cp class, you just have to provide an implementation for the wrappers -between your type [foo] and the type [Raw.cp]. -Once you have your wrappers [w], write -{[class foo_cp = [foo] cp_custom_type w]} - -For further details, have a look at the commented .ml file, -section "predefined cp classes". -*) -class ['a] cp_custom_type : 'a wrappers -> - ?group:group -> string list -> ?short_name:string -> 'a -> string -> ['a] cp - - -(** {1 Backward compatibility} - -Deprecated. - -All the functions from the module Options are available, except: - -- [prune_file]: use [group#write ?obsoletes:"foo.ml"]. -- [smalllist_to_value], [smalllist_option]: use lists or tuples. -- [get_class]. -- [class_hook]: hooks are local to a cp. - If you want hooks global to a class, - define a new class that inherit from {!Config_file.cp_custom_type}. -- [set_simple_option], [get_simple_option], [simple_options], [simple_args]: - use {!Config_file.group.write}. -- [set_option_hook]: use {!Config_file.cp.add_hook}. -- [set_string_wrappers]: define a new class with {!Config_file.cp_custom_type}. - -The old configurations files are readable by this module. -*) - - - - - -(**/**) -type 'a option_class -type 'a option_record -type options_file - -val create_options_file : string -> options_file -val set_options_file : options_file -> string -> unit -val load : options_file -> unit -val append : options_file -> string -> unit -val save : options_file -> unit -val save_with_help : options_file -> unit -(* val define_option : options_file -> *) -(* string list -> string -> 'a option_class -> 'a -> 'a option_record *) -val option_hook : 'a option_record -> (unit -> unit) -> unit - -val string_option : string option_class -val color_option : string option_class -val font_option : string option_class -val int_option : int option_class -val bool_option : bool option_class -val float_option : float option_class -val string2_option : (string * string) option_class - -val option_option : 'a option_class -> 'a option option_class -val list_option : 'a option_class -> 'a list option_class -val sum_option : (string * 'a) list -> 'a option_class -val tuple2_option : - 'a option_class * 'b option_class -> ('a * 'b) option_class -val tuple3_option : 'a option_class * 'b option_class * 'c option_class -> - ('a * 'b * 'c) option_class -val tuple4_option : - 'a option_class * 'b option_class * 'c option_class * 'd option_class -> - ('a * 'b * 'c * 'd) option_class - -val ( !! ) : 'a option_record -> 'a -val ( =:= ) : 'a option_record -> 'a -> unit -val shortname : 'a option_record -> string -val get_help : 'a option_record -> string - -type option_value = - Module of option_module -| StringValue of string -| IntValue of int -| FloatValue of float -| List of option_value list -| SmallList of option_value list -and option_module = (string * option_value) list - -val define_option_class : - string -> (option_value -> 'a) -> ('a -> option_value) -> 'a option_class - -val to_value : 'a option_class -> 'a -> option_value -val from_value : 'a option_class -> option_value -> 'a - -val value_to_string : option_value -> string -val string_to_value : string -> option_value -val value_to_int : option_value -> int -val int_to_value : int -> option_value -val bool_of_string : string -> bool -val value_to_bool : option_value -> bool -val bool_to_value : bool -> option_value -val value_to_float : option_value -> float -val float_to_value : float -> option_value -val value_to_string2 : option_value -> string * string -val string2_to_value : string * string -> option_value -val value_to_list : (option_value -> 'a) -> option_value -> 'a list -val list_to_value : ('a -> option_value) -> 'a list -> option_value diff --git a/ide/utils/configwin.ml b/ide/utils/configwin.ml index 4606ef29fd..69e8b647ae 100644 --- a/ide/utils/configwin.ml +++ b/ide/utils/configwin.ml @@ -36,44 +36,16 @@ type return_button = | Return_ok | Return_cancel -let string_to_key = Configwin_types.string_to_key -let key_to_string = Configwin_types.key_to_string -let key_cp_wrapper = Configwin_types.key_cp_wrapper -class key_cp = Configwin_types.key_cp - - let string = Configwin_ihm.string -let text = Configwin_ihm.text let strings = Configwin_ihm.strings let list = Configwin_ihm.list let bool = Configwin_ihm.bool -let filename = Configwin_ihm.filename -let filenames = Configwin_ihm.filenames -let color = Configwin_ihm.color -let font = Configwin_ihm.font let combo = Configwin_ihm.combo let custom = Configwin_ihm.custom -let date = Configwin_ihm.date -let hotkey = Configwin_ihm.hotkey let modifiers = Configwin_ihm.modifiers -let html = Configwin_ihm.html let edit ?(apply=(fun () -> ())) title ?width ?height conf_struct_list = Configwin_ihm.edit ~with_apply: true ~apply title ?width ?height conf_struct_list - -let get = Configwin_ihm.edit ~with_apply: false ~apply: (fun () -> ()) - -let simple_edit - ?(apply=(fun () -> ())) - title ?width ?height - param_list = Configwin_ihm.simple_edit ~with_apply: true ~apply title ?width ?height param_list - -let simple_get = Configwin_ihm.simple_edit - ~with_apply: false ~apply: (fun () -> ()) - -let box = Configwin_ihm.box - -let tabbed_box = Configwin_ihm.tabbed_box diff --git a/ide/utils/configwin.mli b/ide/utils/configwin.mli index c5fbf39a01..7616e471db 100644 --- a/ide/utils/configwin.mli +++ b/ide/utils/configwin.mli @@ -50,22 +50,6 @@ type return_button = button or the window manager but never clicked on the apply button.*) - -(** {2 The key option class (to use with the {!Config_file} library)} *) - -val string_to_key : string -> Gdk.Tags.modifier list * int - -val key_to_string : Gdk.Tags.modifier list * int -> string - -val key_cp_wrapper : (Gdk.Tags.modifier list * int) Config_file.wrappers - -class key_cp : - ?group:Config_file.group -> - string list -> - ?short_name:string -> - Gdk.Tags.modifier list * int -> - string -> [Gdk.Tags.modifier list * int] Config_file.cp_custom_type - (** {2 Functions to create parameters} *) (** [string label value] creates a string parameter. @@ -136,24 +120,6 @@ val list : ?editable: bool -> ?help: string -> 'a list -> parameter_kind -(** [color label value] creates a color parameter. - @param editable indicate if the value is editable (default is [true]). - @param expand indicate if the entry widget must expand or not (default is [true]). - @param help an optional help message. - @param f the function called to apply the value (default function does nothing). -*) -val color : ?editable: bool -> ?expand: bool -> ?help: string -> - ?f: (string -> unit) -> string -> string -> parameter_kind - -(** [font label value] creates a font parameter. - @param editable indicate if the value is editable (default is [true]). - @param expand indicate if the entry widget must expand or not (default is [true]). - @param help an optional help message. - @param f the function called to apply the value (default function does nothing). -*) -val font : ?editable: bool -> ?expand: bool -> ?help: string -> - ?f: (string -> unit) -> string -> string -> parameter_kind - (** [combo label choices value] creates a combo parameter. @param editable indicate if the value is editable (default is [true]). @param expand indicate if the entry widget must expand or not (default is [true]). @@ -169,69 +135,6 @@ val combo : ?editable: bool -> ?expand: bool -> ?help: string -> ?new_allowed: bool -> ?blank_allowed: bool -> string -> string list -> string -> parameter_kind -(** [text label value] creates a text parameter. - @param editable indicate if the value is editable (default is [true]). - @param expand indicate if the box for the text must expand or not (default is [true]). - @param help an optional help message. - @param f the function called to apply the value (default function does nothing). -*) -val text : ?editable: bool -> ?expand: bool -> ?help: string -> - ?f: (string -> unit) -> string -> string -> parameter_kind - -(** Same as {!Configwin.text} but html bindings are available - in the text widget. Use the [configwin_html_config] utility - to edit your bindings. -*) -val html : ?editable: bool -> ?expand: bool -> ?help: string -> - ?f: (string -> unit) -> string -> string -> parameter_kind - -(** [filename label value] creates a filename parameter. - @param editable indicate if the value is editable (default is [true]). - @param expand indicate if the entry widget must expand or not (default is [true]). - @param help an optional help message. - @param f the function called to apply the value (default function does nothing). -*) -val filename : ?editable: bool -> ?expand: bool -> ?help: string -> - ?f: (string -> unit) -> string -> string -> parameter_kind - -(** [filenames label value] creates a filename list parameter. - @param editable indicate if the value is editable (default is [true]). - @param help an optional help message. - @param f the function called to apply the value (default function does nothing). - @param eq the comparison function, used not to have doubles in list. Default - is [Pervasives.(=)]. If you want to allow doubles in the list, give a function - always returning false. -*) -val filenames : ?editable: bool -> ?help: string -> - ?f: (string list -> unit) -> - ?eq: (string -> string -> bool) -> - string -> string list -> parameter_kind - -(** [date label value] creates a date parameter. - @param editable indicate if the value is editable (default is [true]). - @param expand indicate if the entry widget must expand or not (default is [true]). - @param help an optional help message. - @param f the function called to apply the value (default function does nothing). - @param f_string the function used to display the date as a string. The parameter - is a tupe [(day,month,year)], where [month] is between [0] and [11]. The default - function creates the string [year/month/day]. -*) -val date : ?editable: bool -> ?expand: bool -> ?help: string -> - ?f: ((int * int * int) -> unit) -> - ?f_string: ((int * int * int -> string)) -> - string -> (int * int * int) -> parameter_kind - -(** [hotkey label value] creates a hot key parameter. - A hot key is defined by a list of modifiers and a key code. - @param editable indicate if the value is editable (default is [true]). - @param expand indicate if the entry widget must expand or not (default is [true]). - @param help an optional help message. - @param f the function called to apply the value (default function does nothing). -*) -val hotkey : ?editable: bool -> ?expand: bool -> ?help: string -> - ?f: ((Gdk.Tags.modifier list * int) -> unit) -> - string -> (Gdk.Tags.modifier list * int) -> parameter_kind - val modifiers : ?editable: bool -> ?expand: bool -> ?help: string -> ?allow:(Gdk.Tags.modifier list) -> ?f: (Gdk.Tags.modifier list -> unit) -> @@ -259,46 +162,3 @@ val edit : ?height:int -> configuration_structure list -> return_button - -(** This function takes a configuration structure and creates a window used - to get the various parameters from the user. It is the same window as edit but - there is no apply button.*) -val get : - string -> - ?width:int -> - ?height:int -> - configuration_structure list -> - return_button - -(** This function takes a list of parameter specifications and - creates a window to configure the various parameters. - @param apply this function is called when the apply button is clicked, after - giving new values to parameters.*) -val simple_edit : - ?apply: (unit -> unit) -> - string -> - ?width:int -> - ?height:int -> - parameter_kind list -> return_button - -(** This function takes a list of parameter specifications and - creates a window to configure the various parameters, - without Apply button.*) -val simple_get : - string -> - ?width:int -> - ?height:int -> - parameter_kind list -> return_button - -(** Create a [GPack.box] with the list of given parameters, - Return the box and the function to call to apply new values to parameters. -*) -val box : parameter_kind list -> GData.tooltips -> GPack.box * (unit -> unit) - -(** Create a [GPack.box] with the list of given configuration structure list, - and the given list of buttons (defined by their label and callback). - Before calling the callback of a button, the [apply] function - of each parameter is called. -*) -val tabbed_box : configuration_structure list -> - (string * (unit -> unit)) list -> GData.tooltips -> GPack.box diff --git a/ide/utils/configwin_ihm.ml b/ide/utils/configwin_ihm.ml index c1062a9db1..70133fb9f5 100644 --- a/ide/utils/configwin_ihm.ml +++ b/ide/utils/configwin_ihm.ml @@ -27,7 +27,25 @@ open Configwin_types -module O = Config_file +let modifiers_to_string m = + let rec iter m s = + match m with + [] -> s + | c :: m -> + iter m (( + match c with + `CONTROL -> "<ctrl>" + | `SHIFT -> "<shft>" + | `LOCK -> "<lock>" + | `MOD1 -> "<alt>" + | `MOD2 -> "<mod2>" + | `MOD3 -> "<mod3>" + | `MOD4 -> "<mod4>" + | `MOD5 -> "<mod5>" + | _ -> raise Not_found + ) ^ s) + in + iter m "" class type widget = object @@ -35,112 +53,9 @@ class type widget = method apply : unit -> unit end -let file_html_config = Filename.concat Configwin_messages.home ".configwin_html" - let debug = false let dbg s = if debug then Minilib.log s else () -(** Return the config group for the html config file, - and the option for bindings. *) -let html_config_file_and_option () = - let ini = new O.group in - let bindings = new O.list_cp - Configwin_types.htmlbinding_cp_wrapper - ~group: ini - ["bindings"] - ~short_name: "bd" - [ { html_key = Configwin_types.string_to_key "A-b" ; - html_begin = "<b>"; - html_end = "</b>" ; - } ; - { html_key = Configwin_types.string_to_key "A-i" ; - html_begin = "<i>"; - html_end = "</i>" ; - } - ] - "" - in - ini#read file_html_config ; - (ini, bindings) - -(** This variable contains the last directory where the user selected a file.*) -let last_dir = ref "";; - -(** This function allows the user to select a file and returns the - selected file name. An optional function allows changing the - behaviour of the ok button. - A VOIR : mutli-selection ? *) -let select_files ?dir - ?(fok : (string -> unit) option) - the_title = - let files = ref ([] : string list) in - let fs = GWindow.file_selection ~modal:true - ~title: the_title () in - (* we set the previous directory, if no directory is given *) - ( - match dir with - None -> - if !last_dir <> "" then - let _ = fs#set_filename !last_dir in - () - else - () - | Some dir -> - let _ = fs#set_filename !last_dir in - () - ); - - let _ = fs # connect#destroy ~callback: GMain.Main.quit in - let _ = fs # ok_button # connect#clicked ~callback: - (match fok with - None -> - (fun () -> files := [fs#filename] ; fs#destroy ()) - | Some f -> - (fun () -> f fs#filename) - ) - in - let _ = fs # cancel_button # connect#clicked ~callback:fs#destroy in - fs # show (); - GMain.Main.main (); - match !files with - | [] -> - [] - | [""] -> - [] - | l -> - (* we keep the directory in last_dir *) - last_dir := Filename.dirname (List.hd l); - l -;; - -(** Make the user select a date. *) -let select_date title (day,mon,year) = - let v_opt = ref None in - let window = GWindow.dialog ~modal:true ~title () in - let hbox = GPack.hbox ~border_width:10 ~packing:window#vbox#add () in - let cal = GMisc.calendar ~packing: (hbox#pack ~expand: true) () in - cal#select_month ~month: mon ~year: year ; - cal#select_day day; - let bbox = window#action_area in - - let bok = GButton.button ~label: Configwin_messages.mOk - ~packing:(bbox#pack ~expand:true ~padding:4) () - in - let bcancel = GButton.button ~label: Configwin_messages.mCancel - ~packing:(bbox#pack ~expand:true ~padding:4) () - in - ignore (bok#connect#clicked ~callback: - (fun () -> v_opt := Some (cal#date); window#destroy ())); - ignore(bcancel#connect#clicked ~callback: window#destroy); - - bok#grab_default (); - ignore(window#connect#destroy ~callback: GMain.Main.quit); - window#set_position `CENTER; - window#show (); - GMain.Main.main (); - !v_opt - - (** This class builds a frame with a clist and two buttons : one to add items and one to remove the selected items. The class takes in parameter a function used to add items and @@ -460,164 +375,6 @@ class custom_param_box param (tt:GData.tooltips) = method apply = param.custom_f_apply () end -(** This class is used to build a box for a color parameter.*) -class color_param_box param (tt:GData.tooltips) = - let _ = dbg "color_param_box" in - let v = ref param.color_value in - let hbox = GPack.hbox () in - let wb = GButton.button ~label: param.color_label - ~packing: (hbox#pack ~expand: false ~padding: 2) () - in - let w_test = GMisc.arrow - ~kind: `RIGHT - ~shadow: `OUT - ~width: 20 - ~height: 20 - ~packing: (hbox#pack ~expand: false ~padding: 2 ) - () - in - let we = GEdit.entry - ~editable: param.color_editable - ~packing: (hbox#pack ~expand: param.color_expand ~padding: 2) - () - in - let _ = - match param.color_help with - None -> () - | Some help -> - tt#set_tip ~text: help ~privat: help wb#coerce - in - let set_color s = - let style = w_test#misc#style#copy in - ( - try style#set_fg [ (`NORMAL, `NAME s) ; ] - with _ -> () - ); - w_test#misc#set_style style; - in - let _ = set_color !v in - let _ = we#set_text !v in - let f_sel () = - let dialog = GWindow.color_selection_dialog - ~title: param.color_label - ~modal: true - ~show: true - () - in - let wb_ok = dialog#ok_button in - let wb_cancel = dialog#cancel_button in - let _ = dialog#connect#destroy ~callback:GMain.Main.quit in - let _ = wb_ok#connect#clicked - ~callback:(fun () -> -(* let color = dialog#colorsel#color in - let r = (Gdk.Color.red color) in - let g = (Gdk.Color.green color)in - let b = (Gdk.Color.blue color) in - let s = Printf.sprintf "#%4X%4X%4X" r g b in - let _ = - for i = 1 to (String.length s) - 1 do - if s.[i] = ' ' then s.[i] <- '0' - done - in - we#set_text s ; *) - dialog#destroy () - ) - in - let _ = wb_cancel#connect#clicked ~callback:dialog#destroy in - GMain.Main.main () - in - let _ = - if param.color_editable then ignore (wb#connect#clicked ~callback:f_sel) - in - - object (self) - (** This method returns the main box ready to be packed. *) - method box = hbox#coerce - (** This method applies the new value of the parameter. *) - method apply = - let new_value = we#text in - if new_value <> param.color_value then - let _ = param.color_f_apply new_value in - param.color_value <- new_value - else - () - - initializer - ignore (we#connect#changed ~callback:(fun () -> set_color we#text)); - - end ;; - -(** This class is used to build a box for a font parameter.*) -class font_param_box param (tt:GData.tooltips) = - let _ = dbg "font_param_box" in - let v = ref param.font_value in - let hbox = GPack.hbox () in - let wb = GButton.button ~label: param.font_label - ~packing: (hbox#pack ~expand: false ~padding: 2) () - in - let we = GEdit.entry - ~editable: false - ~packing: (hbox#pack ~expand: param.font_expand ~padding: 2) - () - in - let _ = - match param.font_help with - None -> () - | Some help -> - tt#set_tip ~text: help ~privat: help wb#coerce - in - let set_entry_font font_opt = - match font_opt with - None -> () - | Some s -> - let style = we#misc#style#copy in - ( - try - let font = Gdk.Font.load_fontset s in - style#set_font font - with _ -> () - ); - we#misc#set_style style - in - let _ = set_entry_font (Some !v) in - let _ = we#set_text !v in - let f_sel () = - let dialog = GWindow.font_selection_dialog - ~title: param.font_label - ~modal: true - ~show: true - () - in - dialog#selection#set_font_name !v; - let wb_ok = dialog#ok_button in - let wb_cancel = dialog#cancel_button in - let _ = dialog#connect#destroy ~callback:GMain.Main.quit in - let _ = wb_ok#connect#clicked - ~callback:(fun () -> - let font = dialog#selection#font_name in - we#set_text font ; - set_entry_font (Some font); - dialog#destroy () - ) - in - let _ = wb_cancel#connect#clicked ~callback:dialog#destroy in - GMain.Main.main () - in - let _ = if param.font_editable then ignore (wb#connect#clicked ~callback:f_sel) in - - object (self) - (** This method returns the main box ready to be packed. *) - method box = hbox#coerce - (** This method applies the new value of the parameter. *) - method apply = - let new_value = we#text in - if new_value <> param.font_value then - let _ = param.font_f_apply new_value in - param.font_value <- new_value - else - () - end ;; - (** This class is used to build a box for a text parameter.*) class text_param_box param (tt:GData.tooltips) = let _ = dbg "text_param_box" in @@ -662,35 +419,6 @@ class text_param_box param (tt:GData.tooltips) = () end ;; -(** This class is used to build a box a html parameter. *) -class html_param_box param (tt:GData.tooltips) = - let _ = dbg "html_param_box" in - object (self) - inherit text_param_box param tt - - method private exec html_start html_end () = - let (i1,i2) = wview#buffer#selection_bounds in - let s = i1#get_text ~stop: i2 in - match s with - "" -> - wview#buffer#insert (html_start^html_end) - | _ -> - ignore (wview#buffer#insert ~iter: i2 html_end); - ignore (wview#buffer#insert ~iter: i1 html_start); - wview#buffer#place_cursor ~where: i2 - - initializer - dbg "html_param_box:initializer"; - let (_,html_bindings) = html_config_file_and_option () in - dbg "html_param_box:connecting key press events"; - let add_shortcut hb = - let (mods, k) = hb.html_key in - Okey.add wview ~mods k (self#exec hb.html_begin hb.html_end) - in - List.iter add_shortcut html_bindings#get; - dbg "html_param_box:end" - end - (** This class is used to build a box for a boolean parameter.*) class bool_param_box param (tt:GData.tooltips) = let _ = dbg "bool_param_box" in @@ -719,105 +447,6 @@ class bool_param_box param (tt:GData.tooltips) = () end ;; -(** This class is used to build a box for a file name parameter.*) -class filename_param_box param (tt:GData.tooltips) = - let _ = dbg "filename_param_box" in - let hbox = GPack.hbox () in - let wb = GButton.button ~label: param.string_label - ~packing: (hbox#pack ~expand: false ~padding: 2) () - in - let we = GEdit.entry - ~editable: param.string_editable - ~packing: (hbox#pack ~expand: param.string_expand ~padding: 2) - () - in - let _ = - match param.string_help with - None -> () - | Some help -> - tt#set_tip ~text: help ~privat: help wb#coerce - in - let _ = we#set_text (param.string_to_string param.string_value) in - - let f_click () = - match select_files param.string_label with - [] -> - () - | f :: _ -> - we#set_text f - in - let _ = - if param.string_editable then - let _ = wb#connect#clicked ~callback:f_click in - () - else - () - in - - object (self) - (** This method returns the main box ready to be packed. *) - method box = hbox#coerce - (** This method applies the new value of the parameter. *) - method apply = - let new_value = param.string_of_string we#text in - if new_value <> param.string_value then - let _ = param.string_f_apply new_value in - param.string_value <- new_value - else - () - end ;; - -(** This class is used to build a box for a hot key parameter.*) -class hotkey_param_box param (tt:GData.tooltips) = - let _ = dbg "hotkey_param_box" in - let hbox = GPack.hbox () in - let wev = GBin.event_box ~packing: (hbox#pack ~expand: false ~padding: 2) () in - let _wl = GMisc.label ~text: param.hk_label ~packing: wev#add () in - let we = GEdit.entry - ~editable: false - ~packing: (hbox#pack ~expand: param.hk_expand ~padding: 2) - () - in - let value = ref param.hk_value in - let _ = - match param.hk_help with - None -> () - | Some help -> - tt#set_tip ~text: help ~privat: help wev#coerce - in - let _ = we#set_text (Configwin_types.key_to_string param.hk_value) in - let mods_we_dont_care = [`MOD2 ; `MOD3 ; `MOD4 ; `MOD5 ; `LOCK] in - let capture ev = - let key = GdkEvent.Key.keyval ev in - let modifiers = GdkEvent.Key.state ev in - let mods = List.filter - (fun m -> not (List.mem m mods_we_dont_care)) - modifiers - in - value := (mods, key); - we#set_text (Glib.Convert.locale_to_utf8 (Configwin_types.key_to_string !value)); - false - in - let _ = - if param.hk_editable then - ignore (we#event#connect#key_press ~callback:capture) - else - () - in - - object (self) - (** This method returns the main box ready to be packed. *) - method box = hbox#coerce - (** This method applies the new value of the parameter. *) - method apply = - let new_value = !value in - if new_value <> param.hk_value then - let _ = param.hk_f_apply new_value in - param.hk_value <- new_value - else - () - end ;; - class modifiers_param_box param = let hbox = GPack.hbox () in let wev = GBin.event_box ~packing: (hbox#pack ~expand:true ~fill:true ~padding: 2) () in @@ -825,7 +454,7 @@ class modifiers_param_box param = let value = ref param.md_value in let _ = List.map (fun modifier -> let but = GButton.toggle_button - ~label:(Configwin_types.modifiers_to_string [modifier]) + ~label:(modifiers_to_string [modifier]) ~active:(List.mem modifier param.md_value) ~packing:(hbox#pack ~expand:false) () in ignore (but#connect#toggled @@ -854,55 +483,6 @@ class modifiers_param_box param = () end ;; -(** This class is used to build a box for a date parameter.*) -class date_param_box param (tt:GData.tooltips) = - let _ = dbg "date_param_box" in - let v = ref param.date_value in - let hbox = GPack.hbox () in - let wb = GButton.button ~label: param.date_label - ~packing: (hbox#pack ~expand: false ~padding: 2) () - in - let we = GEdit.entry - ~editable: false - ~packing: (hbox#pack ~expand: param.date_expand ~padding: 2) - () - in - - let _ = - match param.date_help with - None -> () - | Some help -> - tt#set_tip ~text: help ~privat: help wb#coerce - in - - let _ = we#set_text (param.date_f_string param.date_value) in - let f_click () = - match select_date param.date_label !v with - None -> () - | Some (y,m,d) -> - v := (d,m,y) ; - we#set_text (param.date_f_string (d,m,y)) - in - let _ = - if param.date_editable then - let _ = wb#connect#clicked ~callback:f_click in - () - else - () - in - - object (self) - (** This method returns the main box ready to be packed. *) - method box = hbox#coerce - (** This method applies the new value of the parameter. *) - method apply = - if !v <> param.date_value then - let _ = param.date_f_apply !v in - param.date_value <- !v - else - () - end ;; - (** This class is used to build a box for a parameter whose values are a list.*) class ['a] list_param_box (param : 'a list_param) (tt:GData.tooltips) = let _ = dbg "list_param_box" in @@ -975,10 +555,6 @@ class configuration_box (tt : GData.tooltips) conf_struct = let box = new bool_param_box p tt in let _ = main_box#pack ~expand: false ~padding: 2 box#box in box - | Filename_param p -> - let box = new filename_param_box p tt in - let _ = main_box#pack ~expand: false ~padding: 2 box#box in - box | List_param f -> let box = f tt in let _ = main_box#pack ~expand: true ~padding: 2 box#box in @@ -987,30 +563,10 @@ class configuration_box (tt : GData.tooltips) conf_struct = let box = new custom_param_box p tt in let _ = main_box#pack ~expand: p.custom_expand ~padding: 2 box#box in box - | Color_param p -> - let box = new color_param_box p tt in - let _ = main_box#pack ~expand: false ~padding: 2 box#box in - box - | Font_param p -> - let box = new font_param_box p tt in - let _ = main_box#pack ~expand: false ~padding: 2 box#box in - box - | Date_param p -> - let box = new date_param_box p tt in - let _ = main_box#pack ~expand: false ~padding: 2 box#box in - box - | Hotkey_param p -> - let box = new hotkey_param_box p tt in - let _ = main_box#pack ~expand: false ~padding: 2 box#box in - box | Modifiers_param p -> let box = new modifiers_param_box p in let _ = main_box#pack ~expand: false ~padding: 2 box#box in box - | Html_param p -> - let box = new html_param_box p tt in - let _ = main_box#pack ~expand: p.string_expand ~padding: 2 box#box in - box in let set_icon iter = function @@ -1102,36 +658,6 @@ class configuration_box (tt : GData.tooltips) conf_struct = end -(** Create a vbox with the list of given configuration structure list, - and the given list of buttons (defined by their label and callback). - Before calling the callback of a button, the [apply] function - of each parameter is called. -*) -let tabbed_box conf_struct_list buttons tooltips = - let param_box = - new configuration_box tooltips conf_struct_list - in - let f_apply () = param_box#apply - in - let hbox_buttons = GPack.hbox ~packing: (param_box#box#pack ~expand: false ~padding: 4) () in - let rec iter_buttons ?(grab=false) = function - [] -> - () - | (label, callb) :: q -> - let b = GButton.button ~label: label - ~packing:(hbox_buttons#pack ~expand:true ~fill: true ~padding:4) () - in - ignore (b#connect#clicked ~callback: - (fun () -> f_apply (); callb ())); - (* If it's the first button then give it the focus *) - if grab then b#grab_default (); - - iter_buttons q - in - iter_buttons ~grab: true buttons; - - param_box#box - (** This function takes a configuration structure list and creates a window to configure the various parameters. *) let edit ?(with_apply=true) @@ -1174,110 +700,6 @@ let edit ?(with_apply=true) in iter Return_cancel -(** Create a vbox with the list of given parameters. *) -let box param_list tt = - let main_box = GPack.vbox () in - let f parameter = - match parameter with - String_param p -> - let box = new string_param_box p tt in - let _ = main_box#pack ~expand: false ~padding: 2 box#box in - box - | Combo_param p -> - let box = new combo_param_box p tt in - let _ = main_box#pack ~expand: false ~padding: 2 box#box in - box - | Text_param p -> - let box = new text_param_box p tt in - let _ = main_box#pack ~expand: p.string_expand ~padding: 2 box#box in - box - | Bool_param p -> - let box = new bool_param_box p tt in - let _ = main_box#pack ~expand: false ~padding: 2 box#box in - box - | Filename_param p -> - let box = new filename_param_box p tt in - let _ = main_box#pack ~expand: false ~padding: 2 box#box in - box - | List_param f -> - let box = f tt in - let _ = main_box#pack ~expand: true ~padding: 2 box#box in - box - | Custom_param p -> - let box = new custom_param_box p tt in - let _ = main_box#pack ~expand: p.custom_expand ~padding: 2 box#box in - box - | Color_param p -> - let box = new color_param_box p tt in - let _ = main_box#pack ~expand: false ~padding: 2 box#box in - box - | Font_param p -> - let box = new font_param_box p tt in - let _ = main_box#pack ~expand: false ~padding: 2 box#box in - box - | Date_param p -> - let box = new date_param_box p tt in - let _ = main_box#pack ~expand: false ~padding: 2 box#box in - box - | Hotkey_param p -> - let box = new hotkey_param_box p tt in - let _ = main_box#pack ~expand: false ~padding: 2 box#box in - box - | Modifiers_param p -> - let box = new modifiers_param_box p in - let _ = main_box#pack ~expand: false ~padding: 2 box#box in - box - | Html_param p -> - let box = new html_param_box p tt in - let _ = main_box#pack ~expand: p.string_expand ~padding: 2 box#box in - box - in - let list_param_box = List.map f param_list in - let f_apply () = - List.iter (fun param_box -> param_box#apply) list_param_box - in - (main_box, f_apply) - -(** This function takes a list of parameter specifications and - creates a window to configure the various parameters.*) -let simple_edit ?(with_apply=true) - ?(apply=(fun () -> ())) - title ?width ?height - param_list = - let dialog = GWindow.dialog - ~modal: true ~title: title - ?height ?width - () - in - let tooltips = GData.tooltips () in - if with_apply then - dialog#add_button Configwin_messages.mApply `APPLY; - - dialog#add_button Configwin_messages.mOk `OK; - dialog#add_button Configwin_messages.mCancel `CANCEL; - - let (box, f_apply) = box param_list tooltips in - dialog#vbox#pack ~expand: true ~fill: true box#coerce; - - let destroy () = - tooltips#destroy () ; - dialog#destroy (); - in - let rec iter rep = - try - match dialog#run () with - | `APPLY -> f_apply (); apply (); iter Return_apply - | `OK -> f_apply () ; destroy () ; Return_ok - | _ -> destroy (); rep - with - Failure s -> - GToolbox.message_box ~title:"Error" s; iter rep - | e -> - GToolbox.message_box ~title:"Error" (Printexc.to_string e); iter rep - in - iter Return_cancel - - let edit_string l s = match GToolbox.input_string ~title: l ~text: s Configwin_messages.mValue with None -> s @@ -1342,30 +764,6 @@ let strings ?(editable=true) ?help ?(add=(fun () -> [])) label v = list ~editable ?help ~f ~eq ~edit: (edit_string label) ~add label (fun s -> [s]) v -(** Create a color param. *) -let color ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label v = - Color_param - { - color_label = label ; - color_help = help ; - color_value = v ; - color_editable = editable ; - color_f_apply = f ; - color_expand = expand ; - } - -(** Create a font param. *) -let font ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label v = - Font_param - { - font_label = label ; - font_help = help ; - font_value = v ; - font_editable = editable ; - font_f_apply = f ; - font_expand = expand ; - } - (** Create a combo param. *) let combo ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) ?(new_allowed=false) @@ -1383,82 +781,6 @@ let combo ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) combo_expand = expand ; } -(** Create a text param. *) -let text ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label v = - Text_param - { - string_label = label ; - string_help = help ; - string_value = v ; - string_editable = editable ; - string_f_apply = f ; - string_expand = expand ; - string_to_string = (fun x -> x) ; - string_of_string = (fun x -> x) ; - } - -(** Create a html param. *) -let html ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label v = - Html_param - { - string_label = label ; - string_help = help ; - string_value = v ; - string_editable = editable ; - string_f_apply = f ; - string_expand = expand ; - string_to_string = (fun x -> x) ; - string_of_string = (fun x -> x) ; - } - -(** Create a filename param. *) -let filename ?(editable=true) ?(expand=true)?help ?(f=(fun _ -> ())) label v = - Filename_param - { - string_label = label ; - string_help = help ; - string_value = v ; - string_editable = editable ; - string_f_apply = f ; - string_expand = expand ; - string_to_string = (fun x -> x) ; - string_of_string = (fun x -> x) ; - } - -(** Create a filenames param.*) -let filenames ?(editable=true) ?help ?(f=(fun _ -> ())) - ?(eq=Pervasives.(=)) - label v = - let add () = select_files label in - list ~editable ?help ~f ~eq ~add label (fun s -> [Glib.Convert.locale_to_utf8 s]) v - -(** Create a date param. *) -let date ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) - ?(f_string=(fun(d,m,y)-> Printf.sprintf "%d/%d/%d" y (m+1) d)) - label v = - Date_param - { - date_label = label ; - date_help = help ; - date_value = v ; - date_editable = editable ; - date_f_string = f_string ; - date_f_apply = f ; - date_expand = expand ; - } - -(** Create a hot key param. *) -let hotkey ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label v = - Hotkey_param - { - hk_label = label ; - hk_help = help ; - hk_value = v ; - hk_editable = editable ; - hk_f_apply = f ; - hk_expand = expand ; - } - let modifiers ?(editable=true) ?(expand=true) diff --git a/ide/utils/configwin_ihm.mli b/ide/utils/configwin_ihm.mli new file mode 100644 index 0000000000..c867ad9127 --- /dev/null +++ b/ide/utils/configwin_ihm.mli @@ -0,0 +1,66 @@ +(*********************************************************************************) +(* Cameleon *) +(* *) +(* Copyright (C) 2005 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. *) +(* *) +(* This program is free software; you can redistribute it and/or modify *) +(* it under the terms of the GNU Library General Public License as *) +(* published by the Free Software Foundation; either version 2 of the *) +(* License, or any later version. *) +(* *) +(* This program is distributed in the hope that it will be useful, *) +(* but WITHOUT ANY WARRANTY; without even the implied warranty of *) +(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) +(* GNU Library General Public License for more details. *) +(* *) +(* You should have received a copy of the GNU Library General Public *) +(* License along with this program; if not, write to the Free Software *) +(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA *) +(* 02111-1307 USA *) +(* *) +(* Contact: Maxence.Guesdon@inria.fr *) +(* *) +(*********************************************************************************) + +open Configwin_types + +val string : ?editable: bool -> ?expand: bool -> ?help: string -> + ?f: (string -> unit) -> string -> string -> parameter_kind +val bool : ?editable: bool -> ?help: string -> + ?f: (bool -> unit) -> string -> bool -> parameter_kind +val strings : ?editable: bool -> ?help: string -> + ?f: (string list -> unit) -> + ?eq: (string -> string -> bool) -> + ?add: (unit -> string list) -> + string -> string list -> parameter_kind +val list : ?editable: bool -> ?help: string -> + ?f: ('a list -> unit) -> + ?eq: ('a -> 'a -> bool) -> + ?edit: ('a -> 'a) -> + ?add: (unit -> 'a list) -> + ?titles: string list -> + ?color: ('a -> string option) -> + string -> + ('a -> string list) -> + 'a list -> + parameter_kind +val combo : ?editable: bool -> ?expand: bool -> ?help: string -> + ?f: (string -> unit) -> + ?new_allowed: bool -> ?blank_allowed: bool -> + string -> string list -> string -> parameter_kind + +val modifiers : ?editable: bool -> ?expand: bool -> ?help: string -> + ?allow:(Gdk.Tags.modifier list) -> + ?f: (Gdk.Tags.modifier list -> unit) -> + string -> Gdk.Tags.modifier list -> parameter_kind +val custom : ?label: string -> GPack.box -> (unit -> unit) -> bool -> parameter_kind + +val edit : + ?with_apply:bool -> + ?apply:(unit -> unit) -> + string -> + ?width:int -> + ?height:int -> + configuration_structure list -> + return_button diff --git a/ide/utils/configwin_keys.ml b/ide/utils/configwin_keys.ml deleted file mode 100644 index 9f44e5c6be..0000000000 --- a/ide/utils/configwin_keys.ml +++ /dev/null @@ -1,4176 +0,0 @@ -(*********************************************************************************) -(* Cameleon *) -(* *) -(* Copyright (C) 2005 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. *) -(* *) -(* This program is free software; you can redistribute it and/or modify *) -(* it under the terms of the GNU Library General Public License as *) -(* published by the Free Software Foundation; either version 2 of the *) -(* License, or any later version. *) -(* *) -(* This program is distributed in the hope that it will be useful, *) -(* but WITHOUT ANY WARRANTY; without even the implied warranty of *) -(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) -(* GNU Library General Public License for more details. *) -(* *) -(* You should have received a copy of the GNU Library General Public *) -(* License along with this program; if not, write to the Free Software *) -(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA *) -(* 02111-1307 USA *) -(* *) -(* Contact: Maxence.Guesdon@inria.fr *) -(* *) -(*********************************************************************************) - -(** Key codes - - Ce fichier provient de X11/keysymdef.h - les noms des symboles deviennent : XK_ -> xk_ - - Thanks to Fabrice Le Fessant. -*) - -let xk_VoidSymbol = 0xFFFFFF (** void symbol *) - - -(** TTY Functions, cleverly chosen to map to ascii, for convenience of - programming, but could have been arbitrary (at the cost of lookup - tables in client code. -*) - -let xk_BackSpace = 0xFF08 (** back space, back char *) -let xk_Tab = 0xFF09 -let xk_Linefeed = 0xFF0A (** Linefeed, LF *) -let xk_Clear = 0xFF0B -let xk_Return = 0xFF0D (** Return, enter *) -let xk_Pause = 0xFF13 (** Pause, hold *) -let xk_Scroll_Lock = 0xFF14 -let xk_Sys_Req = 0xFF15 -let xk_Escape = 0xFF1B -let xk_Delete = 0xFFFF (** Delete, rubout *) - - - -(** International & multi-key character composition *) - -let xk_Multi_key = 0xFF20 (** Multi-key character compose *) - -(** Japanese keyboard support *) - -let xk_Kanji = 0xFF21 (** Kanji, Kanji convert *) -let xk_Muhenkan = 0xFF22 (** Cancel Conversion *) -let xk_Henkan_Mode = 0xFF23 (** Start/Stop Conversion *) -let xk_Henkan = 0xFF23 (** Alias for Henkan_Mode *) -let xk_Romaji = 0xFF24 (** to Romaji *) -let xk_Hiragana = 0xFF25 (** to Hiragana *) -let xk_Katakana = 0xFF26 (** to Katakana *) -let xk_Hiragana_Katakana = 0xFF27 (** Hiragana/Katakana toggle *) -let xk_Zenkaku = 0xFF28 (** to Zenkaku *) -let xk_Hankaku = 0xFF29 (** to Hankaku *) -let xk_Zenkaku_Hankaku = 0xFF2A (** Zenkaku/Hankaku toggle *) -let xk_Touroku = 0xFF2B (** Add to Dictionary *) -let xk_Massyo = 0xFF2C (** Delete from Dictionary *) -let xk_Kana_Lock = 0xFF2D (** Kana Lock *) -let xk_Kana_Shift = 0xFF2E (** Kana Shift *) -let xk_Eisu_Shift = 0xFF2F (** Alphanumeric Shift *) -let xk_Eisu_toggle = 0xFF30 (** Alphanumeric toggle *) - -(** = 0xFF31 thru = 0xFF3F are under xk_KOREAN *) - -(** Cursor control & motion *) - -let xk_Home = 0xFF50 -let xk_Left = 0xFF51 (** Move left, left arrow *) -let xk_Up = 0xFF52 (** Move up, up arrow *) -let xk_Right = 0xFF53 (** Move right, right arrow *) -let xk_Down = 0xFF54 (** Move down, down arrow *) -let xk_Prior = 0xFF55 (** Prior, previous *) -let xk_Page_Up = 0xFF55 -let xk_Next = 0xFF56 (** Next *) -let xk_Page_Down = 0xFF56 -let xk_End = 0xFF57 (** EOL *) -let xk_Begin = 0xFF58 (** BOL *) - - -(** Misc Functions *) - -let xk_Select = 0xFF60 (** Select, mark *) -let xk_Print = 0xFF61 -let xk_Execute = 0xFF62 (** Execute, run, do *) -let xk_Insert = 0xFF63 (** Insert, insert here *) -let xk_Undo = 0xFF65 (** Undo, oops *) -let xk_Redo = 0xFF66 (** redo, again *) -let xk_Menu = 0xFF67 -let xk_Find = 0xFF68 (** Find, search *) -let xk_Cancel = 0xFF69 (** Cancel, stop, abort, exit *) -let xk_Help = 0xFF6A (** Help *) -let xk_Break = 0xFF6B -let xk_Mode_switch = 0xFF7E (** Character set switch *) -let xk_script_switch = 0xFF7E (** Alias for mode_switch *) -let xk_Num_Lock = 0xFF7F - -(** Keypad Functions, keypad numbers cleverly chosen to map to ascii *) - -let xk_KP_Space = 0xFF80 (** space *) -let xk_KP_Tab = 0xFF89 -let xk_KP_Enter = 0xFF8D (** enter *) -let xk_KP_F1 = 0xFF91 (** PF1, KP_A, ... *) -let xk_KP_F2 = 0xFF92 -let xk_KP_F3 = 0xFF93 -let xk_KP_F4 = 0xFF94 -let xk_KP_Home = 0xFF95 -let xk_KP_Left = 0xFF96 -let xk_KP_Up = 0xFF97 -let xk_KP_Right = 0xFF98 -let xk_KP_Down = 0xFF99 -let xk_KP_Prior = 0xFF9A -let xk_KP_Page_Up = 0xFF9A -let xk_KP_Next = 0xFF9B -let xk_KP_Page_Down = 0xFF9B -let xk_KP_End = 0xFF9C -let xk_KP_Begin = 0xFF9D -let xk_KP_Insert = 0xFF9E -let xk_KP_Delete = 0xFF9F -let xk_KP_Equal = 0xFFBD (** equals *) -let xk_KP_Multiply = 0xFFAA -let xk_KP_Add = 0xFFAB -let xk_KP_Separator = 0xFFAC (** separator, often comma *) -let xk_KP_Subtract = 0xFFAD -let xk_KP_Decimal = 0xFFAE -let xk_KP_Divide = 0xFFAF - -let xk_KP_0 = 0xFFB0 -let xk_KP_1 = 0xFFB1 -let xk_KP_2 = 0xFFB2 -let xk_KP_3 = 0xFFB3 -let xk_KP_4 = 0xFFB4 -let xk_KP_5 = 0xFFB5 -let xk_KP_6 = 0xFFB6 -let xk_KP_7 = 0xFFB7 -let xk_KP_8 = 0xFFB8 -let xk_KP_9 = 0xFFB9 - - - -(* - * Auxilliary Functions; note the duplicate definitions for left and right - * function keys; Sun keyboards and a few other manufactures have such - * function key groups on the left and/or right sides of the keyboard. - * We've not found a keyboard with more than 35 function keys total. - *) - -let xk_F1 = 0xFFBE -let xk_F2 = 0xFFBF -let xk_F3 = 0xFFC0 -let xk_F4 = 0xFFC1 -let xk_F5 = 0xFFC2 -let xk_F6 = 0xFFC3 -let xk_F7 = 0xFFC4 -let xk_F8 = 0xFFC5 -let xk_F9 = 0xFFC6 -let xk_F10 = 0xFFC7 -let xk_F11 = 0xFFC8 -let xk_L1 = 0xFFC8 -let xk_F12 = 0xFFC9 -let xk_L2 = 0xFFC9 -let xk_F13 = 0xFFCA -let xk_L3 = 0xFFCA -let xk_F14 = 0xFFCB -let xk_L4 = 0xFFCB -let xk_F15 = 0xFFCC -let xk_L5 = 0xFFCC -let xk_F16 = 0xFFCD -let xk_L6 = 0xFFCD -let xk_F17 = 0xFFCE -let xk_L7 = 0xFFCE -let xk_F18 = 0xFFCF -let xk_L8 = 0xFFCF -let xk_F19 = 0xFFD0 -let xk_L9 = 0xFFD0 -let xk_F20 = 0xFFD1 -let xk_L10 = 0xFFD1 -let xk_F21 = 0xFFD2 -let xk_R1 = 0xFFD2 -let xk_F22 = 0xFFD3 -let xk_R2 = 0xFFD3 -let xk_F23 = 0xFFD4 -let xk_R3 = 0xFFD4 -let xk_F24 = 0xFFD5 -let xk_R4 = 0xFFD5 -let xk_F25 = 0xFFD6 -let xk_R5 = 0xFFD6 -let xk_F26 = 0xFFD7 -let xk_R6 = 0xFFD7 -let xk_F27 = 0xFFD8 -let xk_R7 = 0xFFD8 -let xk_F28 = 0xFFD9 -let xk_R8 = 0xFFD9 -let xk_F29 = 0xFFDA -let xk_R9 = 0xFFDA -let xk_F30 = 0xFFDB -let xk_R10 = 0xFFDB -let xk_F31 = 0xFFDC -let xk_R11 = 0xFFDC -let xk_F32 = 0xFFDD -let xk_R12 = 0xFFDD -let xk_F33 = 0xFFDE -let xk_R13 = 0xFFDE -let xk_F34 = 0xFFDF -let xk_R14 = 0xFFDF -let xk_F35 = 0xFFE0 -let xk_R15 = 0xFFE0 - -(** Modifiers *) - -let xk_Shift_L = 0xFFE1 (** Left shift *) -let xk_Shift_R = 0xFFE2 (** Right shift *) -let xk_Control_L = 0xFFE3 (** Left control *) -let xk_Control_R = 0xFFE4 (** Right control *) -let xk_Caps_Lock = 0xFFE5 (** Caps lock *) -let xk_Shift_Lock = 0xFFE6 (** Shift lock *) - -let xk_Meta_L = 0xFFE7 (** Left meta *) -let xk_Meta_R = 0xFFE8 (** Right meta *) -let xk_Alt_L = 0xFFE9 (** Left alt *) -let xk_Alt_R = 0xFFEA (** Right alt *) -let xk_Super_L = 0xFFEB (** Left super *) -let xk_Super_R = 0xFFEC (** Right super *) -let xk_Hyper_L = 0xFFED (** Left hyper *) -let xk_Hyper_R = 0xFFEE (** Right hyper *) - - -(* - * ISO 9995 Function and Modifier Keys - * Byte 3 = = 0xFE - *) - - -let xk_ISO_Lock = 0xFE01 -let xk_ISO_Level2_Latch = 0xFE02 -let xk_ISO_Level3_Shift = 0xFE03 -let xk_ISO_Level3_Latch = 0xFE04 -let xk_ISO_Level3_Lock = 0xFE05 -let xk_ISO_Group_Shift = 0xFF7E (** Alias for mode_switch *) -let xk_ISO_Group_Latch = 0xFE06 -let xk_ISO_Group_Lock = 0xFE07 -let xk_ISO_Next_Group = 0xFE08 -let xk_ISO_Next_Group_Lock = 0xFE09 -let xk_ISO_Prev_Group = 0xFE0A -let xk_ISO_Prev_Group_Lock = 0xFE0B -let xk_ISO_First_Group = 0xFE0C -let xk_ISO_First_Group_Lock = 0xFE0D -let xk_ISO_Last_Group = 0xFE0E -let xk_ISO_Last_Group_Lock = 0xFE0F - -let xk_ISO_Left_Tab = 0xFE20 -let xk_ISO_Move_Line_Up = 0xFE21 -let xk_ISO_Move_Line_Down = 0xFE22 -let xk_ISO_Partial_Line_Up = 0xFE23 -let xk_ISO_Partial_Line_Down = 0xFE24 -let xk_ISO_Partial_Space_Left = 0xFE25 -let xk_ISO_Partial_Space_Right = 0xFE26 -let xk_ISO_Set_Margin_Left = 0xFE27 -let xk_ISO_Set_Margin_Right = 0xFE28 -let xk_ISO_Release_Margin_Left = 0xFE29 -let xk_ISO_Release_Margin_Right = 0xFE2A -let xk_ISO_Release_Both_Margins = 0xFE2B -let xk_ISO_Fast_Cursor_Left = 0xFE2C -let xk_ISO_Fast_Cursor_Right = 0xFE2D -let xk_ISO_Fast_Cursor_Up = 0xFE2E -let xk_ISO_Fast_Cursor_Down = 0xFE2F -let xk_ISO_Continuous_Underline = 0xFE30 -let xk_ISO_Discontinuous_Underline = 0xFE31 -let xk_ISO_Emphasize = 0xFE32 -let xk_ISO_Center_Object = 0xFE33 -let xk_ISO_Enter = 0xFE34 - -let xk_dead_grave = 0xFE50 -let xk_dead_acute = 0xFE51 -let xk_dead_circumflex = 0xFE52 -let xk_dead_tilde = 0xFE53 -let xk_dead_macron = 0xFE54 -let xk_dead_breve = 0xFE55 -let xk_dead_abovedot = 0xFE56 -let xk_dead_diaeresis = 0xFE57 -let xk_dead_abovering = 0xFE58 -let xk_dead_doubleacute = 0xFE59 -let xk_dead_caron = 0xFE5A -let xk_dead_cedilla = 0xFE5B -let xk_dead_ogonek = 0xFE5C -let xk_dead_iota = 0xFE5D -let xk_dead_voiced_sound = 0xFE5E -let xk_dead_semivoiced_sound = 0xFE5F -let xk_dead_belowdot = 0xFE60 - -let xk_First_Virtual_Screen = 0xFED0 -let xk_Prev_Virtual_Screen = 0xFED1 -let xk_Next_Virtual_Screen = 0xFED2 -let xk_Last_Virtual_Screen = 0xFED4 -let xk_Terminate_Server = 0xFED5 - -let xk_AccessX_Enable = 0xFE70 -let xk_AccessX_Feedback_Enable = 0xFE71 -let xk_RepeatKeys_Enable = 0xFE72 -let xk_SlowKeys_Enable = 0xFE73 -let xk_BounceKeys_Enable = 0xFE74 -let xk_StickyKeys_Enable = 0xFE75 -let xk_MouseKeys_Enable = 0xFE76 -let xk_MouseKeys_Accel_Enable = 0xFE77 -let xk_Overlay1_Enable = 0xFE78 -let xk_Overlay2_Enable = 0xFE79 -let xk_AudibleBell_Enable = 0xFE7A - -let xk_Pointer_Left = 0xFEE0 -let xk_Pointer_Right = 0xFEE1 -let xk_Pointer_Up = 0xFEE2 -let xk_Pointer_Down = 0xFEE3 -let xk_Pointer_UpLeft = 0xFEE4 -let xk_Pointer_UpRight = 0xFEE5 -let xk_Pointer_DownLeft = 0xFEE6 -let xk_Pointer_DownRight = 0xFEE7 -let xk_Pointer_Button_Dflt = 0xFEE8 -let xk_Pointer_Button1 = 0xFEE9 -let xk_Pointer_Button2 = 0xFEEA -let xk_Pointer_Button3 = 0xFEEB -let xk_Pointer_Button4 = 0xFEEC -let xk_Pointer_Button5 = 0xFEED -let xk_Pointer_DblClick_Dflt = 0xFEEE -let xk_Pointer_DblClick1 = 0xFEEF -let xk_Pointer_DblClick2 = 0xFEF0 -let xk_Pointer_DblClick3 = 0xFEF1 -let xk_Pointer_DblClick4 = 0xFEF2 -let xk_Pointer_DblClick5 = 0xFEF3 -let xk_Pointer_Drag_Dflt = 0xFEF4 -let xk_Pointer_Drag1 = 0xFEF5 -let xk_Pointer_Drag2 = 0xFEF6 -let xk_Pointer_Drag3 = 0xFEF7 -let xk_Pointer_Drag4 = 0xFEF8 -let xk_Pointer_Drag5 = 0xFEFD - -let xk_Pointer_EnableKeys = 0xFEF9 -let xk_Pointer_Accelerate = 0xFEFA -let xk_Pointer_DfltBtnNext = 0xFEFB -let xk_Pointer_DfltBtnPrev = 0xFEFC - - - -(* - * 3270 Terminal Keys - * Byte 3 = = 0xFD - *) - - -let xk_3270_Duplicate = 0xFD01 -let xk_3270_FieldMark = 0xFD02 -let xk_3270_Right2 = 0xFD03 -let xk_3270_Left2 = 0xFD04 -let xk_3270_BackTab = 0xFD05 -let xk_3270_EraseEOF = 0xFD06 -let xk_3270_EraseInput = 0xFD07 -let xk_3270_Reset = 0xFD08 -let xk_3270_Quit = 0xFD09 -let xk_3270_PA1 = 0xFD0A -let xk_3270_PA2 = 0xFD0B -let xk_3270_PA3 = 0xFD0C -let xk_3270_Test = 0xFD0D -let xk_3270_Attn = 0xFD0E -let xk_3270_CursorBlink = 0xFD0F -let xk_3270_AltCursor = 0xFD10 -let xk_3270_KeyClick = 0xFD11 -let xk_3270_Jump = 0xFD12 -let xk_3270_Ident = 0xFD13 -let xk_3270_Rule = 0xFD14 -let xk_3270_Copy = 0xFD15 -let xk_3270_Play = 0xFD16 -let xk_3270_Setup = 0xFD17 -let xk_3270_Record = 0xFD18 -let xk_3270_ChangeScreen = 0xFD19 -let xk_3270_DeleteWord = 0xFD1A -let xk_3270_ExSelect = 0xFD1B -let xk_3270_CursorSelect = 0xFD1C -let xk_3270_PrintScreen = 0xFD1D -let xk_3270_Enter = 0xFD1E - - -(* - * Latin 1 - * Byte 3 = 0 - *) - -let xk_space = 0x020 -let xk_exclam = 0x021 -let xk_quotedbl = 0x022 -let xk_numbersign = 0x023 -let xk_dollar = 0x024 -let xk_percent = 0x025 -let xk_ampersand = 0x026 -let xk_apostrophe = 0x027 -let xk_quoteright = 0x027 (** deprecated *) -let xk_parenleft = 0x028 -let xk_parenright = 0x029 -let xk_asterisk = 0x02a -let xk_plus = 0x02b -let xk_comma = 0x02c -let xk_minus = 0x02d -let xk_period = 0x02e -let xk_slash = 0x02f -let xk_0 = 0x030 -let xk_1 = 0x031 -let xk_2 = 0x032 -let xk_3 = 0x033 -let xk_4 = 0x034 -let xk_5 = 0x035 -let xk_6 = 0x036 -let xk_7 = 0x037 -let xk_8 = 0x038 -let xk_9 = 0x039 -let xk_colon = 0x03a -let xk_semicolon = 0x03b -let xk_less = 0x03c -let xk_equal = 0x03d -let xk_greater = 0x03e -let xk_question = 0x03f -let xk_at = 0x040 -let xk_A = 0x041 -let xk_B = 0x042 -let xk_C = 0x043 -let xk_D = 0x044 -let xk_E = 0x045 -let xk_F = 0x046 -let xk_G = 0x047 -let xk_H = 0x048 -let xk_I = 0x049 -let xk_J = 0x04a -let xk_K = 0x04b -let xk_L = 0x04c -let xk_M = 0x04d -let xk_N = 0x04e -let xk_O = 0x04f -let xk_P = 0x050 -let xk_Q = 0x051 -let xk_R = 0x052 -let xk_S = 0x053 -let xk_T = 0x054 -let xk_U = 0x055 -let xk_V = 0x056 -let xk_W = 0x057 -let xk_X = 0x058 -let xk_Y = 0x059 -let xk_Z = 0x05a -let xk_bracketleft = 0x05b -let xk_backslash = 0x05c -let xk_bracketright = 0x05d -let xk_asciicircum = 0x05e -let xk_underscore = 0x05f -let xk_grave = 0x060 -let xk_quoteleft = 0x060 (** deprecated *) -let xk_a = 0x061 -let xk_b = 0x062 -let xk_c = 0x063 -let xk_d = 0x064 -let xk_e = 0x065 -let xk_f = 0x066 -let xk_g = 0x067 -let xk_h = 0x068 -let xk_i = 0x069 -let xk_j = 0x06a -let xk_k = 0x06b -let xk_l = 0x06c -let xk_m = 0x06d -let xk_n = 0x06e -let xk_o = 0x06f -let xk_p = 0x070 -let xk_q = 0x071 -let xk_r = 0x072 -let xk_s = 0x073 -let xk_t = 0x074 -let xk_u = 0x075 -let xk_v = 0x076 -let xk_w = 0x077 -let xk_x = 0x078 -let xk_y = 0x079 -let xk_z = 0x07a -let xk_braceleft = 0x07b -let xk_bar = 0x07c -let xk_braceright = 0x07d -let xk_asciitilde = 0x07e - -let xk_nobreakspace = 0x0a0 -let xk_exclamdown = 0x0a1 -let xk_cent = 0x0a2 -let xk_sterling = 0x0a3 -let xk_currency = 0x0a4 -let xk_yen = 0x0a5 -let xk_brokenbar = 0x0a6 -let xk_section = 0x0a7 -let xk_diaeresis = 0x0a8 -let xk_copyright = 0x0a9 -let xk_ordfeminine = 0x0aa -let xk_guillemotleft = 0x0ab (** left angle quotation mark *) -let xk_notsign = 0x0ac -let xk_hyphen = 0x0ad -let xk_registered = 0x0ae -let xk_macron = 0x0af -let xk_degree = 0x0b0 -let xk_plusminus = 0x0b1 -let xk_twosuperior = 0x0b2 -let xk_threesuperior = 0x0b3 -let xk_acute = 0x0b4 -let xk_mu = 0x0b5 -let xk_paragraph = 0x0b6 -let xk_periodcentered = 0x0b7 -let xk_cedilla = 0x0b8 -let xk_onesuperior = 0x0b9 -let xk_masculine = 0x0ba -let xk_guillemotright = 0x0bb (** right angle quotation mark *) -let xk_onequarter = 0x0bc -let xk_onehalf = 0x0bd -let xk_threequarters = 0x0be -let xk_questiondown = 0x0bf -let xk_Agrave = 0x0c0 -let xk_Aacute = 0x0c1 -let xk_Acircumflex = 0x0c2 -let xk_Atilde = 0x0c3 -let xk_Adiaeresis = 0x0c4 -let xk_Aring = 0x0c5 -let xk_AE = 0x0c6 -let xk_Ccedilla = 0x0c7 -let xk_Egrave = 0x0c8 -let xk_Eacute = 0x0c9 -let xk_Ecircumflex = 0x0ca -let xk_Ediaeresis = 0x0cb -let xk_Igrave = 0x0cc -let xk_Iacute = 0x0cd -let xk_Icircumflex = 0x0ce -let xk_Idiaeresis = 0x0cf -let xk_ETH = 0x0d0 -let xk_Eth = 0x0d0 (** deprecated *) -let xk_Ntilde = 0x0d1 -let xk_Ograve = 0x0d2 -let xk_Oacute = 0x0d3 -let xk_Ocircumflex = 0x0d4 -let xk_Otilde = 0x0d5 -let xk_Odiaeresis = 0x0d6 -let xk_multiply = 0x0d7 -let xk_Ooblique = 0x0d8 -let xk_Ugrave = 0x0d9 -let xk_Uacute = 0x0da -let xk_Ucircumflex = 0x0db -let xk_Udiaeresis = 0x0dc -let xk_Yacute = 0x0dd -let xk_THORN = 0x0de -let xk_Thorn = 0x0de (** deprecated *) -let xk_ssharp = 0x0df -let xk_agrave = 0x0e0 -let xk_aacute = 0x0e1 -let xk_acircumflex = 0x0e2 -let xk_atilde = 0x0e3 -let xk_adiaeresis = 0x0e4 -let xk_aring = 0x0e5 -let xk_ae = 0x0e6 -let xk_ccedilla = 0x0e7 -let xk_egrave = 0x0e8 -let xk_eacute = 0x0e9 -let xk_ecircumflex = 0x0ea -let xk_ediaeresis = 0x0eb -let xk_igrave = 0x0ec -let xk_iacute = 0x0ed -let xk_icircumflex = 0x0ee -let xk_idiaeresis = 0x0ef -let xk_eth = 0x0f0 -let xk_ntilde = 0x0f1 -let xk_ograve = 0x0f2 -let xk_oacute = 0x0f3 -let xk_ocircumflex = 0x0f4 -let xk_otilde = 0x0f5 -let xk_odiaeresis = 0x0f6 -let xk_division = 0x0f7 -let xk_oslash = 0x0f8 -let xk_ugrave = 0x0f9 -let xk_uacute = 0x0fa -let xk_ucircumflex = 0x0fb -let xk_udiaeresis = 0x0fc -let xk_yacute = 0x0fd -let xk_thorn = 0x0fe -let xk_ydiaeresis = 0x0ff - - -(* - * Latin 2 - * Byte 3 = 1 - *) - - -let xk_Aogonek = 0x1a1 -let xk_breve = 0x1a2 -let xk_Lstroke = 0x1a3 -let xk_Lcaron = 0x1a5 -let xk_Sacute = 0x1a6 -let xk_Scaron = 0x1a9 -let xk_Scedilla = 0x1aa -let xk_Tcaron = 0x1ab -let xk_Zacute = 0x1ac -let xk_Zcaron = 0x1ae -let xk_Zabovedot = 0x1af -let xk_aogonek = 0x1b1 -let xk_ogonek = 0x1b2 -let xk_lstroke = 0x1b3 -let xk_lcaron = 0x1b5 -let xk_sacute = 0x1b6 -let xk_caron = 0x1b7 -let xk_scaron = 0x1b9 -let xk_scedilla = 0x1ba -let xk_tcaron = 0x1bb -let xk_zacute = 0x1bc -let xk_doubleacute = 0x1bd -let xk_zcaron = 0x1be -let xk_zabovedot = 0x1bf -let xk_Racute = 0x1c0 -let xk_Abreve = 0x1c3 -let xk_Lacute = 0x1c5 -let xk_Cacute = 0x1c6 -let xk_Ccaron = 0x1c8 -let xk_Eogonek = 0x1ca -let xk_Ecaron = 0x1cc -let xk_Dcaron = 0x1cf -let xk_Dstroke = 0x1d0 -let xk_Nacute = 0x1d1 -let xk_Ncaron = 0x1d2 -let xk_Odoubleacute = 0x1d5 -let xk_Rcaron = 0x1d8 -let xk_Uring = 0x1d9 -let xk_Udoubleacute = 0x1db -let xk_Tcedilla = 0x1de -let xk_racute = 0x1e0 -let xk_abreve = 0x1e3 -let xk_lacute = 0x1e5 -let xk_cacute = 0x1e6 -let xk_ccaron = 0x1e8 -let xk_eogonek = 0x1ea -let xk_ecaron = 0x1ec -let xk_dcaron = 0x1ef -let xk_dstroke = 0x1f0 -let xk_nacute = 0x1f1 -let xk_ncaron = 0x1f2 -let xk_odoubleacute = 0x1f5 -let xk_udoubleacute = 0x1fb -let xk_rcaron = 0x1f8 -let xk_uring = 0x1f9 -let xk_tcedilla = 0x1fe -let xk_abovedot = 0x1ff - - -(* - * Latin 3 - * Byte 3 = 2 - *) - - -let xk_Hstroke = 0x2a1 -let xk_Hcircumflex = 0x2a6 -let xk_Iabovedot = 0x2a9 -let xk_Gbreve = 0x2ab -let xk_Jcircumflex = 0x2ac -let xk_hstroke = 0x2b1 -let xk_hcircumflex = 0x2b6 -let xk_idotless = 0x2b9 -let xk_gbreve = 0x2bb -let xk_jcircumflex = 0x2bc -let xk_Cabovedot = 0x2c5 -let xk_Ccircumflex = 0x2c6 -let xk_Gabovedot = 0x2d5 -let xk_Gcircumflex = 0x2d8 -let xk_Ubreve = 0x2dd -let xk_Scircumflex = 0x2de -let xk_cabovedot = 0x2e5 -let xk_ccircumflex = 0x2e6 -let xk_gabovedot = 0x2f5 -let xk_gcircumflex = 0x2f8 -let xk_ubreve = 0x2fd -let xk_scircumflex = 0x2fe - - - -(* - * Latin 4 - * Byte 3 = 3 - *) - - -let xk_kra = 0x3a2 -let xk_kappa = 0x3a2 (** deprecated *) -let xk_Rcedilla = 0x3a3 -let xk_Itilde = 0x3a5 -let xk_Lcedilla = 0x3a6 -let xk_Emacron = 0x3aa -let xk_Gcedilla = 0x3ab -let xk_Tslash = 0x3ac -let xk_rcedilla = 0x3b3 -let xk_itilde = 0x3b5 -let xk_lcedilla = 0x3b6 -let xk_emacron = 0x3ba -let xk_gcedilla = 0x3bb -let xk_tslash = 0x3bc -let xk_ENG = 0x3bd -let xk_eng = 0x3bf -let xk_Amacron = 0x3c0 -let xk_Iogonek = 0x3c7 -let xk_Eabovedot = 0x3cc -let xk_Imacron = 0x3cf -let xk_Ncedilla = 0x3d1 -let xk_Omacron = 0x3d2 -let xk_Kcedilla = 0x3d3 -let xk_Uogonek = 0x3d9 -let xk_Utilde = 0x3dd -let xk_Umacron = 0x3de -let xk_amacron = 0x3e0 -let xk_iogonek = 0x3e7 -let xk_eabovedot = 0x3ec -let xk_imacron = 0x3ef -let xk_ncedilla = 0x3f1 -let xk_omacron = 0x3f2 -let xk_kcedilla = 0x3f3 -let xk_uogonek = 0x3f9 -let xk_utilde = 0x3fd -let xk_umacron = 0x3fe - - -(* - * Katakana - * Byte 3 = 4 - *) - - -let xk_overline = 0x47e -let xk_kana_fullstop = 0x4a1 -let xk_kana_openingbracket = 0x4a2 -let xk_kana_closingbracket = 0x4a3 -let xk_kana_comma = 0x4a4 -let xk_kana_conjunctive = 0x4a5 -let xk_kana_middledot = 0x4a5 (** deprecated *) -let xk_kana_WO = 0x4a6 -let xk_kana_a = 0x4a7 -let xk_kana_i = 0x4a8 -let xk_kana_u = 0x4a9 -let xk_kana_e = 0x4aa -let xk_kana_o = 0x4ab -let xk_kana_ya = 0x4ac -let xk_kana_yu = 0x4ad -let xk_kana_yo = 0x4ae -let xk_kana_tsu = 0x4af -let xk_kana_tu = 0x4af (** deprecated *) -let xk_prolongedsound = 0x4b0 -let xk_kana_A = 0x4b1 -let xk_kana_I = 0x4b2 -let xk_kana_U = 0x4b3 -let xk_kana_E = 0x4b4 -let xk_kana_O = 0x4b5 -let xk_kana_KA = 0x4b6 -let xk_kana_KI = 0x4b7 -let xk_kana_KU = 0x4b8 -let xk_kana_KE = 0x4b9 -let xk_kana_KO = 0x4ba -let xk_kana_SA = 0x4bb -let xk_kana_SHI = 0x4bc -let xk_kana_SU = 0x4bd -let xk_kana_SE = 0x4be -let xk_kana_SO = 0x4bf -let xk_kana_TA = 0x4c0 -let xk_kana_CHI = 0x4c1 -let xk_kana_TI = 0x4c1 (** deprecated *) -let xk_kana_TSU = 0x4c2 -let xk_kana_TU = 0x4c2 (** deprecated *) -let xk_kana_TE = 0x4c3 -let xk_kana_TO = 0x4c4 -let xk_kana_NA = 0x4c5 -let xk_kana_NI = 0x4c6 -let xk_kana_NU = 0x4c7 -let xk_kana_NE = 0x4c8 -let xk_kana_NO = 0x4c9 -let xk_kana_HA = 0x4ca -let xk_kana_HI = 0x4cb -let xk_kana_FU = 0x4cc -let xk_kana_HU = 0x4cc (** deprecated *) -let xk_kana_HE = 0x4cd -let xk_kana_HO = 0x4ce -let xk_kana_MA = 0x4cf -let xk_kana_MI = 0x4d0 -let xk_kana_MU = 0x4d1 -let xk_kana_ME = 0x4d2 -let xk_kana_MO = 0x4d3 -let xk_kana_YA = 0x4d4 -let xk_kana_YU = 0x4d5 -let xk_kana_YO = 0x4d6 -let xk_kana_RA = 0x4d7 -let xk_kana_RI = 0x4d8 -let xk_kana_RU = 0x4d9 -let xk_kana_RE = 0x4da -let xk_kana_RO = 0x4db -let xk_kana_WA = 0x4dc -let xk_kana_N = 0x4dd -let xk_voicedsound = 0x4de -let xk_semivoicedsound = 0x4df -let xk_kana_switch = 0xFF7E (** Alias for mode_switch *) - - -(* - * Arabic - * Byte 3 = 5 - *) - - -let xk_Arabic_comma = 0x5ac -let xk_Arabic_semicolon = 0x5bb -let xk_Arabic_question_mark = 0x5bf -let xk_Arabic_hamza = 0x5c1 -let xk_Arabic_maddaonalef = 0x5c2 -let xk_Arabic_hamzaonalef = 0x5c3 -let xk_Arabic_hamzaonwaw = 0x5c4 -let xk_Arabic_hamzaunderalef = 0x5c5 -let xk_Arabic_hamzaonyeh = 0x5c6 -let xk_Arabic_alef = 0x5c7 -let xk_Arabic_beh = 0x5c8 -let xk_Arabic_tehmarbuta = 0x5c9 -let xk_Arabic_teh = 0x5ca -let xk_Arabic_theh = 0x5cb -let xk_Arabic_jeem = 0x5cc -let xk_Arabic_hah = 0x5cd -let xk_Arabic_khah = 0x5ce -let xk_Arabic_dal = 0x5cf -let xk_Arabic_thal = 0x5d0 -let xk_Arabic_ra = 0x5d1 -let xk_Arabic_zain = 0x5d2 -let xk_Arabic_seen = 0x5d3 -let xk_Arabic_sheen = 0x5d4 -let xk_Arabic_sad = 0x5d5 -let xk_Arabic_dad = 0x5d6 -let xk_Arabic_tah = 0x5d7 -let xk_Arabic_zah = 0x5d8 -let xk_Arabic_ain = 0x5d9 -let xk_Arabic_ghain = 0x5da -let xk_Arabic_tatweel = 0x5e0 -let xk_Arabic_feh = 0x5e1 -let xk_Arabic_qaf = 0x5e2 -let xk_Arabic_kaf = 0x5e3 -let xk_Arabic_lam = 0x5e4 -let xk_Arabic_meem = 0x5e5 -let xk_Arabic_noon = 0x5e6 -let xk_Arabic_ha = 0x5e7 -let xk_Arabic_heh = 0x5e7 (** deprecated *) -let xk_Arabic_waw = 0x5e8 -let xk_Arabic_alefmaksura = 0x5e9 -let xk_Arabic_yeh = 0x5ea -let xk_Arabic_fathatan = 0x5eb -let xk_Arabic_dammatan = 0x5ec -let xk_Arabic_kasratan = 0x5ed -let xk_Arabic_fatha = 0x5ee -let xk_Arabic_damma = 0x5ef -let xk_Arabic_kasra = 0x5f0 -let xk_Arabic_shadda = 0x5f1 -let xk_Arabic_sukun = 0x5f2 -let xk_Arabic_switch = 0xFF7E (** Alias for mode_switch *) - - -(* - * Cyrillic - * Byte 3 = 6 - *) - -let xk_Serbian_dje = 0x6a1 -let xk_Macedonia_gje = 0x6a2 -let xk_Cyrillic_io = 0x6a3 -let xk_Ukrainian_ie = 0x6a4 -let xk_Ukranian_je = 0x6a4 (** deprecated *) -let xk_Macedonia_dse = 0x6a5 -let xk_Ukrainian_i = 0x6a6 -let xk_Ukranian_i = 0x6a6 (** deprecated *) -let xk_Ukrainian_yi = 0x6a7 -let xk_Ukranian_yi = 0x6a7 (** deprecated *) -let xk_Cyrillic_je = 0x6a8 -let xk_Serbian_je = 0x6a8 (** deprecated *) -let xk_Cyrillic_lje = 0x6a9 -let xk_Serbian_lje = 0x6a9 (** deprecated *) -let xk_Cyrillic_nje = 0x6aa -let xk_Serbian_nje = 0x6aa (** deprecated *) -let xk_Serbian_tshe = 0x6ab -let xk_Macedonia_kje = 0x6ac -let xk_Byelorussian_shortu = 0x6ae -let xk_Cyrillic_dzhe = 0x6af -let xk_Serbian_dze = 0x6af (** deprecated *) -let xk_numerosign = 0x6b0 -let xk_Serbian_DJE = 0x6b1 -let xk_Macedonia_GJE = 0x6b2 -let xk_Cyrillic_IO = 0x6b3 -let xk_Ukrainian_IE = 0x6b4 -let xk_Ukranian_JE = 0x6b4 (** deprecated *) -let xk_Macedonia_DSE = 0x6b5 -let xk_Ukrainian_I = 0x6b6 -let xk_Ukranian_I = 0x6b6 (** deprecated *) -let xk_Ukrainian_YI = 0x6b7 -let xk_Ukranian_YI = 0x6b7 (** deprecated *) -let xk_Cyrillic_JE = 0x6b8 -let xk_Serbian_JE = 0x6b8 (** deprecated *) -let xk_Cyrillic_LJE = 0x6b9 -let xk_Serbian_LJE = 0x6b9 (** deprecated *) -let xk_Cyrillic_NJE = 0x6ba -let xk_Serbian_NJE = 0x6ba (** deprecated *) -let xk_Serbian_TSHE = 0x6bb -let xk_Macedonia_KJE = 0x6bc -let xk_Byelorussian_SHORTU = 0x6be -let xk_Cyrillic_DZHE = 0x6bf -let xk_Serbian_DZE = 0x6bf (** deprecated *) -let xk_Cyrillic_yu = 0x6c0 -let xk_Cyrillic_a = 0x6c1 -let xk_Cyrillic_be = 0x6c2 -let xk_Cyrillic_tse = 0x6c3 -let xk_Cyrillic_de = 0x6c4 -let xk_Cyrillic_ie = 0x6c5 -let xk_Cyrillic_ef = 0x6c6 -let xk_Cyrillic_ghe = 0x6c7 -let xk_Cyrillic_ha = 0x6c8 -let xk_Cyrillic_i = 0x6c9 -let xk_Cyrillic_shorti = 0x6ca -let xk_Cyrillic_ka = 0x6cb -let xk_Cyrillic_el = 0x6cc -let xk_Cyrillic_em = 0x6cd -let xk_Cyrillic_en = 0x6ce -let xk_Cyrillic_o = 0x6cf -let xk_Cyrillic_pe = 0x6d0 -let xk_Cyrillic_ya = 0x6d1 -let xk_Cyrillic_er = 0x6d2 -let xk_Cyrillic_es = 0x6d3 -let xk_Cyrillic_te = 0x6d4 -let xk_Cyrillic_u = 0x6d5 -let xk_Cyrillic_zhe = 0x6d6 -let xk_Cyrillic_ve = 0x6d7 -let xk_Cyrillic_softsign = 0x6d8 -let xk_Cyrillic_yeru = 0x6d9 -let xk_Cyrillic_ze = 0x6da -let xk_Cyrillic_sha = 0x6db -let xk_Cyrillic_e = 0x6dc -let xk_Cyrillic_shcha = 0x6dd -let xk_Cyrillic_che = 0x6de -let xk_Cyrillic_hardsign = 0x6df -let xk_Cyrillic_YU = 0x6e0 -let xk_Cyrillic_A = 0x6e1 -let xk_Cyrillic_BE = 0x6e2 -let xk_Cyrillic_TSE = 0x6e3 -let xk_Cyrillic_DE = 0x6e4 -let xk_Cyrillic_IE = 0x6e5 -let xk_Cyrillic_EF = 0x6e6 -let xk_Cyrillic_GHE = 0x6e7 -let xk_Cyrillic_HA = 0x6e8 -let xk_Cyrillic_I = 0x6e9 -let xk_Cyrillic_SHORTI = 0x6ea -let xk_Cyrillic_KA = 0x6eb -let xk_Cyrillic_EL = 0x6ec -let xk_Cyrillic_EM = 0x6ed -let xk_Cyrillic_EN = 0x6ee -let xk_Cyrillic_O = 0x6ef -let xk_Cyrillic_PE = 0x6f0 -let xk_Cyrillic_YA = 0x6f1 -let xk_Cyrillic_ER = 0x6f2 -let xk_Cyrillic_ES = 0x6f3 -let xk_Cyrillic_TE = 0x6f4 -let xk_Cyrillic_U = 0x6f5 -let xk_Cyrillic_ZHE = 0x6f6 -let xk_Cyrillic_VE = 0x6f7 -let xk_Cyrillic_SOFTSIGN = 0x6f8 -let xk_Cyrillic_YERU = 0x6f9 -let xk_Cyrillic_ZE = 0x6fa -let xk_Cyrillic_SHA = 0x6fb -let xk_Cyrillic_E = 0x6fc -let xk_Cyrillic_SHCHA = 0x6fd -let xk_Cyrillic_CHE = 0x6fe -let xk_Cyrillic_HARDSIGN = 0x6ff - - -(* - * Greek - * Byte 3 = 7 - *) - - -let xk_Greek_ALPHAaccent = 0x7a1 -let xk_Greek_EPSILONaccent = 0x7a2 -let xk_Greek_ETAaccent = 0x7a3 -let xk_Greek_IOTAaccent = 0x7a4 -let xk_Greek_IOTAdiaeresis = 0x7a5 -let xk_Greek_OMICRONaccent = 0x7a7 -let xk_Greek_UPSILONaccent = 0x7a8 -let xk_Greek_UPSILONdieresis = 0x7a9 -let xk_Greek_OMEGAaccent = 0x7ab -let xk_Greek_accentdieresis = 0x7ae -let xk_Greek_horizbar = 0x7af -let xk_Greek_alphaaccent = 0x7b1 -let xk_Greek_epsilonaccent = 0x7b2 -let xk_Greek_etaaccent = 0x7b3 -let xk_Greek_iotaaccent = 0x7b4 -let xk_Greek_iotadieresis = 0x7b5 -let xk_Greek_iotaaccentdieresis = 0x7b6 -let xk_Greek_omicronaccent = 0x7b7 -let xk_Greek_upsilonaccent = 0x7b8 -let xk_Greek_upsilondieresis = 0x7b9 -let xk_Greek_upsilonaccentdieresis = 0x7ba -let xk_Greek_omegaaccent = 0x7bb -let xk_Greek_ALPHA = 0x7c1 -let xk_Greek_BETA = 0x7c2 -let xk_Greek_GAMMA = 0x7c3 -let xk_Greek_DELTA = 0x7c4 -let xk_Greek_EPSILON = 0x7c5 -let xk_Greek_ZETA = 0x7c6 -let xk_Greek_ETA = 0x7c7 -let xk_Greek_THETA = 0x7c8 -let xk_Greek_IOTA = 0x7c9 -let xk_Greek_KAPPA = 0x7ca -let xk_Greek_LAMDA = 0x7cb -let xk_Greek_LAMBDA = 0x7cb -let xk_Greek_MU = 0x7cc -let xk_Greek_NU = 0x7cd -let xk_Greek_XI = 0x7ce -let xk_Greek_OMICRON = 0x7cf -let xk_Greek_PI = 0x7d0 -let xk_Greek_RHO = 0x7d1 -let xk_Greek_SIGMA = 0x7d2 -let xk_Greek_TAU = 0x7d4 -let xk_Greek_UPSILON = 0x7d5 -let xk_Greek_PHI = 0x7d6 -let xk_Greek_CHI = 0x7d7 -let xk_Greek_PSI = 0x7d8 -let xk_Greek_OMEGA = 0x7d9 -let xk_Greek_alpha = 0x7e1 -let xk_Greek_beta = 0x7e2 -let xk_Greek_gamma = 0x7e3 -let xk_Greek_delta = 0x7e4 -let xk_Greek_epsilon = 0x7e5 -let xk_Greek_zeta = 0x7e6 -let xk_Greek_eta = 0x7e7 -let xk_Greek_theta = 0x7e8 -let xk_Greek_iota = 0x7e9 -let xk_Greek_kappa = 0x7ea -let xk_Greek_lamda = 0x7eb -let xk_Greek_lambda = 0x7eb -let xk_Greek_mu = 0x7ec -let xk_Greek_nu = 0x7ed -let xk_Greek_xi = 0x7ee -let xk_Greek_omicron = 0x7ef -let xk_Greek_pi = 0x7f0 -let xk_Greek_rho = 0x7f1 -let xk_Greek_sigma = 0x7f2 -let xk_Greek_finalsmallsigma = 0x7f3 -let xk_Greek_tau = 0x7f4 -let xk_Greek_upsilon = 0x7f5 -let xk_Greek_phi = 0x7f6 -let xk_Greek_chi = 0x7f7 -let xk_Greek_psi = 0x7f8 -let xk_Greek_omega = 0x7f9 -let xk_Greek_switch = 0xFF7E (** Alias for mode_switch *) - - -(* - * Technical - * Byte 3 = 8 - *) - - -let xk_leftradical = 0x8a1 -let xk_topleftradical = 0x8a2 -let xk_horizconnector = 0x8a3 -let xk_topintegral = 0x8a4 -let xk_botintegral = 0x8a5 -let xk_vertconnector = 0x8a6 -let xk_topleftsqbracket = 0x8a7 -let xk_botleftsqbracket = 0x8a8 -let xk_toprightsqbracket = 0x8a9 -let xk_botrightsqbracket = 0x8aa -let xk_topleftparens = 0x8ab -let xk_botleftparens = 0x8ac -let xk_toprightparens = 0x8ad -let xk_botrightparens = 0x8ae -let xk_leftmiddlecurlybrace = 0x8af -let xk_rightmiddlecurlybrace = 0x8b0 -let xk_topleftsummation = 0x8b1 -let xk_botleftsummation = 0x8b2 -let xk_topvertsummationconnector = 0x8b3 -let xk_botvertsummationconnector = 0x8b4 -let xk_toprightsummation = 0x8b5 -let xk_botrightsummation = 0x8b6 -let xk_rightmiddlesummation = 0x8b7 -let xk_lessthanequal = 0x8bc -let xk_notequal = 0x8bd -let xk_greaterthanequal = 0x8be -let xk_integral = 0x8bf -let xk_therefore = 0x8c0 -let xk_variation = 0x8c1 -let xk_infinity = 0x8c2 -let xk_nabla = 0x8c5 -let xk_approximate = 0x8c8 -let xk_similarequal = 0x8c9 -let xk_ifonlyif = 0x8cd -let xk_implies = 0x8ce -let xk_identical = 0x8cf -let xk_radical = 0x8d6 -let xk_includedin = 0x8da -let xk_includes = 0x8db -let xk_intersection = 0x8dc -let xk_union = 0x8dd -let xk_logicaland = 0x8de -let xk_logicalor = 0x8df -let xk_partialderivative = 0x8ef -let xk_function = 0x8f6 -let xk_leftarrow = 0x8fb -let xk_uparrow = 0x8fc -let xk_rightarrow = 0x8fd -let xk_downarrow = 0x8fe - - -(* - * Special - * Byte 3 = 9 - *) - - -let xk_blank = 0x9df -let xk_soliddiamond = 0x9e0 -let xk_checkerboard = 0x9e1 -let xk_ht = 0x9e2 -let xk_ff = 0x9e3 -let xk_cr = 0x9e4 -let xk_lf = 0x9e5 -let xk_nl = 0x9e8 -let xk_vt = 0x9e9 -let xk_lowrightcorner = 0x9ea -let xk_uprightcorner = 0x9eb -let xk_upleftcorner = 0x9ec -let xk_lowleftcorner = 0x9ed -let xk_crossinglines = 0x9ee -let xk_horizlinescan1 = 0x9ef -let xk_horizlinescan3 = 0x9f0 -let xk_horizlinescan5 = 0x9f1 -let xk_horizlinescan7 = 0x9f2 -let xk_horizlinescan9 = 0x9f3 -let xk_leftt = 0x9f4 -let xk_rightt = 0x9f5 -let xk_bott = 0x9f6 -let xk_topt = 0x9f7 -let xk_vertbar = 0x9f8 - - -(* - * Publishing - * Byte 3 = a - *) - - -let xk_emspace = 0xaa1 -let xk_enspace = 0xaa2 -let xk_em3space = 0xaa3 -let xk_em4space = 0xaa4 -let xk_digitspace = 0xaa5 -let xk_punctspace = 0xaa6 -let xk_thinspace = 0xaa7 -let xk_hairspace = 0xaa8 -let xk_emdash = 0xaa9 -let xk_endash = 0xaaa -let xk_signifblank = 0xaac -let xk_ellipsis = 0xaae -let xk_doubbaselinedot = 0xaaf -let xk_onethird = 0xab0 -let xk_twothirds = 0xab1 -let xk_onefifth = 0xab2 -let xk_twofifths = 0xab3 -let xk_threefifths = 0xab4 -let xk_fourfifths = 0xab5 -let xk_onesixth = 0xab6 -let xk_fivesixths = 0xab7 -let xk_careof = 0xab8 -let xk_figdash = 0xabb -let xk_leftanglebracket = 0xabc -let xk_decimalpoint = 0xabd -let xk_rightanglebracket = 0xabe -let xk_marker = 0xabf -let xk_oneeighth = 0xac3 -let xk_threeeighths = 0xac4 -let xk_fiveeighths = 0xac5 -let xk_seveneighths = 0xac6 -let xk_trademark = 0xac9 -let xk_signaturemark = 0xaca -let xk_trademarkincircle = 0xacb -let xk_leftopentriangle = 0xacc -let xk_rightopentriangle = 0xacd -let xk_emopencircle = 0xace -let xk_emopenrectangle = 0xacf -let xk_leftsinglequotemark = 0xad0 -let xk_rightsinglequotemark = 0xad1 -let xk_leftdoublequotemark = 0xad2 -let xk_rightdoublequotemark = 0xad3 -let xk_prescription = 0xad4 -let xk_minutes = 0xad6 -let xk_seconds = 0xad7 -let xk_latincross = 0xad9 -let xk_hexagram = 0xada -let xk_filledrectbullet = 0xadb -let xk_filledlefttribullet = 0xadc -let xk_filledrighttribullet = 0xadd -let xk_emfilledcircle = 0xade -let xk_emfilledrect = 0xadf -let xk_enopencircbullet = 0xae0 -let xk_enopensquarebullet = 0xae1 -let xk_openrectbullet = 0xae2 -let xk_opentribulletup = 0xae3 -let xk_opentribulletdown = 0xae4 -let xk_openstar = 0xae5 -let xk_enfilledcircbullet = 0xae6 -let xk_enfilledsqbullet = 0xae7 -let xk_filledtribulletup = 0xae8 -let xk_filledtribulletdown = 0xae9 -let xk_leftpointer = 0xaea -let xk_rightpointer = 0xaeb -let xk_club = 0xaec -let xk_diamond = 0xaed -let xk_heart = 0xaee -let xk_maltesecross = 0xaf0 -let xk_dagger = 0xaf1 -let xk_doubledagger = 0xaf2 -let xk_checkmark = 0xaf3 -let xk_ballotcross = 0xaf4 -let xk_musicalsharp = 0xaf5 -let xk_musicalflat = 0xaf6 -let xk_malesymbol = 0xaf7 -let xk_femalesymbol = 0xaf8 -let xk_telephone = 0xaf9 -let xk_telephonerecorder = 0xafa -let xk_phonographcopyright = 0xafb -let xk_caret = 0xafc -let xk_singlelowquotemark = 0xafd -let xk_doublelowquotemark = 0xafe -let xk_cursor = 0xaff - - -(* - * APL - * Byte 3 = b - *) - - -let xk_leftcaret = 0xba3 -let xk_rightcaret = 0xba6 -let xk_downcaret = 0xba8 -let xk_upcaret = 0xba9 -let xk_overbar = 0xbc0 -let xk_downtack = 0xbc2 -let xk_upshoe = 0xbc3 -let xk_downstile = 0xbc4 -let xk_underbar = 0xbc6 -let xk_jot = 0xbca -let xk_quad = 0xbcc -let xk_uptack = 0xbce -let xk_circle = 0xbcf -let xk_upstile = 0xbd3 -let xk_downshoe = 0xbd6 -let xk_rightshoe = 0xbd8 -let xk_leftshoe = 0xbda -let xk_lefttack = 0xbdc -let xk_righttack = 0xbfc - - -(* - * Hebrew - * Byte 3 = c - *) - - -let xk_hebrew_doublelowline = 0xcdf -let xk_hebrew_aleph = 0xce0 -let xk_hebrew_bet = 0xce1 -let xk_hebrew_beth = 0xce1 (** deprecated *) -let xk_hebrew_gimel = 0xce2 -let xk_hebrew_gimmel = 0xce2 (** deprecated *) -let xk_hebrew_dalet = 0xce3 -let xk_hebrew_daleth = 0xce3 (** deprecated *) -let xk_hebrew_he = 0xce4 -let xk_hebrew_waw = 0xce5 -let xk_hebrew_zain = 0xce6 -let xk_hebrew_zayin = 0xce6 (** deprecated *) -let xk_hebrew_chet = 0xce7 -let xk_hebrew_het = 0xce7 (** deprecated *) -let xk_hebrew_tet = 0xce8 -let xk_hebrew_teth = 0xce8 (** deprecated *) -let xk_hebrew_yod = 0xce9 -let xk_hebrew_finalkaph = 0xcea -let xk_hebrew_kaph = 0xceb -let xk_hebrew_lamed = 0xcec -let xk_hebrew_finalmem = 0xced -let xk_hebrew_mem = 0xcee -let xk_hebrew_finalnun = 0xcef -let xk_hebrew_nun = 0xcf0 -let xk_hebrew_samech = 0xcf1 -let xk_hebrew_samekh = 0xcf1 (** deprecated *) -let xk_hebrew_ayin = 0xcf2 -let xk_hebrew_finalpe = 0xcf3 -let xk_hebrew_pe = 0xcf4 -let xk_hebrew_finalzade = 0xcf5 -let xk_hebrew_finalzadi = 0xcf5 (** deprecated *) -let xk_hebrew_zade = 0xcf6 -let xk_hebrew_zadi = 0xcf6 (** deprecated *) -let xk_hebrew_qoph = 0xcf7 -let xk_hebrew_kuf = 0xcf7 (** deprecated *) -let xk_hebrew_resh = 0xcf8 -let xk_hebrew_shin = 0xcf9 -let xk_hebrew_taw = 0xcfa -let xk_hebrew_taf = 0xcfa (** deprecated *) -let xk_Hebrew_switch = 0xFF7E (** Alias for mode_switch *) - - -(* - * Thai - * Byte 3 = d - *) - - -let xk_Thai_kokai = 0xda1 -let xk_Thai_khokhai = 0xda2 -let xk_Thai_khokhuat = 0xda3 -let xk_Thai_khokhwai = 0xda4 -let xk_Thai_khokhon = 0xda5 -let xk_Thai_khorakhang = 0xda6 -let xk_Thai_ngongu = 0xda7 -let xk_Thai_chochan = 0xda8 -let xk_Thai_choching = 0xda9 -let xk_Thai_chochang = 0xdaa -let xk_Thai_soso = 0xdab -let xk_Thai_chochoe = 0xdac -let xk_Thai_yoying = 0xdad -let xk_Thai_dochada = 0xdae -let xk_Thai_topatak = 0xdaf -let xk_Thai_thothan = 0xdb0 -let xk_Thai_thonangmontho = 0xdb1 -let xk_Thai_thophuthao = 0xdb2 -let xk_Thai_nonen = 0xdb3 -let xk_Thai_dodek = 0xdb4 -let xk_Thai_totao = 0xdb5 -let xk_Thai_thothung = 0xdb6 -let xk_Thai_thothahan = 0xdb7 -let xk_Thai_thothong = 0xdb8 -let xk_Thai_nonu = 0xdb9 -let xk_Thai_bobaimai = 0xdba -let xk_Thai_popla = 0xdbb -let xk_Thai_phophung = 0xdbc -let xk_Thai_fofa = 0xdbd -let xk_Thai_phophan = 0xdbe -let xk_Thai_fofan = 0xdbf -let xk_Thai_phosamphao = 0xdc0 -let xk_Thai_moma = 0xdc1 -let xk_Thai_yoyak = 0xdc2 -let xk_Thai_rorua = 0xdc3 -let xk_Thai_ru = 0xdc4 -let xk_Thai_loling = 0xdc5 -let xk_Thai_lu = 0xdc6 -let xk_Thai_wowaen = 0xdc7 -let xk_Thai_sosala = 0xdc8 -let xk_Thai_sorusi = 0xdc9 -let xk_Thai_sosua = 0xdca -let xk_Thai_hohip = 0xdcb -let xk_Thai_lochula = 0xdcc -let xk_Thai_oang = 0xdcd -let xk_Thai_honokhuk = 0xdce -let xk_Thai_paiyannoi = 0xdcf -let xk_Thai_saraa = 0xdd0 -let xk_Thai_maihanakat = 0xdd1 -let xk_Thai_saraaa = 0xdd2 -let xk_Thai_saraam = 0xdd3 -let xk_Thai_sarai = 0xdd4 -let xk_Thai_saraii = 0xdd5 -let xk_Thai_saraue = 0xdd6 -let xk_Thai_sarauee = 0xdd7 -let xk_Thai_sarau = 0xdd8 -let xk_Thai_sarauu = 0xdd9 -let xk_Thai_phinthu = 0xdda -let xk_Thai_maihanakat_maitho = 0xdde -let xk_Thai_baht = 0xddf -let xk_Thai_sarae = 0xde0 -let xk_Thai_saraae = 0xde1 -let xk_Thai_sarao = 0xde2 -let xk_Thai_saraaimaimuan = 0xde3 -let xk_Thai_saraaimaimalai = 0xde4 -let xk_Thai_lakkhangyao = 0xde5 -let xk_Thai_maiyamok = 0xde6 -let xk_Thai_maitaikhu = 0xde7 -let xk_Thai_maiek = 0xde8 -let xk_Thai_maitho = 0xde9 -let xk_Thai_maitri = 0xdea -let xk_Thai_maichattawa = 0xdeb -let xk_Thai_thanthakhat = 0xdec -let xk_Thai_nikhahit = 0xded -let xk_Thai_leksun = 0xdf0 -let xk_Thai_leknung = 0xdf1 -let xk_Thai_leksong = 0xdf2 -let xk_Thai_leksam = 0xdf3 -let xk_Thai_leksi = 0xdf4 -let xk_Thai_lekha = 0xdf5 -let xk_Thai_lekhok = 0xdf6 -let xk_Thai_lekchet = 0xdf7 -let xk_Thai_lekpaet = 0xdf8 -let xk_Thai_lekkao = 0xdf9 - - -(* - * Korean - * Byte 3 = e - *) - - - -let xk_Hangul = 0xff31 (** Hangul start/stop(toggle) *) -let xk_Hangul_Start = 0xff32 (** Hangul start *) -let xk_Hangul_End = 0xff33 (** Hangul end, English start *) -let xk_Hangul_Hanja = 0xff34 (** Start Hangul->Hanja Conversion *) -let xk_Hangul_Jamo = 0xff35 (** Hangul Jamo mode *) -let xk_Hangul_Romaja = 0xff36 (** Hangul Romaja mode *) -let xk_Hangul_Codeinput = 0xff37 (** Hangul code input mode *) -let xk_Hangul_Jeonja = 0xff38 (** Jeonja mode *) -let xk_Hangul_Banja = 0xff39 (** Banja mode *) -let xk_Hangul_PreHanja = 0xff3a (** Pre Hanja conversion *) -let xk_Hangul_PostHanja = 0xff3b (** Post Hanja conversion *) -let xk_Hangul_SingleCandidate = 0xff3c (** Single candidate *) -let xk_Hangul_MultipleCandidate = 0xff3d (** Multiple candidate *) -let xk_Hangul_PreviousCandidate = 0xff3e (** Previous candidate *) -let xk_Hangul_Special = 0xff3f (** Special symbols *) -let xk_Hangul_switch = 0xFF7E (** Alias for mode_switch *) - -(** Hangul Consonant Characters *) -let xk_Hangul_Kiyeog = 0xea1 -let xk_Hangul_SsangKiyeog = 0xea2 -let xk_Hangul_KiyeogSios = 0xea3 -let xk_Hangul_Nieun = 0xea4 -let xk_Hangul_NieunJieuj = 0xea5 -let xk_Hangul_NieunHieuh = 0xea6 -let xk_Hangul_Dikeud = 0xea7 -let xk_Hangul_SsangDikeud = 0xea8 -let xk_Hangul_Rieul = 0xea9 -let xk_Hangul_RieulKiyeog = 0xeaa -let xk_Hangul_RieulMieum = 0xeab -let xk_Hangul_RieulPieub = 0xeac -let xk_Hangul_RieulSios = 0xead -let xk_Hangul_RieulTieut = 0xeae -let xk_Hangul_RieulPhieuf = 0xeaf -let xk_Hangul_RieulHieuh = 0xeb0 -let xk_Hangul_Mieum = 0xeb1 -let xk_Hangul_Pieub = 0xeb2 -let xk_Hangul_SsangPieub = 0xeb3 -let xk_Hangul_PieubSios = 0xeb4 -let xk_Hangul_Sios = 0xeb5 -let xk_Hangul_SsangSios = 0xeb6 -let xk_Hangul_Ieung = 0xeb7 -let xk_Hangul_Jieuj = 0xeb8 -let xk_Hangul_SsangJieuj = 0xeb9 -let xk_Hangul_Cieuc = 0xeba -let xk_Hangul_Khieuq = 0xebb -let xk_Hangul_Tieut = 0xebc -let xk_Hangul_Phieuf = 0xebd -let xk_Hangul_Hieuh = 0xebe - -(** Hangul Vowel Characters *) -let xk_Hangul_A = 0xebf -let xk_Hangul_AE = 0xec0 -let xk_Hangul_YA = 0xec1 -let xk_Hangul_YAE = 0xec2 -let xk_Hangul_EO = 0xec3 -let xk_Hangul_E = 0xec4 -let xk_Hangul_YEO = 0xec5 -let xk_Hangul_YE = 0xec6 -let xk_Hangul_O = 0xec7 -let xk_Hangul_WA = 0xec8 -let xk_Hangul_WAE = 0xec9 -let xk_Hangul_OE = 0xeca -let xk_Hangul_YO = 0xecb -let xk_Hangul_U = 0xecc -let xk_Hangul_WEO = 0xecd -let xk_Hangul_WE = 0xece -let xk_Hangul_WI = 0xecf -let xk_Hangul_YU = 0xed0 -let xk_Hangul_EU = 0xed1 -let xk_Hangul_YI = 0xed2 -let xk_Hangul_I = 0xed3 - -(** Hangul syllable-final (JongSeong) Characters *) -let xk_Hangul_J_Kiyeog = 0xed4 -let xk_Hangul_J_SsangKiyeog = 0xed5 -let xk_Hangul_J_KiyeogSios = 0xed6 -let xk_Hangul_J_Nieun = 0xed7 -let xk_Hangul_J_NieunJieuj = 0xed8 -let xk_Hangul_J_NieunHieuh = 0xed9 -let xk_Hangul_J_Dikeud = 0xeda -let xk_Hangul_J_Rieul = 0xedb -let xk_Hangul_J_RieulKiyeog = 0xedc -let xk_Hangul_J_RieulMieum = 0xedd -let xk_Hangul_J_RieulPieub = 0xede -let xk_Hangul_J_RieulSios = 0xedf -let xk_Hangul_J_RieulTieut = 0xee0 -let xk_Hangul_J_RieulPhieuf = 0xee1 -let xk_Hangul_J_RieulHieuh = 0xee2 -let xk_Hangul_J_Mieum = 0xee3 -let xk_Hangul_J_Pieub = 0xee4 -let xk_Hangul_J_PieubSios = 0xee5 -let xk_Hangul_J_Sios = 0xee6 -let xk_Hangul_J_SsangSios = 0xee7 -let xk_Hangul_J_Ieung = 0xee8 -let xk_Hangul_J_Jieuj = 0xee9 -let xk_Hangul_J_Cieuc = 0xeea -let xk_Hangul_J_Khieuq = 0xeeb -let xk_Hangul_J_Tieut = 0xeec -let xk_Hangul_J_Phieuf = 0xeed -let xk_Hangul_J_Hieuh = 0xeee - -(** Ancient Hangul Consonant Characters *) -let xk_Hangul_RieulYeorinHieuh = 0xeef -let xk_Hangul_SunkyeongeumMieum = 0xef0 -let xk_Hangul_SunkyeongeumPieub = 0xef1 -let xk_Hangul_PanSios = 0xef2 -let xk_Hangul_KkogjiDalrinIeung = 0xef3 -let xk_Hangul_SunkyeongeumPhieuf = 0xef4 -let xk_Hangul_YeorinHieuh = 0xef5 - -(** Ancient Hangul Vowel Characters *) -let xk_Hangul_AraeA = 0xef6 -let xk_Hangul_AraeAE = 0xef7 - -(** Ancient Hangul syllable-final (JongSeong) Characters *) -let xk_Hangul_J_PanSios = 0xef8 -let xk_Hangul_J_KkogjiDalrinIeung = 0xef9 -let xk_Hangul_J_YeorinHieuh = 0xefa - -(** Korean currency symbol *) -let xk_Korean_Won = 0xeff - - - -let name_to_keysym = [ -"VoidSymbol",0xFFFFFF; -"BackSpace",0xFF08; -"Tab",0xFF09; -"Linefeed",0xFF0A; -"Clear",0xFF0B; -"Return",0xFF0D; -"Pause",0xFF13; -"Scroll_Lock",0xFF14; -"Sys_Req",0xFF15; -"Escape",0xFF1B; -"Delete",0xFFFF; -"Multi_key",0xFF20; -"Kanji",0xFF21; -"Muhenkan",0xFF22; -"Henkan_Mode",0xFF23; -"Henkan",0xFF23; -"Romaji",0xFF24; -"Hiragana",0xFF25; -"Katakana",0xFF26; -"Hiragana_Katakana",0xFF27; -"Zenkaku",0xFF28; -"Hankaku",0xFF29; -"Zenkaku_Hankaku",0xFF2A; -"Touroku",0xFF2B; -"Massyo",0xFF2C; -"Kana_Lock",0xFF2D; -"Kana_Shift",0xFF2E; -"Eisu_Shift",0xFF2F; -"Eisu_toggle",0xFF30; -"Home",0xFF50; -"Left",0xFF51; -"Up",0xFF52; -"Right",0xFF53; -"Down",0xFF54; -"Prior",0xFF55; -"Page_Up",0xFF55; -"Next",0xFF56; -"Page_Down",0xFF56; -"End",0xFF57; -"Begin",0xFF58; -"Select",0xFF60; -"Print",0xFF61; -"Execute",0xFF62; -"Insert",0xFF63; -"Undo",0xFF65; -"Redo",0xFF66; -"Menu",0xFF67; -"Find",0xFF68; -"Cancel",0xFF69; -"Help",0xFF6A; -"Break",0xFF6B; -"Mode_switch",0xFF7E; -"script_switch",0xFF7E; -"Num_Lock",0xFF7F; -"KP_Space",0xFF80; -"KP_Tab",0xFF89; -"KP_Enter",0xFF8D; -"KP_F1",0xFF91; -"KP_F2",0xFF92; -"KP_F3",0xFF93; -"KP_F4",0xFF94; -"KP_Home",0xFF95; -"KP_Left",0xFF96; -"KP_Up",0xFF97; -"KP_Right",0xFF98; -"KP_Down",0xFF99; -"KP_Prior",0xFF9A; -"KP_Page_Up",0xFF9A; -"KP_Next",0xFF9B; -"KP_Page_Down",0xFF9B; -"KP_End",0xFF9C; -"KP_Begin",0xFF9D; -"KP_Insert",0xFF9E; -"KP_Delete",0xFF9F; -"KP_Equal",0xFFBD; -"KP_Multiply",0xFFAA; -"KP_Add",0xFFAB; -"KP_Separator",0xFFAC; -"KP_Subtract",0xFFAD; -"KP_Decimal",0xFFAE; -"KP_Divide",0xFFAF; -"KP_0",0xFFB0; -"KP_1",0xFFB1; -"KP_2",0xFFB2; -"KP_3",0xFFB3; -"KP_4",0xFFB4; -"KP_5",0xFFB5; -"KP_6",0xFFB6; -"KP_7",0xFFB7; -"KP_8",0xFFB8; -"KP_9",0xFFB9; -"F1",0xFFBE; -"F2",0xFFBF; -"F3",0xFFC0; -"F4",0xFFC1; -"F5",0xFFC2; -"F6",0xFFC3; -"F7",0xFFC4; -"F8",0xFFC5; -"F9",0xFFC6; -"F10",0xFFC7; -"F11",0xFFC8; -"L1",0xFFC8; -"F12",0xFFC9; -"L2",0xFFC9; -"F13",0xFFCA; -"L3",0xFFCA; -"F14",0xFFCB; -"L4",0xFFCB; -"F15",0xFFCC; -"L5",0xFFCC; -"F16",0xFFCD; -"L6",0xFFCD; -"F17",0xFFCE; -"L7",0xFFCE; -"F18",0xFFCF; -"L8",0xFFCF; -"F19",0xFFD0; -"L9",0xFFD0; -"F20",0xFFD1; -"L10",0xFFD1; -"F21",0xFFD2; -"R1",0xFFD2; -"F22",0xFFD3; -"R2",0xFFD3; -"F23",0xFFD4; -"R3",0xFFD4; -"F24",0xFFD5; -"R4",0xFFD5; -"F25",0xFFD6; -"R5",0xFFD6; -"F26",0xFFD7; -"R6",0xFFD7; -"F27",0xFFD8; -"R7",0xFFD8; -"F28",0xFFD9; -"R8",0xFFD9; -"F29",0xFFDA; -"R9",0xFFDA; -"F30",0xFFDB; -"R10",0xFFDB; -"F31",0xFFDC; -"R11",0xFFDC; -"F32",0xFFDD; -"R12",0xFFDD; -"F33",0xFFDE; -"R13",0xFFDE; -"F34",0xFFDF; -"R14",0xFFDF; -"F35",0xFFE0; -"R15",0xFFE0; -"Shift_L",0xFFE1; -"Shift_R",0xFFE2; -"Control_L",0xFFE3; -"Control_R",0xFFE4; -"Caps_Lock",0xFFE5; -"Shift_Lock",0xFFE6; -"Meta_L",0xFFE7; -"Meta_R",0xFFE8; -"Alt_L",0xFFE9; -"Alt_R",0xFFEA; -"Super_L",0xFFEB; -"Super_R",0xFFEC; -"Hyper_L",0xFFED; -"Hyper_R",0xFFEE; -"ISO_Lock",0xFE01; -"ISO_Level2_Latch",0xFE02; -"ISO_Level3_Shift",0xFE03; -"ISO_Level3_Latch",0xFE04; -"ISO_Level3_Lock",0xFE05; -"ISO_Group_Shift",0xFF7E; -"ISO_Group_Latch",0xFE06; -"ISO_Group_Lock",0xFE07; -"ISO_Next_Group",0xFE08; -"ISO_Next_Group_Lock",0xFE09; -"ISO_Prev_Group",0xFE0A; -"ISO_Prev_Group_Lock",0xFE0B; -"ISO_First_Group",0xFE0C; -"ISO_First_Group_Lock",0xFE0D; -"ISO_Last_Group",0xFE0E; -"ISO_Last_Group_Lock",0xFE0F; -"ISO_Left_Tab",0xFE20; -"ISO_Move_Line_Up",0xFE21; -"ISO_Move_Line_Down",0xFE22; -"ISO_Partial_Line_Up",0xFE23; -"ISO_Partial_Line_Down",0xFE24; -"ISO_Partial_Space_Left",0xFE25; -"ISO_Partial_Space_Right",0xFE26; -"ISO_Set_Margin_Left",0xFE27; -"ISO_Set_Margin_Right",0xFE28; -"ISO_Release_Margin_Left",0xFE29; -"ISO_Release_Margin_Right",0xFE2A; -"ISO_Release_Both_Margins",0xFE2B; -"ISO_Fast_Cursor_Left",0xFE2C; -"ISO_Fast_Cursor_Right",0xFE2D; -"ISO_Fast_Cursor_Up",0xFE2E; -"ISO_Fast_Cursor_Down",0xFE2F; -"ISO_Continuous_Underline",0xFE30; -"ISO_Discontinuous_Underline",0xFE31; -"ISO_Emphasize",0xFE32; -"ISO_Center_Object",0xFE33; -"ISO_Enter",0xFE34; -"dead_grave",0xFE50; -"dead_acute",0xFE51; -"dead_circumflex",0xFE52; -"dead_tilde",0xFE53; -"dead_macron",0xFE54; -"dead_breve",0xFE55; -"dead_abovedot",0xFE56; -"dead_diaeresis",0xFE57; -"dead_abovering",0xFE58; -"dead_doubleacute",0xFE59; -"dead_caron",0xFE5A; -"dead_cedilla",0xFE5B; -"dead_ogonek",0xFE5C; -"dead_iota",0xFE5D; -"dead_voiced_sound",0xFE5E; -"dead_semivoiced_sound",0xFE5F; -"dead_belowdot",0xFE60; -"First_Virtual_Screen",0xFED0; -"Prev_Virtual_Screen",0xFED1; -"Next_Virtual_Screen",0xFED2; -"Last_Virtual_Screen",0xFED4; -"Terminate_Server",0xFED5; -"AccessX_Enable",0xFE70; -"AccessX_Feedback_Enable",0xFE71; -"RepeatKeys_Enable",0xFE72; -"SlowKeys_Enable",0xFE73; -"BounceKeys_Enable",0xFE74; -"StickyKeys_Enable",0xFE75; -"MouseKeys_Enable",0xFE76; -"MouseKeys_Accel_Enable",0xFE77; -"Overlay1_Enable",0xFE78; -"Overlay2_Enable",0xFE79; -"AudibleBell_Enable",0xFE7A; -"Pointer_Left",0xFEE0; -"Pointer_Right",0xFEE1; -"Pointer_Up",0xFEE2; -"Pointer_Down",0xFEE3; -"Pointer_UpLeft",0xFEE4; -"Pointer_UpRight",0xFEE5; -"Pointer_DownLeft",0xFEE6; -"Pointer_DownRight",0xFEE7; -"Pointer_Button_Dflt",0xFEE8; -"Pointer_Button1",0xFEE9; -"Pointer_Button2",0xFEEA; -"Pointer_Button3",0xFEEB; -"Pointer_Button4",0xFEEC; -"Pointer_Button5",0xFEED; -"Pointer_DblClick_Dflt",0xFEEE; -"Pointer_DblClick1",0xFEEF; -"Pointer_DblClick2",0xFEF0; -"Pointer_DblClick3",0xFEF1; -"Pointer_DblClick4",0xFEF2; -"Pointer_DblClick5",0xFEF3; -"Pointer_Drag_Dflt",0xFEF4; -"Pointer_Drag1",0xFEF5; -"Pointer_Drag2",0xFEF6; -"Pointer_Drag3",0xFEF7; -"Pointer_Drag4",0xFEF8; -"Pointer_Drag5",0xFEFD; -"Pointer_EnableKeys",0xFEF9; -"Pointer_Accelerate",0xFEFA; -"Pointer_DfltBtnNext",0xFEFB; -"Pointer_DfltBtnPrev",0xFEFC; -"3270_Duplicate",0xFD01; -"3270_FieldMark",0xFD02; -"3270_Right2",0xFD03; -"3270_Left2",0xFD04; -"3270_BackTab",0xFD05; -"3270_EraseEOF",0xFD06; -"3270_EraseInput",0xFD07; -"3270_Reset",0xFD08; -"3270_Quit",0xFD09; -"3270_PA1",0xFD0A; -"3270_PA2",0xFD0B; -"3270_PA3",0xFD0C; -"3270_Test",0xFD0D; -"3270_Attn",0xFD0E; -"3270_CursorBlink",0xFD0F; -"3270_AltCursor",0xFD10; -"3270_KeyClick",0xFD11; -"3270_Jump",0xFD12; -"3270_Ident",0xFD13; -"3270_Rule",0xFD14; -"3270_Copy",0xFD15; -"3270_Play",0xFD16; -"3270_Setup",0xFD17; -"3270_Record",0xFD18; -"3270_ChangeScreen",0xFD19; -"3270_DeleteWord",0xFD1A; -"3270_ExSelect",0xFD1B; -"3270_CursorSelect",0xFD1C; -"3270_PrintScreen",0xFD1D; -"3270_Enter",0xFD1E; -"space",0x020; -"exclam",0x021; -"quotedbl",0x022; -"numbersign",0x023; -"dollar",0x024; -"percent",0x025; -"ampersand",0x026; -"apostrophe",0x027; -"quoteright",0x027; -"parenleft",0x028; -"parenright",0x029; -"asterisk",0x02a; -"plus",0x02b; -"comma",0x02c; -"minus",0x02d; -"period",0x02e; -"slash",0x02f; -"0",0x030; -"1",0x031; -"2",0x032; -"3",0x033; -"4",0x034; -"5",0x035; -"6",0x036; -"7",0x037; -"8",0x038; -"9",0x039; -"colon",0x03a; -"semicolon",0x03b; -"less",0x03c; -"equal",0x03d; -"greater",0x03e; -"question",0x03f; -"at",0x040; -"A",0x041; -"B",0x042; -"C",0x043; -"D",0x044; -"E",0x045; -"F",0x046; -"G",0x047; -"H",0x048; -"I",0x049; -"J",0x04a; -"K",0x04b; -"L",0x04c; -"M",0x04d; -"N",0x04e; -"O",0x04f; -"P",0x050; -"Q",0x051; -"R",0x052; -"S",0x053; -"T",0x054; -"U",0x055; -"V",0x056; -"W",0x057; -"X",0x058; -"Y",0x059; -"Z",0x05a; -"bracketleft",0x05b; -"backslash",0x05c; -"bracketright",0x05d; -"asciicircum",0x05e; -"underscore",0x05f; -"grave",0x060; -"quoteleft",0x060; -"a",0x061; -"b",0x062; -"c",0x063; -"d",0x064; -"e",0x065; -"f",0x066; -"g",0x067; -"h",0x068; -"i",0x069; -"j",0x06a; -"k",0x06b; -"l",0x06c; -"m",0x06d; -"n",0x06e; -"o",0x06f; -"p",0x070; -"q",0x071; -"r",0x072; -"s",0x073; -"t",0x074; -"u",0x075; -"v",0x076; -"w",0x077; -"x",0x078; -"y",0x079; -"z",0x07a; -"braceleft",0x07b; -"bar",0x07c; -"braceright",0x07d; -"asciitilde",0x07e; -"nobreakspace",0x0a0; -"exclamdown",0x0a1; -"cent",0x0a2; -"sterling",0x0a3; -"currency",0x0a4; -"yen",0x0a5; -"brokenbar",0x0a6; -"section",0x0a7; -"diaeresis",0x0a8; -"copyright",0x0a9; -"ordfeminine",0x0aa; -"guillemotleft",0x0ab; -"notsign",0x0ac; -"hyphen",0x0ad; -"registered",0x0ae; -"macron",0x0af; -"degree",0x0b0; -"plusminus",0x0b1; -"twosuperior",0x0b2; -"threesuperior",0x0b3; -"acute",0x0b4; -"mu",0x0b5; -"paragraph",0x0b6; -"periodcentered",0x0b7; -"cedilla",0x0b8; -"onesuperior",0x0b9; -"masculine",0x0ba; -"guillemotright",0x0bb; -"onequarter",0x0bc; -"onehalf",0x0bd; -"threequarters",0x0be; -"questiondown",0x0bf; -"Agrave",0x0c0; -"Aacute",0x0c1; -"Acircumflex",0x0c2; -"Atilde",0x0c3; -"Adiaeresis",0x0c4; -"Aring",0x0c5; -"AE",0x0c6; -"Ccedilla",0x0c7; -"Egrave",0x0c8; -"Eacute",0x0c9; -"Ecircumflex",0x0ca; -"Ediaeresis",0x0cb; -"Igrave",0x0cc; -"Iacute",0x0cd; -"Icircumflex",0x0ce; -"Idiaeresis",0x0cf; -"ETH",0x0d0; -"Eth",0x0d0; -"Ntilde",0x0d1; -"Ograve",0x0d2; -"Oacute",0x0d3; -"Ocircumflex",0x0d4; -"Otilde",0x0d5; -"Odiaeresis",0x0d6; -"multiply",0x0d7; -"Ooblique",0x0d8; -"Ugrave",0x0d9; -"Uacute",0x0da; -"Ucircumflex",0x0db; -"Udiaeresis",0x0dc; -"Yacute",0x0dd; -"THORN",0x0de; -"Thorn",0x0de; -"ssharp",0x0df; -"agrave",0x0e0; -"aacute",0x0e1; -"acircumflex",0x0e2; -"atilde",0x0e3; -"adiaeresis",0x0e4; -"aring",0x0e5; -"ae",0x0e6; -"ccedilla",0x0e7; -"egrave",0x0e8; -"eacute",0x0e9; -"ecircumflex",0x0ea; -"ediaeresis",0x0eb; -"igrave",0x0ec; -"iacute",0x0ed; -"icircumflex",0x0ee; -"idiaeresis",0x0ef; -"eth",0x0f0; -"ntilde",0x0f1; -"ograve",0x0f2; -"oacute",0x0f3; -"ocircumflex",0x0f4; -"otilde",0x0f5; -"odiaeresis",0x0f6; -"division",0x0f7; -"oslash",0x0f8; -"ugrave",0x0f9; -"uacute",0x0fa; -"ucircumflex",0x0fb; -"udiaeresis",0x0fc; -"yacute",0x0fd; -"thorn",0x0fe; -"ydiaeresis",0x0ff; -"Aogonek",0x1a1; -"breve",0x1a2; -"Lstroke",0x1a3; -"Lcaron",0x1a5; -"Sacute",0x1a6; -"Scaron",0x1a9; -"Scedilla",0x1aa; -"Tcaron",0x1ab; -"Zacute",0x1ac; -"Zcaron",0x1ae; -"Zabovedot",0x1af; -"aogonek",0x1b1; -"ogonek",0x1b2; -"lstroke",0x1b3; -"lcaron",0x1b5; -"sacute",0x1b6; -"caron",0x1b7; -"scaron",0x1b9; -"scedilla",0x1ba; -"tcaron",0x1bb; -"zacute",0x1bc; -"doubleacute",0x1bd; -"zcaron",0x1be; -"zabovedot",0x1bf; -"Racute",0x1c0; -"Abreve",0x1c3; -"Lacute",0x1c5; -"Cacute",0x1c6; -"Ccaron",0x1c8; -"Eogonek",0x1ca; -"Ecaron",0x1cc; -"Dcaron",0x1cf; -"Dstroke",0x1d0; -"Nacute",0x1d1; -"Ncaron",0x1d2; -"Odoubleacute",0x1d5; -"Rcaron",0x1d8; -"Uring",0x1d9; -"Udoubleacute",0x1db; -"Tcedilla",0x1de; -"racute",0x1e0; -"abreve",0x1e3; -"lacute",0x1e5; -"cacute",0x1e6; -"ccaron",0x1e8; -"eogonek",0x1ea; -"ecaron",0x1ec; -"dcaron",0x1ef; -"dstroke",0x1f0; -"nacute",0x1f1; -"ncaron",0x1f2; -"odoubleacute",0x1f5; -"udoubleacute",0x1fb; -"rcaron",0x1f8; -"uring",0x1f9; -"tcedilla",0x1fe; -"abovedot",0x1ff; -"Hstroke",0x2a1; -"Hcircumflex",0x2a6; -"Iabovedot",0x2a9; -"Gbreve",0x2ab; -"Jcircumflex",0x2ac; -"hstroke",0x2b1; -"hcircumflex",0x2b6; -"idotless",0x2b9; -"gbreve",0x2bb; -"jcircumflex",0x2bc; -"Cabovedot",0x2c5; -"Ccircumflex",0x2c6; -"Gabovedot",0x2d5; -"Gcircumflex",0x2d8; -"Ubreve",0x2dd; -"Scircumflex",0x2de; -"cabovedot",0x2e5; -"ccircumflex",0x2e6; -"gabovedot",0x2f5; -"gcircumflex",0x2f8; -"ubreve",0x2fd; -"scircumflex",0x2fe; -"kra",0x3a2; -"kappa",0x3a2; -"Rcedilla",0x3a3; -"Itilde",0x3a5; -"Lcedilla",0x3a6; -"Emacron",0x3aa; -"Gcedilla",0x3ab; -"Tslash",0x3ac; -"rcedilla",0x3b3; -"itilde",0x3b5; -"lcedilla",0x3b6; -"emacron",0x3ba; -"gcedilla",0x3bb; -"tslash",0x3bc; -"ENG",0x3bd; -"eng",0x3bf; -"Amacron",0x3c0; -"Iogonek",0x3c7; -"Eabovedot",0x3cc; -"Imacron",0x3cf; -"Ncedilla",0x3d1; -"Omacron",0x3d2; -"Kcedilla",0x3d3; -"Uogonek",0x3d9; -"Utilde",0x3dd; -"Umacron",0x3de; -"amacron",0x3e0; -"iogonek",0x3e7; -"eabovedot",0x3ec; -"imacron",0x3ef; -"ncedilla",0x3f1; -"omacron",0x3f2; -"kcedilla",0x3f3; -"uogonek",0x3f9; -"utilde",0x3fd; -"umacron",0x3fe; -"overline",0x47e; -"kana_fullstop",0x4a1; -"kana_openingbracket",0x4a2; -"kana_closingbracket",0x4a3; -"kana_comma",0x4a4; -"kana_conjunctive",0x4a5; -"kana_middledot",0x4a5; -"kana_WO",0x4a6; -"kana_a",0x4a7; -"kana_i",0x4a8; -"kana_u",0x4a9; -"kana_e",0x4aa; -"kana_o",0x4ab; -"kana_ya",0x4ac; -"kana_yu",0x4ad; -"kana_yo",0x4ae; -"kana_tsu",0x4af; -"kana_tu",0x4af; -"prolongedsound",0x4b0; -"kana_A",0x4b1; -"kana_I",0x4b2; -"kana_U",0x4b3; -"kana_E",0x4b4; -"kana_O",0x4b5; -"kana_KA",0x4b6; -"kana_KI",0x4b7; -"kana_KU",0x4b8; -"kana_KE",0x4b9; -"kana_KO",0x4ba; -"kana_SA",0x4bb; -"kana_SHI",0x4bc; -"kana_SU",0x4bd; -"kana_SE",0x4be; -"kana_SO",0x4bf; -"kana_TA",0x4c0; -"kana_CHI",0x4c1; -"kana_TI",0x4c1; -"kana_TSU",0x4c2; -"kana_TU",0x4c2; -"kana_TE",0x4c3; -"kana_TO",0x4c4; -"kana_NA",0x4c5; -"kana_NI",0x4c6; -"kana_NU",0x4c7; -"kana_NE",0x4c8; -"kana_NO",0x4c9; -"kana_HA",0x4ca; -"kana_HI",0x4cb; -"kana_FU",0x4cc; -"kana_HU",0x4cc; -"kana_HE",0x4cd; -"kana_HO",0x4ce; -"kana_MA",0x4cf; -"kana_MI",0x4d0; -"kana_MU",0x4d1; -"kana_ME",0x4d2; -"kana_MO",0x4d3; -"kana_YA",0x4d4; -"kana_YU",0x4d5; -"kana_YO",0x4d6; -"kana_RA",0x4d7; -"kana_RI",0x4d8; -"kana_RU",0x4d9; -"kana_RE",0x4da; -"kana_RO",0x4db; -"kana_WA",0x4dc; -"kana_N",0x4dd; -"voicedsound",0x4de; -"semivoicedsound",0x4df; -"kana_switch",0xFF7E; -"Arabic_comma",0x5ac; -"Arabic_semicolon",0x5bb; -"Arabic_question_mark",0x5bf; -"Arabic_hamza",0x5c1; -"Arabic_maddaonalef",0x5c2; -"Arabic_hamzaonalef",0x5c3; -"Arabic_hamzaonwaw",0x5c4; -"Arabic_hamzaunderalef",0x5c5; -"Arabic_hamzaonyeh",0x5c6; -"Arabic_alef",0x5c7; -"Arabic_beh",0x5c8; -"Arabic_tehmarbuta",0x5c9; -"Arabic_teh",0x5ca; -"Arabic_theh",0x5cb; -"Arabic_jeem",0x5cc; -"Arabic_hah",0x5cd; -"Arabic_khah",0x5ce; -"Arabic_dal",0x5cf; -"Arabic_thal",0x5d0; -"Arabic_ra",0x5d1; -"Arabic_zain",0x5d2; -"Arabic_seen",0x5d3; -"Arabic_sheen",0x5d4; -"Arabic_sad",0x5d5; -"Arabic_dad",0x5d6; -"Arabic_tah",0x5d7; -"Arabic_zah",0x5d8; -"Arabic_ain",0x5d9; -"Arabic_ghain",0x5da; -"Arabic_tatweel",0x5e0; -"Arabic_feh",0x5e1; -"Arabic_qaf",0x5e2; -"Arabic_kaf",0x5e3; -"Arabic_lam",0x5e4; -"Arabic_meem",0x5e5; -"Arabic_noon",0x5e6; -"Arabic_ha",0x5e7; -"Arabic_heh",0x5e7; -"Arabic_waw",0x5e8; -"Arabic_alefmaksura",0x5e9; -"Arabic_yeh",0x5ea; -"Arabic_fathatan",0x5eb; -"Arabic_dammatan",0x5ec; -"Arabic_kasratan",0x5ed; -"Arabic_fatha",0x5ee; -"Arabic_damma",0x5ef; -"Arabic_kasra",0x5f0; -"Arabic_shadda",0x5f1; -"Arabic_sukun",0x5f2; -"Arabic_switch",0xFF7E; -"Serbian_dje",0x6a1; -"Macedonia_gje",0x6a2; -"Cyrillic_io",0x6a3; -"Ukrainian_ie",0x6a4; -"Ukranian_je",0x6a4; -"Macedonia_dse",0x6a5; -"Ukrainian_i",0x6a6; -"Ukranian_i",0x6a6; -"Ukrainian_yi",0x6a7; -"Ukranian_yi",0x6a7; -"Cyrillic_je",0x6a8; -"Serbian_je",0x6a8; -"Cyrillic_lje",0x6a9; -"Serbian_lje",0x6a9; -"Cyrillic_nje",0x6aa; -"Serbian_nje",0x6aa; -"Serbian_tshe",0x6ab; -"Macedonia_kje",0x6ac; -"Byelorussian_shortu",0x6ae; -"Cyrillic_dzhe",0x6af; -"Serbian_dze",0x6af; -"numerosign",0x6b0; -"Serbian_DJE",0x6b1; -"Macedonia_GJE",0x6b2; -"Cyrillic_IO",0x6b3; -"Ukrainian_IE",0x6b4; -"Ukranian_JE",0x6b4; -"Macedonia_DSE",0x6b5; -"Ukrainian_I",0x6b6; -"Ukranian_I",0x6b6; -"Ukrainian_YI",0x6b7; -"Ukranian_YI",0x6b7; -"Cyrillic_JE",0x6b8; -"Serbian_JE",0x6b8; -"Cyrillic_LJE",0x6b9; -"Serbian_LJE",0x6b9; -"Cyrillic_NJE",0x6ba; -"Serbian_NJE",0x6ba; -"Serbian_TSHE",0x6bb; -"Macedonia_KJE",0x6bc; -"Byelorussian_SHORTU",0x6be; -"Cyrillic_DZHE",0x6bf; -"Serbian_DZE",0x6bf; -"Cyrillic_yu",0x6c0; -"Cyrillic_a",0x6c1; -"Cyrillic_be",0x6c2; -"Cyrillic_tse",0x6c3; -"Cyrillic_de",0x6c4; -"Cyrillic_ie",0x6c5; -"Cyrillic_ef",0x6c6; -"Cyrillic_ghe",0x6c7; -"Cyrillic_ha",0x6c8; -"Cyrillic_i",0x6c9; -"Cyrillic_shorti",0x6ca; -"Cyrillic_ka",0x6cb; -"Cyrillic_el",0x6cc; -"Cyrillic_em",0x6cd; -"Cyrillic_en",0x6ce; -"Cyrillic_o",0x6cf; -"Cyrillic_pe",0x6d0; -"Cyrillic_ya",0x6d1; -"Cyrillic_er",0x6d2; -"Cyrillic_es",0x6d3; -"Cyrillic_te",0x6d4; -"Cyrillic_u",0x6d5; -"Cyrillic_zhe",0x6d6; -"Cyrillic_ve",0x6d7; -"Cyrillic_softsign",0x6d8; -"Cyrillic_yeru",0x6d9; -"Cyrillic_ze",0x6da; -"Cyrillic_sha",0x6db; -"Cyrillic_e",0x6dc; -"Cyrillic_shcha",0x6dd; -"Cyrillic_che",0x6de; -"Cyrillic_hardsign",0x6df; -"Cyrillic_YU",0x6e0; -"Cyrillic_A",0x6e1; -"Cyrillic_BE",0x6e2; -"Cyrillic_TSE",0x6e3; -"Cyrillic_DE",0x6e4; -"Cyrillic_IE",0x6e5; -"Cyrillic_EF",0x6e6; -"Cyrillic_GHE",0x6e7; -"Cyrillic_HA",0x6e8; -"Cyrillic_I",0x6e9; -"Cyrillic_SHORTI",0x6ea; -"Cyrillic_KA",0x6eb; -"Cyrillic_EL",0x6ec; -"Cyrillic_EM",0x6ed; -"Cyrillic_EN",0x6ee; -"Cyrillic_O",0x6ef; -"Cyrillic_PE",0x6f0; -"Cyrillic_YA",0x6f1; -"Cyrillic_ER",0x6f2; -"Cyrillic_ES",0x6f3; -"Cyrillic_TE",0x6f4; -"Cyrillic_U",0x6f5; -"Cyrillic_ZHE",0x6f6; -"Cyrillic_VE",0x6f7; -"Cyrillic_SOFTSIGN",0x6f8; -"Cyrillic_YERU",0x6f9; -"Cyrillic_ZE",0x6fa; -"Cyrillic_SHA",0x6fb; -"Cyrillic_E",0x6fc; -"Cyrillic_SHCHA",0x6fd; -"Cyrillic_CHE",0x6fe; -"Cyrillic_HARDSIGN",0x6ff; -"Greek_ALPHAaccent",0x7a1; -"Greek_EPSILONaccent",0x7a2; -"Greek_ETAaccent",0x7a3; -"Greek_IOTAaccent",0x7a4; -"Greek_IOTAdiaeresis",0x7a5; -"Greek_OMICRONaccent",0x7a7; -"Greek_UPSILONaccent",0x7a8; -"Greek_UPSILONdieresis",0x7a9; -"Greek_OMEGAaccent",0x7ab; -"Greek_accentdieresis",0x7ae; -"Greek_horizbar",0x7af; -"Greek_alphaaccent",0x7b1; -"Greek_epsilonaccent",0x7b2; -"Greek_etaaccent",0x7b3; -"Greek_iotaaccent",0x7b4; -"Greek_iotadieresis",0x7b5; -"Greek_iotaaccentdieresis",0x7b6; -"Greek_omicronaccent",0x7b7; -"Greek_upsilonaccent",0x7b8; -"Greek_upsilondieresis",0x7b9; -"Greek_upsilonaccentdieresis",0x7ba; -"Greek_omegaaccent",0x7bb; -"Greek_ALPHA",0x7c1; -"Greek_BETA",0x7c2; -"Greek_GAMMA",0x7c3; -"Greek_DELTA",0x7c4; -"Greek_EPSILON",0x7c5; -"Greek_ZETA",0x7c6; -"Greek_ETA",0x7c7; -"Greek_THETA",0x7c8; -"Greek_IOTA",0x7c9; -"Greek_KAPPA",0x7ca; -"Greek_LAMDA",0x7cb; -"Greek_LAMBDA",0x7cb; -"Greek_MU",0x7cc; -"Greek_NU",0x7cd; -"Greek_XI",0x7ce; -"Greek_OMICRON",0x7cf; -"Greek_PI",0x7d0; -"Greek_RHO",0x7d1; -"Greek_SIGMA",0x7d2; -"Greek_TAU",0x7d4; -"Greek_UPSILON",0x7d5; -"Greek_PHI",0x7d6; -"Greek_CHI",0x7d7; -"Greek_PSI",0x7d8; -"Greek_OMEGA",0x7d9; -"Greek_alpha",0x7e1; -"Greek_beta",0x7e2; -"Greek_gamma",0x7e3; -"Greek_delta",0x7e4; -"Greek_epsilon",0x7e5; -"Greek_zeta",0x7e6; -"Greek_eta",0x7e7; -"Greek_theta",0x7e8; -"Greek_iota",0x7e9; -"Greek_kappa",0x7ea; -"Greek_lamda",0x7eb; -"Greek_lambda",0x7eb; -"Greek_mu",0x7ec; -"Greek_nu",0x7ed; -"Greek_xi",0x7ee; -"Greek_omicron",0x7ef; -"Greek_pi",0x7f0; -"Greek_rho",0x7f1; -"Greek_sigma",0x7f2; -"Greek_finalsmallsigma",0x7f3; -"Greek_tau",0x7f4; -"Greek_upsilon",0x7f5; -"Greek_phi",0x7f6; -"Greek_chi",0x7f7; -"Greek_psi",0x7f8; -"Greek_omega",0x7f9; -"Greek_switch",0xFF7E; -"leftradical",0x8a1; -"topleftradical",0x8a2; -"horizconnector",0x8a3; -"topintegral",0x8a4; -"botintegral",0x8a5; -"vertconnector",0x8a6; -"topleftsqbracket",0x8a7; -"botleftsqbracket",0x8a8; -"toprightsqbracket",0x8a9; -"botrightsqbracket",0x8aa; -"topleftparens",0x8ab; -"botleftparens",0x8ac; -"toprightparens",0x8ad; -"botrightparens",0x8ae; -"leftmiddlecurlybrace",0x8af; -"rightmiddlecurlybrace",0x8b0; -"topleftsummation",0x8b1; -"botleftsummation",0x8b2; -"topvertsummationconnector",0x8b3; -"botvertsummationconnector",0x8b4; -"toprightsummation",0x8b5; -"botrightsummation",0x8b6; -"rightmiddlesummation",0x8b7; -"lessthanequal",0x8bc; -"notequal",0x8bd; -"greaterthanequal",0x8be; -"integral",0x8bf; -"therefore",0x8c0; -"variation",0x8c1; -"infinity",0x8c2; -"nabla",0x8c5; -"approximate",0x8c8; -"similarequal",0x8c9; -"ifonlyif",0x8cd; -"implies",0x8ce; -"identical",0x8cf; -"radical",0x8d6; -"includedin",0x8da; -"includes",0x8db; -"intersection",0x8dc; -"union",0x8dd; -"logicaland",0x8de; -"logicalor",0x8df; -"partialderivative",0x8ef; -"function",0x8f6; -"leftarrow",0x8fb; -"uparrow",0x8fc; -"rightarrow",0x8fd; -"downarrow",0x8fe; -"blank",0x9df; -"soliddiamond",0x9e0; -"checkerboard",0x9e1; -"ht",0x9e2; -"ff",0x9e3; -"cr",0x9e4; -"lf",0x9e5; -"nl",0x9e8; -"vt",0x9e9; -"lowrightcorner",0x9ea; -"uprightcorner",0x9eb; -"upleftcorner",0x9ec; -"lowleftcorner",0x9ed; -"crossinglines",0x9ee; -"horizlinescan1",0x9ef; -"horizlinescan3",0x9f0; -"horizlinescan5",0x9f1; -"horizlinescan7",0x9f2; -"horizlinescan9",0x9f3; -"leftt",0x9f4; -"rightt",0x9f5; -"bott",0x9f6; -"topt",0x9f7; -"vertbar",0x9f8; -"emspace",0xaa1; -"enspace",0xaa2; -"em3space",0xaa3; -"em4space",0xaa4; -"digitspace",0xaa5; -"punctspace",0xaa6; -"thinspace",0xaa7; -"hairspace",0xaa8; -"emdash",0xaa9; -"endash",0xaaa; -"signifblank",0xaac; -"ellipsis",0xaae; -"doubbaselinedot",0xaaf; -"onethird",0xab0; -"twothirds",0xab1; -"onefifth",0xab2; -"twofifths",0xab3; -"threefifths",0xab4; -"fourfifths",0xab5; -"onesixth",0xab6; -"fivesixths",0xab7; -"careof",0xab8; -"figdash",0xabb; -"leftanglebracket",0xabc; -"decimalpoint",0xabd; -"rightanglebracket",0xabe; -"marker",0xabf; -"oneeighth",0xac3; -"threeeighths",0xac4; -"fiveeighths",0xac5; -"seveneighths",0xac6; -"trademark",0xac9; -"signaturemark",0xaca; -"trademarkincircle",0xacb; -"leftopentriangle",0xacc; -"rightopentriangle",0xacd; -"emopencircle",0xace; -"emopenrectangle",0xacf; -"leftsinglequotemark",0xad0; -"rightsinglequotemark",0xad1; -"leftdoublequotemark",0xad2; -"rightdoublequotemark",0xad3; -"prescription",0xad4; -"minutes",0xad6; -"seconds",0xad7; -"latincross",0xad9; -"hexagram",0xada; -"filledrectbullet",0xadb; -"filledlefttribullet",0xadc; -"filledrighttribullet",0xadd; -"emfilledcircle",0xade; -"emfilledrect",0xadf; -"enopencircbullet",0xae0; -"enopensquarebullet",0xae1; -"openrectbullet",0xae2; -"opentribulletup",0xae3; -"opentribulletdown",0xae4; -"openstar",0xae5; -"enfilledcircbullet",0xae6; -"enfilledsqbullet",0xae7; -"filledtribulletup",0xae8; -"filledtribulletdown",0xae9; -"leftpointer",0xaea; -"rightpointer",0xaeb; -"club",0xaec; -"diamond",0xaed; -"heart",0xaee; -"maltesecross",0xaf0; -"dagger",0xaf1; -"doubledagger",0xaf2; -"checkmark",0xaf3; -"ballotcross",0xaf4; -"musicalsharp",0xaf5; -"musicalflat",0xaf6; -"malesymbol",0xaf7; -"femalesymbol",0xaf8; -"telephone",0xaf9; -"telephonerecorder",0xafa; -"phonographcopyright",0xafb; -"caret",0xafc; -"singlelowquotemark",0xafd; -"doublelowquotemark",0xafe; -"cursor",0xaff; -"leftcaret",0xba3; -"rightcaret",0xba6; -"downcaret",0xba8; -"upcaret",0xba9; -"overbar",0xbc0; -"downtack",0xbc2; -"upshoe",0xbc3; -"downstile",0xbc4; -"underbar",0xbc6; -"jot",0xbca; -"quad",0xbcc; -"uptack",0xbce; -"circle",0xbcf; -"upstile",0xbd3; -"downshoe",0xbd6; -"rightshoe",0xbd8; -"leftshoe",0xbda; -"lefttack",0xbdc; -"righttack",0xbfc; -"hebrew_doublelowline",0xcdf; -"hebrew_aleph",0xce0; -"hebrew_bet",0xce1; -"hebrew_beth",0xce1; -"hebrew_gimel",0xce2; -"hebrew_gimmel",0xce2; -"hebrew_dalet",0xce3; -"hebrew_daleth",0xce3; -"hebrew_he",0xce4; -"hebrew_waw",0xce5; -"hebrew_zain",0xce6; -"hebrew_zayin",0xce6; -"hebrew_chet",0xce7; -"hebrew_het",0xce7; -"hebrew_tet",0xce8; -"hebrew_teth",0xce8; -"hebrew_yod",0xce9; -"hebrew_finalkaph",0xcea; -"hebrew_kaph",0xceb; -"hebrew_lamed",0xcec; -"hebrew_finalmem",0xced; -"hebrew_mem",0xcee; -"hebrew_finalnun",0xcef; -"hebrew_nun",0xcf0; -"hebrew_samech",0xcf1; -"hebrew_samekh",0xcf1; -"hebrew_ayin",0xcf2; -"hebrew_finalpe",0xcf3; -"hebrew_pe",0xcf4; -"hebrew_finalzade",0xcf5; -"hebrew_finalzadi",0xcf5; -"hebrew_zade",0xcf6; -"hebrew_zadi",0xcf6; -"hebrew_qoph",0xcf7; -"hebrew_kuf",0xcf7; -"hebrew_resh",0xcf8; -"hebrew_shin",0xcf9; -"hebrew_taw",0xcfa; -"hebrew_taf",0xcfa; -"Hebrew_switch",0xFF7E; -"Thai_kokai",0xda1; -"Thai_khokhai",0xda2; -"Thai_khokhuat",0xda3; -"Thai_khokhwai",0xda4; -"Thai_khokhon",0xda5; -"Thai_khorakhang",0xda6; -"Thai_ngongu",0xda7; -"Thai_chochan",0xda8; -"Thai_choching",0xda9; -"Thai_chochang",0xdaa; -"Thai_soso",0xdab; -"Thai_chochoe",0xdac; -"Thai_yoying",0xdad; -"Thai_dochada",0xdae; -"Thai_topatak",0xdaf; -"Thai_thothan",0xdb0; -"Thai_thonangmontho",0xdb1; -"Thai_thophuthao",0xdb2; -"Thai_nonen",0xdb3; -"Thai_dodek",0xdb4; -"Thai_totao",0xdb5; -"Thai_thothung",0xdb6; -"Thai_thothahan",0xdb7; -"Thai_thothong",0xdb8; -"Thai_nonu",0xdb9; -"Thai_bobaimai",0xdba; -"Thai_popla",0xdbb; -"Thai_phophung",0xdbc; -"Thai_fofa",0xdbd; -"Thai_phophan",0xdbe; -"Thai_fofan",0xdbf; -"Thai_phosamphao",0xdc0; -"Thai_moma",0xdc1; -"Thai_yoyak",0xdc2; -"Thai_rorua",0xdc3; -"Thai_ru",0xdc4; -"Thai_loling",0xdc5; -"Thai_lu",0xdc6; -"Thai_wowaen",0xdc7; -"Thai_sosala",0xdc8; -"Thai_sorusi",0xdc9; -"Thai_sosua",0xdca; -"Thai_hohip",0xdcb; -"Thai_lochula",0xdcc; -"Thai_oang",0xdcd; -"Thai_honokhuk",0xdce; -"Thai_paiyannoi",0xdcf; -"Thai_saraa",0xdd0; -"Thai_maihanakat",0xdd1; -"Thai_saraaa",0xdd2; -"Thai_saraam",0xdd3; -"Thai_sarai",0xdd4; -"Thai_saraii",0xdd5; -"Thai_saraue",0xdd6; -"Thai_sarauee",0xdd7; -"Thai_sarau",0xdd8; -"Thai_sarauu",0xdd9; -"Thai_phinthu",0xdda; -"Thai_maihanakat_maitho",0xdde; -"Thai_baht",0xddf; -"Thai_sarae",0xde0; -"Thai_saraae",0xde1; -"Thai_sarao",0xde2; -"Thai_saraaimaimuan",0xde3; -"Thai_saraaimaimalai",0xde4; -"Thai_lakkhangyao",0xde5; -"Thai_maiyamok",0xde6; -"Thai_maitaikhu",0xde7; -"Thai_maiek",0xde8; -"Thai_maitho",0xde9; -"Thai_maitri",0xdea; -"Thai_maichattawa",0xdeb; -"Thai_thanthakhat",0xdec; -"Thai_nikhahit",0xded; -"Thai_leksun",0xdf0; -"Thai_leknung",0xdf1; -"Thai_leksong",0xdf2; -"Thai_leksam",0xdf3; -"Thai_leksi",0xdf4; -"Thai_lekha",0xdf5; -"Thai_lekhok",0xdf6; -"Thai_lekchet",0xdf7; -"Thai_lekpaet",0xdf8; -"Thai_lekkao",0xdf9; -"Hangul",0xff31; -"Hangul_Start",0xff32; -"Hangul_End",0xff33; -"Hangul_Hanja",0xff34; -"Hangul_Jamo",0xff35; -"Hangul_Romaja",0xff36; -"Hangul_Codeinput",0xff37; -"Hangul_Jeonja",0xff38; -"Hangul_Banja",0xff39; -"Hangul_PreHanja",0xff3a; -"Hangul_PostHanja",0xff3b; -"Hangul_SingleCandidate",0xff3c; -"Hangul_MultipleCandidate",0xff3d; -"Hangul_PreviousCandidate",0xff3e; -"Hangul_Special",0xff3f; -"Hangul_switch",0xFF7E; -"Hangul_Kiyeog",0xea1; -"Hangul_SsangKiyeog",0xea2; -"Hangul_KiyeogSios",0xea3; -"Hangul_Nieun",0xea4; -"Hangul_NieunJieuj",0xea5; -"Hangul_NieunHieuh",0xea6; -"Hangul_Dikeud",0xea7; -"Hangul_SsangDikeud",0xea8; -"Hangul_Rieul",0xea9; -"Hangul_RieulKiyeog",0xeaa; -"Hangul_RieulMieum",0xeab; -"Hangul_RieulPieub",0xeac; -"Hangul_RieulSios",0xead; -"Hangul_RieulTieut",0xeae; -"Hangul_RieulPhieuf",0xeaf; -"Hangul_RieulHieuh",0xeb0; -"Hangul_Mieum",0xeb1; -"Hangul_Pieub",0xeb2; -"Hangul_SsangPieub",0xeb3; -"Hangul_PieubSios",0xeb4; -"Hangul_Sios",0xeb5; -"Hangul_SsangSios",0xeb6; -"Hangul_Ieung",0xeb7; -"Hangul_Jieuj",0xeb8; -"Hangul_SsangJieuj",0xeb9; -"Hangul_Cieuc",0xeba; -"Hangul_Khieuq",0xebb; -"Hangul_Tieut",0xebc; -"Hangul_Phieuf",0xebd; -"Hangul_Hieuh",0xebe; -"Hangul_A",0xebf; -"Hangul_AE",0xec0; -"Hangul_YA",0xec1; -"Hangul_YAE",0xec2; -"Hangul_EO",0xec3; -"Hangul_E",0xec4; -"Hangul_YEO",0xec5; -"Hangul_YE",0xec6; -"Hangul_O",0xec7; -"Hangul_WA",0xec8; -"Hangul_WAE",0xec9; -"Hangul_OE",0xeca; -"Hangul_YO",0xecb; -"Hangul_U",0xecc; -"Hangul_WEO",0xecd; -"Hangul_WE",0xece; -"Hangul_WI",0xecf; -"Hangul_YU",0xed0; -"Hangul_EU",0xed1; -"Hangul_YI",0xed2; -"Hangul_I",0xed3; -"Hangul_J_Kiyeog",0xed4; -"Hangul_J_SsangKiyeog",0xed5; -"Hangul_J_KiyeogSios",0xed6; -"Hangul_J_Nieun",0xed7; -"Hangul_J_NieunJieuj",0xed8; -"Hangul_J_NieunHieuh",0xed9; -"Hangul_J_Dikeud",0xeda; -"Hangul_J_Rieul",0xedb; -"Hangul_J_RieulKiyeog",0xedc; -"Hangul_J_RieulMieum",0xedd; -"Hangul_J_RieulPieub",0xede; -"Hangul_J_RieulSios",0xedf; -"Hangul_J_RieulTieut",0xee0; -"Hangul_J_RieulPhieuf",0xee1; -"Hangul_J_RieulHieuh",0xee2; -"Hangul_J_Mieum",0xee3; -"Hangul_J_Pieub",0xee4; -"Hangul_J_PieubSios",0xee5; -"Hangul_J_Sios",0xee6; -"Hangul_J_SsangSios",0xee7; -"Hangul_J_Ieung",0xee8; -"Hangul_J_Jieuj",0xee9; -"Hangul_J_Cieuc",0xeea; -"Hangul_J_Khieuq",0xeeb; -"Hangul_J_Tieut",0xeec; -"Hangul_J_Phieuf",0xeed; -"Hangul_J_Hieuh",0xeee; -"Hangul_RieulYeorinHieuh",0xeef; -"Hangul_SunkyeongeumMieum",0xef0; -"Hangul_SunkyeongeumPieub",0xef1; -"Hangul_PanSios",0xef2; -"Hangul_KkogjiDalrinIeung",0xef3; -"Hangul_SunkyeongeumPhieuf",0xef4; -"Hangul_YeorinHieuh",0xef5; -"Hangul_AraeA",0xef6; -"Hangul_AraeAE",0xef7; -"Hangul_J_PanSios",0xef8; -"Hangul_J_KkogjiDalrinIeung",0xef9; -"Hangul_J_YeorinHieuh",0xefa; -"Korean_Won",0xeff; -] -let keysym_to_name = [ -0xFFFFFF,"VoidSymbol"; -0xFF08,"BackSpace"; -0xFF09,"Tab"; -0xFF0A,"Linefeed"; -0xFF0B,"Clear"; -0xFF0D,"Return"; -0xFF13,"Pause"; -0xFF14,"Scroll_Lock"; -0xFF15,"Sys_Req"; -0xFF1B,"Escape"; -0xFFFF,"Delete"; -0xFF20,"Multi_key"; -0xFF21,"Kanji"; -0xFF22,"Muhenkan"; -0xFF23,"Henkan_Mode"; -0xFF23,"Henkan"; -0xFF24,"Romaji"; -0xFF25,"Hiragana"; -0xFF26,"Katakana"; -0xFF27,"Hiragana_Katakana"; -0xFF28,"Zenkaku"; -0xFF29,"Hankaku"; -0xFF2A,"Zenkaku_Hankaku"; -0xFF2B,"Touroku"; -0xFF2C,"Massyo"; -0xFF2D,"Kana_Lock"; -0xFF2E,"Kana_Shift"; -0xFF2F,"Eisu_Shift"; -0xFF30,"Eisu_toggle"; -0xFF50,"Home"; -0xFF51,"Left"; -0xFF52,"Up"; -0xFF53,"Right"; -0xFF54,"Down"; -0xFF55,"Prior"; -0xFF55,"Page_Up"; -0xFF56,"Next"; -0xFF56,"Page_Down"; -0xFF57,"End"; -0xFF58,"Begin"; -0xFF60,"Select"; -0xFF61,"Print"; -0xFF62,"Execute"; -0xFF63,"Insert"; -0xFF65,"Undo"; -0xFF66,"Redo"; -0xFF67,"Menu"; -0xFF68,"Find"; -0xFF69,"Cancel"; -0xFF6A,"Help"; -0xFF6B,"Break"; -0xFF7E,"Mode_switch"; -0xFF7E,"script_switch"; -0xFF7F,"Num_Lock"; -0xFF80,"KP_Space"; -0xFF89,"KP_Tab"; -0xFF8D,"KP_Enter"; -0xFF91,"KP_F1"; -0xFF92,"KP_F2"; -0xFF93,"KP_F3"; -0xFF94,"KP_F4"; -0xFF95,"KP_Home"; -0xFF96,"KP_Left"; -0xFF97,"KP_Up"; -0xFF98,"KP_Right"; -0xFF99,"KP_Down"; -0xFF9A,"KP_Prior"; -0xFF9A,"KP_Page_Up"; -0xFF9B,"KP_Next"; -0xFF9B,"KP_Page_Down"; -0xFF9C,"KP_End"; -0xFF9D,"KP_Begin"; -0xFF9E,"KP_Insert"; -0xFF9F,"KP_Delete"; -0xFFBD,"KP_Equal"; -0xFFAA,"KP_Multiply"; -0xFFAB,"KP_Add"; -0xFFAC,"KP_Separator"; -0xFFAD,"KP_Subtract"; -0xFFAE,"KP_Decimal"; -0xFFAF,"KP_Divide"; -0xFFB0,"KP_0"; -0xFFB1,"KP_1"; -0xFFB2,"KP_2"; -0xFFB3,"KP_3"; -0xFFB4,"KP_4"; -0xFFB5,"KP_5"; -0xFFB6,"KP_6"; -0xFFB7,"KP_7"; -0xFFB8,"KP_8"; -0xFFB9,"KP_9"; -0xFFBE,"F1"; -0xFFBF,"F2"; -0xFFC0,"F3"; -0xFFC1,"F4"; -0xFFC2,"F5"; -0xFFC3,"F6"; -0xFFC4,"F7"; -0xFFC5,"F8"; -0xFFC6,"F9"; -0xFFC7,"F10"; -0xFFC8,"F11"; -0xFFC8,"L1"; -0xFFC9,"F12"; -0xFFC9,"L2"; -0xFFCA,"F13"; -0xFFCA,"L3"; -0xFFCB,"F14"; -0xFFCB,"L4"; -0xFFCC,"F15"; -0xFFCC,"L5"; -0xFFCD,"F16"; -0xFFCD,"L6"; -0xFFCE,"F17"; -0xFFCE,"L7"; -0xFFCF,"F18"; -0xFFCF,"L8"; -0xFFD0,"F19"; -0xFFD0,"L9"; -0xFFD1,"F20"; -0xFFD1,"L10"; -0xFFD2,"F21"; -0xFFD2,"R1"; -0xFFD3,"F22"; -0xFFD3,"R2"; -0xFFD4,"F23"; -0xFFD4,"R3"; -0xFFD5,"F24"; -0xFFD5,"R4"; -0xFFD6,"F25"; -0xFFD6,"R5"; -0xFFD7,"F26"; -0xFFD7,"R6"; -0xFFD8,"F27"; -0xFFD8,"R7"; -0xFFD9,"F28"; -0xFFD9,"R8"; -0xFFDA,"F29"; -0xFFDA,"R9"; -0xFFDB,"F30"; -0xFFDB,"R10"; -0xFFDC,"F31"; -0xFFDC,"R11"; -0xFFDD,"F32"; -0xFFDD,"R12"; -0xFFDE,"F33"; -0xFFDE,"R13"; -0xFFDF,"F34"; -0xFFDF,"R14"; -0xFFE0,"F35"; -0xFFE0,"R15"; -0xFFE1,"Shift_L"; -0xFFE2,"Shift_R"; -0xFFE3,"Control_L"; -0xFFE4,"Control_R"; -0xFFE5,"Caps_Lock"; -0xFFE6,"Shift_Lock"; -0xFFE7,"Meta_L"; -0xFFE8,"Meta_R"; -0xFFE9,"Alt_L"; -0xFFEA,"Alt_R"; -0xFFEB,"Super_L"; -0xFFEC,"Super_R"; -0xFFED,"Hyper_L"; -0xFFEE,"Hyper_R"; -0xFE01,"ISO_Lock"; -0xFE02,"ISO_Level2_Latch"; -0xFE03,"ISO_Level3_Shift"; -0xFE04,"ISO_Level3_Latch"; -0xFE05,"ISO_Level3_Lock"; -0xFF7E,"ISO_Group_Shift"; -0xFE06,"ISO_Group_Latch"; -0xFE07,"ISO_Group_Lock"; -0xFE08,"ISO_Next_Group"; -0xFE09,"ISO_Next_Group_Lock"; -0xFE0A,"ISO_Prev_Group"; -0xFE0B,"ISO_Prev_Group_Lock"; -0xFE0C,"ISO_First_Group"; -0xFE0D,"ISO_First_Group_Lock"; -0xFE0E,"ISO_Last_Group"; -0xFE0F,"ISO_Last_Group_Lock"; -0xFE20,"ISO_Left_Tab"; -0xFE21,"ISO_Move_Line_Up"; -0xFE22,"ISO_Move_Line_Down"; -0xFE23,"ISO_Partial_Line_Up"; -0xFE24,"ISO_Partial_Line_Down"; -0xFE25,"ISO_Partial_Space_Left"; -0xFE26,"ISO_Partial_Space_Right"; -0xFE27,"ISO_Set_Margin_Left"; -0xFE28,"ISO_Set_Margin_Right"; -0xFE29,"ISO_Release_Margin_Left"; -0xFE2A,"ISO_Release_Margin_Right"; -0xFE2B,"ISO_Release_Both_Margins"; -0xFE2C,"ISO_Fast_Cursor_Left"; -0xFE2D,"ISO_Fast_Cursor_Right"; -0xFE2E,"ISO_Fast_Cursor_Up"; -0xFE2F,"ISO_Fast_Cursor_Down"; -0xFE30,"ISO_Continuous_Underline"; -0xFE31,"ISO_Discontinuous_Underline"; -0xFE32,"ISO_Emphasize"; -0xFE33,"ISO_Center_Object"; -0xFE34,"ISO_Enter"; -0xFE50,"dead_grave"; -0xFE51,"dead_acute"; -0xFE52,"dead_circumflex"; -0xFE53,"dead_tilde"; -0xFE54,"dead_macron"; -0xFE55,"dead_breve"; -0xFE56,"dead_abovedot"; -0xFE57,"dead_diaeresis"; -0xFE58,"dead_abovering"; -0xFE59,"dead_doubleacute"; -0xFE5A,"dead_caron"; -0xFE5B,"dead_cedilla"; -0xFE5C,"dead_ogonek"; -0xFE5D,"dead_iota"; -0xFE5E,"dead_voiced_sound"; -0xFE5F,"dead_semivoiced_sound"; -0xFE60,"dead_belowdot"; -0xFED0,"First_Virtual_Screen"; -0xFED1,"Prev_Virtual_Screen"; -0xFED2,"Next_Virtual_Screen"; -0xFED4,"Last_Virtual_Screen"; -0xFED5,"Terminate_Server"; -0xFE70,"AccessX_Enable"; -0xFE71,"AccessX_Feedback_Enable"; -0xFE72,"RepeatKeys_Enable"; -0xFE73,"SlowKeys_Enable"; -0xFE74,"BounceKeys_Enable"; -0xFE75,"StickyKeys_Enable"; -0xFE76,"MouseKeys_Enable"; -0xFE77,"MouseKeys_Accel_Enable"; -0xFE78,"Overlay1_Enable"; -0xFE79,"Overlay2_Enable"; -0xFE7A,"AudibleBell_Enable"; -0xFEE0,"Pointer_Left"; -0xFEE1,"Pointer_Right"; -0xFEE2,"Pointer_Up"; -0xFEE3,"Pointer_Down"; -0xFEE4,"Pointer_UpLeft"; -0xFEE5,"Pointer_UpRight"; -0xFEE6,"Pointer_DownLeft"; -0xFEE7,"Pointer_DownRight"; -0xFEE8,"Pointer_Button_Dflt"; -0xFEE9,"Pointer_Button1"; -0xFEEA,"Pointer_Button2"; -0xFEEB,"Pointer_Button3"; -0xFEEC,"Pointer_Button4"; -0xFEED,"Pointer_Button5"; -0xFEEE,"Pointer_DblClick_Dflt"; -0xFEEF,"Pointer_DblClick1"; -0xFEF0,"Pointer_DblClick2"; -0xFEF1,"Pointer_DblClick3"; -0xFEF2,"Pointer_DblClick4"; -0xFEF3,"Pointer_DblClick5"; -0xFEF4,"Pointer_Drag_Dflt"; -0xFEF5,"Pointer_Drag1"; -0xFEF6,"Pointer_Drag2"; -0xFEF7,"Pointer_Drag3"; -0xFEF8,"Pointer_Drag4"; -0xFEFD,"Pointer_Drag5"; -0xFEF9,"Pointer_EnableKeys"; -0xFEFA,"Pointer_Accelerate"; -0xFEFB,"Pointer_DfltBtnNext"; -0xFEFC,"Pointer_DfltBtnPrev"; -0xFD01,"3270_Duplicate"; -0xFD02,"3270_FieldMark"; -0xFD03,"3270_Right2"; -0xFD04,"3270_Left2"; -0xFD05,"3270_BackTab"; -0xFD06,"3270_EraseEOF"; -0xFD07,"3270_EraseInput"; -0xFD08,"3270_Reset"; -0xFD09,"3270_Quit"; -0xFD0A,"3270_PA1"; -0xFD0B,"3270_PA2"; -0xFD0C,"3270_PA3"; -0xFD0D,"3270_Test"; -0xFD0E,"3270_Attn"; -0xFD0F,"3270_CursorBlink"; -0xFD10,"3270_AltCursor"; -0xFD11,"3270_KeyClick"; -0xFD12,"3270_Jump"; -0xFD13,"3270_Ident"; -0xFD14,"3270_Rule"; -0xFD15,"3270_Copy"; -0xFD16,"3270_Play"; -0xFD17,"3270_Setup"; -0xFD18,"3270_Record"; -0xFD19,"3270_ChangeScreen"; -0xFD1A,"3270_DeleteWord"; -0xFD1B,"3270_ExSelect"; -0xFD1C,"3270_CursorSelect"; -0xFD1D,"3270_PrintScreen"; -0xFD1E,"3270_Enter"; -0x020,"space"; -0x021,"exclam"; -0x022,"quotedbl"; -0x023,"numbersign"; -0x024,"dollar"; -0x025,"percent"; -0x026,"ampersand"; -0x027,"apostrophe"; -0x027,"quoteright"; -0x028,"parenleft"; -0x029,"parenright"; -0x02a,"asterisk"; -0x02b,"plus"; -0x02c,"comma"; -0x02d,"minus"; -0x02e,"period"; -0x02f,"slash"; -0x030,"0"; -0x031,"1"; -0x032,"2"; -0x033,"3"; -0x034,"4"; -0x035,"5"; -0x036,"6"; -0x037,"7"; -0x038,"8"; -0x039,"9"; -0x03a,"colon"; -0x03b,"semicolon"; -0x03c,"less"; -0x03d,"equal"; -0x03e,"greater"; -0x03f,"question"; -0x040,"at"; -0x041,"A"; -0x042,"B"; -0x043,"C"; -0x044,"D"; -0x045,"E"; -0x046,"F"; -0x047,"G"; -0x048,"H"; -0x049,"I"; -0x04a,"J"; -0x04b,"K"; -0x04c,"L"; -0x04d,"M"; -0x04e,"N"; -0x04f,"O"; -0x050,"P"; -0x051,"Q"; -0x052,"R"; -0x053,"S"; -0x054,"T"; -0x055,"U"; -0x056,"V"; -0x057,"W"; -0x058,"X"; -0x059,"Y"; -0x05a,"Z"; -0x05b,"bracketleft"; -0x05c,"backslash"; -0x05d,"bracketright"; -0x05e,"asciicircum"; -0x05f,"underscore"; -0x060,"grave"; -0x060,"quoteleft"; -0x061,"a"; -0x062,"b"; -0x063,"c"; -0x064,"d"; -0x065,"e"; -0x066,"f"; -0x067,"g"; -0x068,"h"; -0x069,"i"; -0x06a,"j"; -0x06b,"k"; -0x06c,"l"; -0x06d,"m"; -0x06e,"n"; -0x06f,"o"; -0x070,"p"; -0x071,"q"; -0x072,"r"; -0x073,"s"; -0x074,"t"; -0x075,"u"; -0x076,"v"; -0x077,"w"; -0x078,"x"; -0x079,"y"; -0x07a,"z"; -0x07b,"braceleft"; -0x07c,"bar"; -0x07d,"braceright"; -0x07e,"asciitilde"; -0x0a0,"nobreakspace"; -0x0a1,"exclamdown"; -0x0a2,"cent"; -0x0a3,"sterling"; -0x0a4,"currency"; -0x0a5,"yen"; -0x0a6,"brokenbar"; -0x0a7,"section"; -0x0a8,"diaeresis"; -0x0a9,"copyright"; -0x0aa,"ordfeminine"; -0x0ab,"guillemotleft"; -0x0ac,"notsign"; -0x0ad,"hyphen"; -0x0ae,"registered"; -0x0af,"macron"; -0x0b0,"degree"; -0x0b1,"plusminus"; -0x0b2,"twosuperior"; -0x0b3,"threesuperior"; -0x0b4,"acute"; -0x0b5,"mu"; -0x0b6,"paragraph"; -0x0b7,"periodcentered"; -0x0b8,"cedilla"; -0x0b9,"onesuperior"; -0x0ba,"masculine"; -0x0bb,"guillemotright"; -0x0bc,"onequarter"; -0x0bd,"onehalf"; -0x0be,"threequarters"; -0x0bf,"questiondown"; -0x0c0,"Agrave"; -0x0c1,"Aacute"; -0x0c2,"Acircumflex"; -0x0c3,"Atilde"; -0x0c4,"Adiaeresis"; -0x0c5,"Aring"; -0x0c6,"AE"; -0x0c7,"Ccedilla"; -0x0c8,"Egrave"; -0x0c9,"Eacute"; -0x0ca,"Ecircumflex"; -0x0cb,"Ediaeresis"; -0x0cc,"Igrave"; -0x0cd,"Iacute"; -0x0ce,"Icircumflex"; -0x0cf,"Idiaeresis"; -0x0d0,"ETH"; -0x0d0,"Eth"; -0x0d1,"Ntilde"; -0x0d2,"Ograve"; -0x0d3,"Oacute"; -0x0d4,"Ocircumflex"; -0x0d5,"Otilde"; -0x0d6,"Odiaeresis"; -0x0d7,"multiply"; -0x0d8,"Ooblique"; -0x0d9,"Ugrave"; -0x0da,"Uacute"; -0x0db,"Ucircumflex"; -0x0dc,"Udiaeresis"; -0x0dd,"Yacute"; -0x0de,"THORN"; -0x0de,"Thorn"; -0x0df,"ssharp"; -0x0e0,"agrave"; -0x0e1,"aacute"; -0x0e2,"acircumflex"; -0x0e3,"atilde"; -0x0e4,"adiaeresis"; -0x0e5,"aring"; -0x0e6,"ae"; -0x0e7,"ccedilla"; -0x0e8,"egrave"; -0x0e9,"eacute"; -0x0ea,"ecircumflex"; -0x0eb,"ediaeresis"; -0x0ec,"igrave"; -0x0ed,"iacute"; -0x0ee,"icircumflex"; -0x0ef,"idiaeresis"; -0x0f0,"eth"; -0x0f1,"ntilde"; -0x0f2,"ograve"; -0x0f3,"oacute"; -0x0f4,"ocircumflex"; -0x0f5,"otilde"; -0x0f6,"odiaeresis"; -0x0f7,"division"; -0x0f8,"oslash"; -0x0f9,"ugrave"; -0x0fa,"uacute"; -0x0fb,"ucircumflex"; -0x0fc,"udiaeresis"; -0x0fd,"yacute"; -0x0fe,"thorn"; -0x0ff,"ydiaeresis"; -0x1a1,"Aogonek"; -0x1a2,"breve"; -0x1a3,"Lstroke"; -0x1a5,"Lcaron"; -0x1a6,"Sacute"; -0x1a9,"Scaron"; -0x1aa,"Scedilla"; -0x1ab,"Tcaron"; -0x1ac,"Zacute"; -0x1ae,"Zcaron"; -0x1af,"Zabovedot"; -0x1b1,"aogonek"; -0x1b2,"ogonek"; -0x1b3,"lstroke"; -0x1b5,"lcaron"; -0x1b6,"sacute"; -0x1b7,"caron"; -0x1b9,"scaron"; -0x1ba,"scedilla"; -0x1bb,"tcaron"; -0x1bc,"zacute"; -0x1bd,"doubleacute"; -0x1be,"zcaron"; -0x1bf,"zabovedot"; -0x1c0,"Racute"; -0x1c3,"Abreve"; -0x1c5,"Lacute"; -0x1c6,"Cacute"; -0x1c8,"Ccaron"; -0x1ca,"Eogonek"; -0x1cc,"Ecaron"; -0x1cf,"Dcaron"; -0x1d0,"Dstroke"; -0x1d1,"Nacute"; -0x1d2,"Ncaron"; -0x1d5,"Odoubleacute"; -0x1d8,"Rcaron"; -0x1d9,"Uring"; -0x1db,"Udoubleacute"; -0x1de,"Tcedilla"; -0x1e0,"racute"; -0x1e3,"abreve"; -0x1e5,"lacute"; -0x1e6,"cacute"; -0x1e8,"ccaron"; -0x1ea,"eogonek"; -0x1ec,"ecaron"; -0x1ef,"dcaron"; -0x1f0,"dstroke"; -0x1f1,"nacute"; -0x1f2,"ncaron"; -0x1f5,"odoubleacute"; -0x1fb,"udoubleacute"; -0x1f8,"rcaron"; -0x1f9,"uring"; -0x1fe,"tcedilla"; -0x1ff,"abovedot"; -0x2a1,"Hstroke"; -0x2a6,"Hcircumflex"; -0x2a9,"Iabovedot"; -0x2ab,"Gbreve"; -0x2ac,"Jcircumflex"; -0x2b1,"hstroke"; -0x2b6,"hcircumflex"; -0x2b9,"idotless"; -0x2bb,"gbreve"; -0x2bc,"jcircumflex"; -0x2c5,"Cabovedot"; -0x2c6,"Ccircumflex"; -0x2d5,"Gabovedot"; -0x2d8,"Gcircumflex"; -0x2dd,"Ubreve"; -0x2de,"Scircumflex"; -0x2e5,"cabovedot"; -0x2e6,"ccircumflex"; -0x2f5,"gabovedot"; -0x2f8,"gcircumflex"; -0x2fd,"ubreve"; -0x2fe,"scircumflex"; -0x3a2,"kra"; -0x3a2,"kappa"; -0x3a3,"Rcedilla"; -0x3a5,"Itilde"; -0x3a6,"Lcedilla"; -0x3aa,"Emacron"; -0x3ab,"Gcedilla"; -0x3ac,"Tslash"; -0x3b3,"rcedilla"; -0x3b5,"itilde"; -0x3b6,"lcedilla"; -0x3ba,"emacron"; -0x3bb,"gcedilla"; -0x3bc,"tslash"; -0x3bd,"ENG"; -0x3bf,"eng"; -0x3c0,"Amacron"; -0x3c7,"Iogonek"; -0x3cc,"Eabovedot"; -0x3cf,"Imacron"; -0x3d1,"Ncedilla"; -0x3d2,"Omacron"; -0x3d3,"Kcedilla"; -0x3d9,"Uogonek"; -0x3dd,"Utilde"; -0x3de,"Umacron"; -0x3e0,"amacron"; -0x3e7,"iogonek"; -0x3ec,"eabovedot"; -0x3ef,"imacron"; -0x3f1,"ncedilla"; -0x3f2,"omacron"; -0x3f3,"kcedilla"; -0x3f9,"uogonek"; -0x3fd,"utilde"; -0x3fe,"umacron"; -0x47e,"overline"; -0x4a1,"kana_fullstop"; -0x4a2,"kana_openingbracket"; -0x4a3,"kana_closingbracket"; -0x4a4,"kana_comma"; -0x4a5,"kana_conjunctive"; -0x4a5,"kana_middledot"; -0x4a6,"kana_WO"; -0x4a7,"kana_a"; -0x4a8,"kana_i"; -0x4a9,"kana_u"; -0x4aa,"kana_e"; -0x4ab,"kana_o"; -0x4ac,"kana_ya"; -0x4ad,"kana_yu"; -0x4ae,"kana_yo"; -0x4af,"kana_tsu"; -0x4af,"kana_tu"; -0x4b0,"prolongedsound"; -0x4b1,"kana_A"; -0x4b2,"kana_I"; -0x4b3,"kana_U"; -0x4b4,"kana_E"; -0x4b5,"kana_O"; -0x4b6,"kana_KA"; -0x4b7,"kana_KI"; -0x4b8,"kana_KU"; -0x4b9,"kana_KE"; -0x4ba,"kana_KO"; -0x4bb,"kana_SA"; -0x4bc,"kana_SHI"; -0x4bd,"kana_SU"; -0x4be,"kana_SE"; -0x4bf,"kana_SO"; -0x4c0,"kana_TA"; -0x4c1,"kana_CHI"; -0x4c1,"kana_TI"; -0x4c2,"kana_TSU"; -0x4c2,"kana_TU"; -0x4c3,"kana_TE"; -0x4c4,"kana_TO"; -0x4c5,"kana_NA"; -0x4c6,"kana_NI"; -0x4c7,"kana_NU"; -0x4c8,"kana_NE"; -0x4c9,"kana_NO"; -0x4ca,"kana_HA"; -0x4cb,"kana_HI"; -0x4cc,"kana_FU"; -0x4cc,"kana_HU"; -0x4cd,"kana_HE"; -0x4ce,"kana_HO"; -0x4cf,"kana_MA"; -0x4d0,"kana_MI"; -0x4d1,"kana_MU"; -0x4d2,"kana_ME"; -0x4d3,"kana_MO"; -0x4d4,"kana_YA"; -0x4d5,"kana_YU"; -0x4d6,"kana_YO"; -0x4d7,"kana_RA"; -0x4d8,"kana_RI"; -0x4d9,"kana_RU"; -0x4da,"kana_RE"; -0x4db,"kana_RO"; -0x4dc,"kana_WA"; -0x4dd,"kana_N"; -0x4de,"voicedsound"; -0x4df,"semivoicedsound"; -0xFF7E,"kana_switch"; -0x5ac,"Arabic_comma"; -0x5bb,"Arabic_semicolon"; -0x5bf,"Arabic_question_mark"; -0x5c1,"Arabic_hamza"; -0x5c2,"Arabic_maddaonalef"; -0x5c3,"Arabic_hamzaonalef"; -0x5c4,"Arabic_hamzaonwaw"; -0x5c5,"Arabic_hamzaunderalef"; -0x5c6,"Arabic_hamzaonyeh"; -0x5c7,"Arabic_alef"; -0x5c8,"Arabic_beh"; -0x5c9,"Arabic_tehmarbuta"; -0x5ca,"Arabic_teh"; -0x5cb,"Arabic_theh"; -0x5cc,"Arabic_jeem"; -0x5cd,"Arabic_hah"; -0x5ce,"Arabic_khah"; -0x5cf,"Arabic_dal"; -0x5d0,"Arabic_thal"; -0x5d1,"Arabic_ra"; -0x5d2,"Arabic_zain"; -0x5d3,"Arabic_seen"; -0x5d4,"Arabic_sheen"; -0x5d5,"Arabic_sad"; -0x5d6,"Arabic_dad"; -0x5d7,"Arabic_tah"; -0x5d8,"Arabic_zah"; -0x5d9,"Arabic_ain"; -0x5da,"Arabic_ghain"; -0x5e0,"Arabic_tatweel"; -0x5e1,"Arabic_feh"; -0x5e2,"Arabic_qaf"; -0x5e3,"Arabic_kaf"; -0x5e4,"Arabic_lam"; -0x5e5,"Arabic_meem"; -0x5e6,"Arabic_noon"; -0x5e7,"Arabic_ha"; -0x5e7,"Arabic_heh"; -0x5e8,"Arabic_waw"; -0x5e9,"Arabic_alefmaksura"; -0x5ea,"Arabic_yeh"; -0x5eb,"Arabic_fathatan"; -0x5ec,"Arabic_dammatan"; -0x5ed,"Arabic_kasratan"; -0x5ee,"Arabic_fatha"; -0x5ef,"Arabic_damma"; -0x5f0,"Arabic_kasra"; -0x5f1,"Arabic_shadda"; -0x5f2,"Arabic_sukun"; -0xFF7E,"Arabic_switch"; -0x6a1,"Serbian_dje"; -0x6a2,"Macedonia_gje"; -0x6a3,"Cyrillic_io"; -0x6a4,"Ukrainian_ie"; -0x6a4,"Ukranian_je"; -0x6a5,"Macedonia_dse"; -0x6a6,"Ukrainian_i"; -0x6a6,"Ukranian_i"; -0x6a7,"Ukrainian_yi"; -0x6a7,"Ukranian_yi"; -0x6a8,"Cyrillic_je"; -0x6a8,"Serbian_je"; -0x6a9,"Cyrillic_lje"; -0x6a9,"Serbian_lje"; -0x6aa,"Cyrillic_nje"; -0x6aa,"Serbian_nje"; -0x6ab,"Serbian_tshe"; -0x6ac,"Macedonia_kje"; -0x6ae,"Byelorussian_shortu"; -0x6af,"Cyrillic_dzhe"; -0x6af,"Serbian_dze"; -0x6b0,"numerosign"; -0x6b1,"Serbian_DJE"; -0x6b2,"Macedonia_GJE"; -0x6b3,"Cyrillic_IO"; -0x6b4,"Ukrainian_IE"; -0x6b4,"Ukranian_JE"; -0x6b5,"Macedonia_DSE"; -0x6b6,"Ukrainian_I"; -0x6b6,"Ukranian_I"; -0x6b7,"Ukrainian_YI"; -0x6b7,"Ukranian_YI"; -0x6b8,"Cyrillic_JE"; -0x6b8,"Serbian_JE"; -0x6b9,"Cyrillic_LJE"; -0x6b9,"Serbian_LJE"; -0x6ba,"Cyrillic_NJE"; -0x6ba,"Serbian_NJE"; -0x6bb,"Serbian_TSHE"; -0x6bc,"Macedonia_KJE"; -0x6be,"Byelorussian_SHORTU"; -0x6bf,"Cyrillic_DZHE"; -0x6bf,"Serbian_DZE"; -0x6c0,"Cyrillic_yu"; -0x6c1,"Cyrillic_a"; -0x6c2,"Cyrillic_be"; -0x6c3,"Cyrillic_tse"; -0x6c4,"Cyrillic_de"; -0x6c5,"Cyrillic_ie"; -0x6c6,"Cyrillic_ef"; -0x6c7,"Cyrillic_ghe"; -0x6c8,"Cyrillic_ha"; -0x6c9,"Cyrillic_i"; -0x6ca,"Cyrillic_shorti"; -0x6cb,"Cyrillic_ka"; -0x6cc,"Cyrillic_el"; -0x6cd,"Cyrillic_em"; -0x6ce,"Cyrillic_en"; -0x6cf,"Cyrillic_o"; -0x6d0,"Cyrillic_pe"; -0x6d1,"Cyrillic_ya"; -0x6d2,"Cyrillic_er"; -0x6d3,"Cyrillic_es"; -0x6d4,"Cyrillic_te"; -0x6d5,"Cyrillic_u"; -0x6d6,"Cyrillic_zhe"; -0x6d7,"Cyrillic_ve"; -0x6d8,"Cyrillic_softsign"; -0x6d9,"Cyrillic_yeru"; -0x6da,"Cyrillic_ze"; -0x6db,"Cyrillic_sha"; -0x6dc,"Cyrillic_e"; -0x6dd,"Cyrillic_shcha"; -0x6de,"Cyrillic_che"; -0x6df,"Cyrillic_hardsign"; -0x6e0,"Cyrillic_YU"; -0x6e1,"Cyrillic_A"; -0x6e2,"Cyrillic_BE"; -0x6e3,"Cyrillic_TSE"; -0x6e4,"Cyrillic_DE"; -0x6e5,"Cyrillic_IE"; -0x6e6,"Cyrillic_EF"; -0x6e7,"Cyrillic_GHE"; -0x6e8,"Cyrillic_HA"; -0x6e9,"Cyrillic_I"; -0x6ea,"Cyrillic_SHORTI"; -0x6eb,"Cyrillic_KA"; -0x6ec,"Cyrillic_EL"; -0x6ed,"Cyrillic_EM"; -0x6ee,"Cyrillic_EN"; -0x6ef,"Cyrillic_O"; -0x6f0,"Cyrillic_PE"; -0x6f1,"Cyrillic_YA"; -0x6f2,"Cyrillic_ER"; -0x6f3,"Cyrillic_ES"; -0x6f4,"Cyrillic_TE"; -0x6f5,"Cyrillic_U"; -0x6f6,"Cyrillic_ZHE"; -0x6f7,"Cyrillic_VE"; -0x6f8,"Cyrillic_SOFTSIGN"; -0x6f9,"Cyrillic_YERU"; -0x6fa,"Cyrillic_ZE"; -0x6fb,"Cyrillic_SHA"; -0x6fc,"Cyrillic_E"; -0x6fd,"Cyrillic_SHCHA"; -0x6fe,"Cyrillic_CHE"; -0x6ff,"Cyrillic_HARDSIGN"; -0x7a1,"Greek_ALPHAaccent"; -0x7a2,"Greek_EPSILONaccent"; -0x7a3,"Greek_ETAaccent"; -0x7a4,"Greek_IOTAaccent"; -0x7a5,"Greek_IOTAdiaeresis"; -0x7a7,"Greek_OMICRONaccent"; -0x7a8,"Greek_UPSILONaccent"; -0x7a9,"Greek_UPSILONdieresis"; -0x7ab,"Greek_OMEGAaccent"; -0x7ae,"Greek_accentdieresis"; -0x7af,"Greek_horizbar"; -0x7b1,"Greek_alphaaccent"; -0x7b2,"Greek_epsilonaccent"; -0x7b3,"Greek_etaaccent"; -0x7b4,"Greek_iotaaccent"; -0x7b5,"Greek_iotadieresis"; -0x7b6,"Greek_iotaaccentdieresis"; -0x7b7,"Greek_omicronaccent"; -0x7b8,"Greek_upsilonaccent"; -0x7b9,"Greek_upsilondieresis"; -0x7ba,"Greek_upsilonaccentdieresis"; -0x7bb,"Greek_omegaaccent"; -0x7c1,"Greek_ALPHA"; -0x7c2,"Greek_BETA"; -0x7c3,"Greek_GAMMA"; -0x7c4,"Greek_DELTA"; -0x7c5,"Greek_EPSILON"; -0x7c6,"Greek_ZETA"; -0x7c7,"Greek_ETA"; -0x7c8,"Greek_THETA"; -0x7c9,"Greek_IOTA"; -0x7ca,"Greek_KAPPA"; -0x7cb,"Greek_LAMDA"; -0x7cb,"Greek_LAMBDA"; -0x7cc,"Greek_MU"; -0x7cd,"Greek_NU"; -0x7ce,"Greek_XI"; -0x7cf,"Greek_OMICRON"; -0x7d0,"Greek_PI"; -0x7d1,"Greek_RHO"; -0x7d2,"Greek_SIGMA"; -0x7d4,"Greek_TAU"; -0x7d5,"Greek_UPSILON"; -0x7d6,"Greek_PHI"; -0x7d7,"Greek_CHI"; -0x7d8,"Greek_PSI"; -0x7d9,"Greek_OMEGA"; -0x7e1,"Greek_alpha"; -0x7e2,"Greek_beta"; -0x7e3,"Greek_gamma"; -0x7e4,"Greek_delta"; -0x7e5,"Greek_epsilon"; -0x7e6,"Greek_zeta"; -0x7e7,"Greek_eta"; -0x7e8,"Greek_theta"; -0x7e9,"Greek_iota"; -0x7ea,"Greek_kappa"; -0x7eb,"Greek_lamda"; -0x7eb,"Greek_lambda"; -0x7ec,"Greek_mu"; -0x7ed,"Greek_nu"; -0x7ee,"Greek_xi"; -0x7ef,"Greek_omicron"; -0x7f0,"Greek_pi"; -0x7f1,"Greek_rho"; -0x7f2,"Greek_sigma"; -0x7f3,"Greek_finalsmallsigma"; -0x7f4,"Greek_tau"; -0x7f5,"Greek_upsilon"; -0x7f6,"Greek_phi"; -0x7f7,"Greek_chi"; -0x7f8,"Greek_psi"; -0x7f9,"Greek_omega"; -0xFF7E,"Greek_switch"; -0x8a1,"leftradical"; -0x8a2,"topleftradical"; -0x8a3,"horizconnector"; -0x8a4,"topintegral"; -0x8a5,"botintegral"; -0x8a6,"vertconnector"; -0x8a7,"topleftsqbracket"; -0x8a8,"botleftsqbracket"; -0x8a9,"toprightsqbracket"; -0x8aa,"botrightsqbracket"; -0x8ab,"topleftparens"; -0x8ac,"botleftparens"; -0x8ad,"toprightparens"; -0x8ae,"botrightparens"; -0x8af,"leftmiddlecurlybrace"; -0x8b0,"rightmiddlecurlybrace"; -0x8b1,"topleftsummation"; -0x8b2,"botleftsummation"; -0x8b3,"topvertsummationconnector"; -0x8b4,"botvertsummationconnector"; -0x8b5,"toprightsummation"; -0x8b6,"botrightsummation"; -0x8b7,"rightmiddlesummation"; -0x8bc,"lessthanequal"; -0x8bd,"notequal"; -0x8be,"greaterthanequal"; -0x8bf,"integral"; -0x8c0,"therefore"; -0x8c1,"variation"; -0x8c2,"infinity"; -0x8c5,"nabla"; -0x8c8,"approximate"; -0x8c9,"similarequal"; -0x8cd,"ifonlyif"; -0x8ce,"implies"; -0x8cf,"identical"; -0x8d6,"radical"; -0x8da,"includedin"; -0x8db,"includes"; -0x8dc,"intersection"; -0x8dd,"union"; -0x8de,"logicaland"; -0x8df,"logicalor"; -0x8ef,"partialderivative"; -0x8f6,"function"; -0x8fb,"leftarrow"; -0x8fc,"uparrow"; -0x8fd,"rightarrow"; -0x8fe,"downarrow"; -0x9df,"blank"; -0x9e0,"soliddiamond"; -0x9e1,"checkerboard"; -0x9e2,"ht"; -0x9e3,"ff"; -0x9e4,"cr"; -0x9e5,"lf"; -0x9e8,"nl"; -0x9e9,"vt"; -0x9ea,"lowrightcorner"; -0x9eb,"uprightcorner"; -0x9ec,"upleftcorner"; -0x9ed,"lowleftcorner"; -0x9ee,"crossinglines"; -0x9ef,"horizlinescan1"; -0x9f0,"horizlinescan3"; -0x9f1,"horizlinescan5"; -0x9f2,"horizlinescan7"; -0x9f3,"horizlinescan9"; -0x9f4,"leftt"; -0x9f5,"rightt"; -0x9f6,"bott"; -0x9f7,"topt"; -0x9f8,"vertbar"; -0xaa1,"emspace"; -0xaa2,"enspace"; -0xaa3,"em3space"; -0xaa4,"em4space"; -0xaa5,"digitspace"; -0xaa6,"punctspace"; -0xaa7,"thinspace"; -0xaa8,"hairspace"; -0xaa9,"emdash"; -0xaaa,"endash"; -0xaac,"signifblank"; -0xaae,"ellipsis"; -0xaaf,"doubbaselinedot"; -0xab0,"onethird"; -0xab1,"twothirds"; -0xab2,"onefifth"; -0xab3,"twofifths"; -0xab4,"threefifths"; -0xab5,"fourfifths"; -0xab6,"onesixth"; -0xab7,"fivesixths"; -0xab8,"careof"; -0xabb,"figdash"; -0xabc,"leftanglebracket"; -0xabd,"decimalpoint"; -0xabe,"rightanglebracket"; -0xabf,"marker"; -0xac3,"oneeighth"; -0xac4,"threeeighths"; -0xac5,"fiveeighths"; -0xac6,"seveneighths"; -0xac9,"trademark"; -0xaca,"signaturemark"; -0xacb,"trademarkincircle"; -0xacc,"leftopentriangle"; -0xacd,"rightopentriangle"; -0xace,"emopencircle"; -0xacf,"emopenrectangle"; -0xad0,"leftsinglequotemark"; -0xad1,"rightsinglequotemark"; -0xad2,"leftdoublequotemark"; -0xad3,"rightdoublequotemark"; -0xad4,"prescription"; -0xad6,"minutes"; -0xad7,"seconds"; -0xad9,"latincross"; -0xada,"hexagram"; -0xadb,"filledrectbullet"; -0xadc,"filledlefttribullet"; -0xadd,"filledrighttribullet"; -0xade,"emfilledcircle"; -0xadf,"emfilledrect"; -0xae0,"enopencircbullet"; -0xae1,"enopensquarebullet"; -0xae2,"openrectbullet"; -0xae3,"opentribulletup"; -0xae4,"opentribulletdown"; -0xae5,"openstar"; -0xae6,"enfilledcircbullet"; -0xae7,"enfilledsqbullet"; -0xae8,"filledtribulletup"; -0xae9,"filledtribulletdown"; -0xaea,"leftpointer"; -0xaeb,"rightpointer"; -0xaec,"club"; -0xaed,"diamond"; -0xaee,"heart"; -0xaf0,"maltesecross"; -0xaf1,"dagger"; -0xaf2,"doubledagger"; -0xaf3,"checkmark"; -0xaf4,"ballotcross"; -0xaf5,"musicalsharp"; -0xaf6,"musicalflat"; -0xaf7,"malesymbol"; -0xaf8,"femalesymbol"; -0xaf9,"telephone"; -0xafa,"telephonerecorder"; -0xafb,"phonographcopyright"; -0xafc,"caret"; -0xafd,"singlelowquotemark"; -0xafe,"doublelowquotemark"; -0xaff,"cursor"; -0xba3,"leftcaret"; -0xba6,"rightcaret"; -0xba8,"downcaret"; -0xba9,"upcaret"; -0xbc0,"overbar"; -0xbc2,"downtack"; -0xbc3,"upshoe"; -0xbc4,"downstile"; -0xbc6,"underbar"; -0xbca,"jot"; -0xbcc,"quad"; -0xbce,"uptack"; -0xbcf,"circle"; -0xbd3,"upstile"; -0xbd6,"downshoe"; -0xbd8,"rightshoe"; -0xbda,"leftshoe"; -0xbdc,"lefttack"; -0xbfc,"righttack"; -0xcdf,"hebrew_doublelowline"; -0xce0,"hebrew_aleph"; -0xce1,"hebrew_bet"; -0xce1,"hebrew_beth"; -0xce2,"hebrew_gimel"; -0xce2,"hebrew_gimmel"; -0xce3,"hebrew_dalet"; -0xce3,"hebrew_daleth"; -0xce4,"hebrew_he"; -0xce5,"hebrew_waw"; -0xce6,"hebrew_zain"; -0xce6,"hebrew_zayin"; -0xce7,"hebrew_chet"; -0xce7,"hebrew_het"; -0xce8,"hebrew_tet"; -0xce8,"hebrew_teth"; -0xce9,"hebrew_yod"; -0xcea,"hebrew_finalkaph"; -0xceb,"hebrew_kaph"; -0xcec,"hebrew_lamed"; -0xced,"hebrew_finalmem"; -0xcee,"hebrew_mem"; -0xcef,"hebrew_finalnun"; -0xcf0,"hebrew_nun"; -0xcf1,"hebrew_samech"; -0xcf1,"hebrew_samekh"; -0xcf2,"hebrew_ayin"; -0xcf3,"hebrew_finalpe"; -0xcf4,"hebrew_pe"; -0xcf5,"hebrew_finalzade"; -0xcf5,"hebrew_finalzadi"; -0xcf6,"hebrew_zade"; -0xcf6,"hebrew_zadi"; -0xcf7,"hebrew_qoph"; -0xcf7,"hebrew_kuf"; -0xcf8,"hebrew_resh"; -0xcf9,"hebrew_shin"; -0xcfa,"hebrew_taw"; -0xcfa,"hebrew_taf"; -0xFF7E,"Hebrew_switch"; -0xda1,"Thai_kokai"; -0xda2,"Thai_khokhai"; -0xda3,"Thai_khokhuat"; -0xda4,"Thai_khokhwai"; -0xda5,"Thai_khokhon"; -0xda6,"Thai_khorakhang"; -0xda7,"Thai_ngongu"; -0xda8,"Thai_chochan"; -0xda9,"Thai_choching"; -0xdaa,"Thai_chochang"; -0xdab,"Thai_soso"; -0xdac,"Thai_chochoe"; -0xdad,"Thai_yoying"; -0xdae,"Thai_dochada"; -0xdaf,"Thai_topatak"; -0xdb0,"Thai_thothan"; -0xdb1,"Thai_thonangmontho"; -0xdb2,"Thai_thophuthao"; -0xdb3,"Thai_nonen"; -0xdb4,"Thai_dodek"; -0xdb5,"Thai_totao"; -0xdb6,"Thai_thothung"; -0xdb7,"Thai_thothahan"; -0xdb8,"Thai_thothong"; -0xdb9,"Thai_nonu"; -0xdba,"Thai_bobaimai"; -0xdbb,"Thai_popla"; -0xdbc,"Thai_phophung"; -0xdbd,"Thai_fofa"; -0xdbe,"Thai_phophan"; -0xdbf,"Thai_fofan"; -0xdc0,"Thai_phosamphao"; -0xdc1,"Thai_moma"; -0xdc2,"Thai_yoyak"; -0xdc3,"Thai_rorua"; -0xdc4,"Thai_ru"; -0xdc5,"Thai_loling"; -0xdc6,"Thai_lu"; -0xdc7,"Thai_wowaen"; -0xdc8,"Thai_sosala"; -0xdc9,"Thai_sorusi"; -0xdca,"Thai_sosua"; -0xdcb,"Thai_hohip"; -0xdcc,"Thai_lochula"; -0xdcd,"Thai_oang"; -0xdce,"Thai_honokhuk"; -0xdcf,"Thai_paiyannoi"; -0xdd0,"Thai_saraa"; -0xdd1,"Thai_maihanakat"; -0xdd2,"Thai_saraaa"; -0xdd3,"Thai_saraam"; -0xdd4,"Thai_sarai"; -0xdd5,"Thai_saraii"; -0xdd6,"Thai_saraue"; -0xdd7,"Thai_sarauee"; -0xdd8,"Thai_sarau"; -0xdd9,"Thai_sarauu"; -0xdda,"Thai_phinthu"; -0xdde,"Thai_maihanakat_maitho"; -0xddf,"Thai_baht"; -0xde0,"Thai_sarae"; -0xde1,"Thai_saraae"; -0xde2,"Thai_sarao"; -0xde3,"Thai_saraaimaimuan"; -0xde4,"Thai_saraaimaimalai"; -0xde5,"Thai_lakkhangyao"; -0xde6,"Thai_maiyamok"; -0xde7,"Thai_maitaikhu"; -0xde8,"Thai_maiek"; -0xde9,"Thai_maitho"; -0xdea,"Thai_maitri"; -0xdeb,"Thai_maichattawa"; -0xdec,"Thai_thanthakhat"; -0xded,"Thai_nikhahit"; -0xdf0,"Thai_leksun"; -0xdf1,"Thai_leknung"; -0xdf2,"Thai_leksong"; -0xdf3,"Thai_leksam"; -0xdf4,"Thai_leksi"; -0xdf5,"Thai_lekha"; -0xdf6,"Thai_lekhok"; -0xdf7,"Thai_lekchet"; -0xdf8,"Thai_lekpaet"; -0xdf9,"Thai_lekkao"; -0xff31,"Hangul"; -0xff32,"Hangul_Start"; -0xff33,"Hangul_End"; -0xff34,"Hangul_Hanja"; -0xff35,"Hangul_Jamo"; -0xff36,"Hangul_Romaja"; -0xff37,"Hangul_Codeinput"; -0xff38,"Hangul_Jeonja"; -0xff39,"Hangul_Banja"; -0xff3a,"Hangul_PreHanja"; -0xff3b,"Hangul_PostHanja"; -0xff3c,"Hangul_SingleCandidate"; -0xff3d,"Hangul_MultipleCandidate"; -0xff3e,"Hangul_PreviousCandidate"; -0xff3f,"Hangul_Special"; -0xFF7E,"Hangul_switch"; -0xea1,"Hangul_Kiyeog"; -0xea2,"Hangul_SsangKiyeog"; -0xea3,"Hangul_KiyeogSios"; -0xea4,"Hangul_Nieun"; -0xea5,"Hangul_NieunJieuj"; -0xea6,"Hangul_NieunHieuh"; -0xea7,"Hangul_Dikeud"; -0xea8,"Hangul_SsangDikeud"; -0xea9,"Hangul_Rieul"; -0xeaa,"Hangul_RieulKiyeog"; -0xeab,"Hangul_RieulMieum"; -0xeac,"Hangul_RieulPieub"; -0xead,"Hangul_RieulSios"; -0xeae,"Hangul_RieulTieut"; -0xeaf,"Hangul_RieulPhieuf"; -0xeb0,"Hangul_RieulHieuh"; -0xeb1,"Hangul_Mieum"; -0xeb2,"Hangul_Pieub"; -0xeb3,"Hangul_SsangPieub"; -0xeb4,"Hangul_PieubSios"; -0xeb5,"Hangul_Sios"; -0xeb6,"Hangul_SsangSios"; -0xeb7,"Hangul_Ieung"; -0xeb8,"Hangul_Jieuj"; -0xeb9,"Hangul_SsangJieuj"; -0xeba,"Hangul_Cieuc"; -0xebb,"Hangul_Khieuq"; -0xebc,"Hangul_Tieut"; -0xebd,"Hangul_Phieuf"; -0xebe,"Hangul_Hieuh"; -0xebf,"Hangul_A"; -0xec0,"Hangul_AE"; -0xec1,"Hangul_YA"; -0xec2,"Hangul_YAE"; -0xec3,"Hangul_EO"; -0xec4,"Hangul_E"; -0xec5,"Hangul_YEO"; -0xec6,"Hangul_YE"; -0xec7,"Hangul_O"; -0xec8,"Hangul_WA"; -0xec9,"Hangul_WAE"; -0xeca,"Hangul_OE"; -0xecb,"Hangul_YO"; -0xecc,"Hangul_U"; -0xecd,"Hangul_WEO"; -0xece,"Hangul_WE"; -0xecf,"Hangul_WI"; -0xed0,"Hangul_YU"; -0xed1,"Hangul_EU"; -0xed2,"Hangul_YI"; -0xed3,"Hangul_I"; -0xed4,"Hangul_J_Kiyeog"; -0xed5,"Hangul_J_SsangKiyeog"; -0xed6,"Hangul_J_KiyeogSios"; -0xed7,"Hangul_J_Nieun"; -0xed8,"Hangul_J_NieunJieuj"; -0xed9,"Hangul_J_NieunHieuh"; -0xeda,"Hangul_J_Dikeud"; -0xedb,"Hangul_J_Rieul"; -0xedc,"Hangul_J_RieulKiyeog"; -0xedd,"Hangul_J_RieulMieum"; -0xede,"Hangul_J_RieulPieub"; -0xedf,"Hangul_J_RieulSios"; -0xee0,"Hangul_J_RieulTieut"; -0xee1,"Hangul_J_RieulPhieuf"; -0xee2,"Hangul_J_RieulHieuh"; -0xee3,"Hangul_J_Mieum"; -0xee4,"Hangul_J_Pieub"; -0xee5,"Hangul_J_PieubSios"; -0xee6,"Hangul_J_Sios"; -0xee7,"Hangul_J_SsangSios"; -0xee8,"Hangul_J_Ieung"; -0xee9,"Hangul_J_Jieuj"; -0xeea,"Hangul_J_Cieuc"; -0xeeb,"Hangul_J_Khieuq"; -0xeec,"Hangul_J_Tieut"; -0xeed,"Hangul_J_Phieuf"; -0xeee,"Hangul_J_Hieuh"; -0xeef,"Hangul_RieulYeorinHieuh"; -0xef0,"Hangul_SunkyeongeumMieum"; -0xef1,"Hangul_SunkyeongeumPieub"; -0xef2,"Hangul_PanSios"; -0xef3,"Hangul_KkogjiDalrinIeung"; -0xef4,"Hangul_SunkyeongeumPhieuf"; -0xef5,"Hangul_YeorinHieuh"; -0xef6,"Hangul_AraeA"; -0xef7,"Hangul_AraeAE"; -0xef8,"Hangul_J_PanSios"; -0xef9,"Hangul_J_KkogjiDalrinIeung"; -0xefa,"Hangul_J_YeorinHieuh"; -0xeff,"Korean_Won"; -] diff --git a/ide/utils/configwin_types.ml b/ide/utils/configwin_types.mli index ace751c64e..9e339d135d 100644 --- a/ide/utils/configwin_types.ml +++ b/ide/utils/configwin_types.mli @@ -25,113 +25,6 @@ (** This module contains the types used in Configwin. *) -open Config_file - -let name_to_keysym = - ("Button1", Configwin_keys.xk_Pointer_Button1) :: - ("Button2", Configwin_keys.xk_Pointer_Button2) :: - ("Button3", Configwin_keys.xk_Pointer_Button3) :: - ("Button4", Configwin_keys.xk_Pointer_Button4) :: - ("Button5", Configwin_keys.xk_Pointer_Button5) :: - Configwin_keys.name_to_keysym - -let string_to_key s = - let mask = ref [] in - let key = try - let pos = String.rindex s '-' in - for i = 0 to pos - 1 do - let m = match s.[i] with - 'C' -> `CONTROL - | 'S' -> `SHIFT - | 'L' -> `LOCK - | 'M' -> `MOD1 - | 'A' -> `MOD1 - | '1' -> `MOD1 - | '2' -> `MOD2 - | '3' -> `MOD3 - | '4' -> `MOD4 - | '5' -> `MOD5 - | _ -> - Minilib.log s; - raise Not_found - in - mask := m :: !mask - done; - String.sub s (pos+1) (String.length s - pos - 1) - with _ -> - s - in - try - !mask, List.assoc key name_to_keysym - with - e -> - Minilib.log s; - raise e - -let key_to_string (m, k) = - let s = List.assoc k Configwin_keys.keysym_to_name in - match m with - [] -> s - | _ -> - let rec iter m s = - match m with - [] -> s - | c :: m -> - iter m (( - match c with - `CONTROL -> "C" - | `SHIFT -> "S" - | `LOCK -> "L" - | `MOD1 -> "A" - | `MOD2 -> "2" - | `MOD3 -> "3" - | `MOD4 -> "4" - | `MOD5 -> "5" - | _ -> raise Not_found - ) ^ s) - in - iter m ("-" ^ s) - -let modifiers_to_string m = - let rec iter m s = - match m with - [] -> s - | c :: m -> - iter m (( - match c with - `CONTROL -> "<ctrl>" - | `SHIFT -> "<shft>" - | `LOCK -> "<lock>" - | `MOD1 -> "<alt>" - | `MOD2 -> "<mod2>" - | `MOD3 -> "<mod3>" - | `MOD4 -> "<mod4>" - | `MOD5 -> "<mod5>" - | _ -> raise Not_found - ) ^ s) - in - iter m "" - -let value_to_key v = - match v with - Raw.String s -> string_to_key s - | _ -> - Minilib.log "value_to_key"; - raise Not_found - -let key_to_value k = - Raw.String (key_to_string k) - -let key_cp_wrapper = - { - to_raw = key_to_value ; - of_raw = value_to_key ; - } - -(** A class to define key options, with the {!Config_file} module. *) -class key_cp = - [(Gdk.Tags.modifier list * int)] Config_file.cp_custom_type key_cp_wrapper - (** This type represents a string or filename parameter, or any other type, depending on the given conversion functions. *) type 'a string_param = { @@ -188,49 +81,6 @@ type custom_param = { custom_framed : string option ; (** optional label for an optional frame *) } ;; -type color_param = { - color_label : string; (** the label of the parameter *) - mutable color_value : string; (** the current value of the parameter *) - color_editable : bool ; (** indicates if the value can be changed *) - color_f_apply : (string -> unit) ; (** the function to call to apply the new value of the parameter *) - color_help : string option ; (** optional help string *) - color_expand : bool ; (** expand the entry widget or not *) - } ;; - -type date_param = { - date_label : string ; (** the label of the parameter *) - mutable date_value : int * int * int ; (** day, month, year *) - date_editable : bool ; (** indicates if the value can be changed *) - date_f_string : (int * int * int) -> string ; - (** the function used to display the current value (day, month, year) *) - date_f_apply : ((int * int * int) -> unit) ; - (** the function to call to apply the new value (day, month, year) of the parameter *) - date_help : string option ; (** optional help string *) - date_expand : bool ; (** expand the entry widget or not *) - } ;; - -type font_param = { - font_label : string ; (** the label of the parameter *) - mutable font_value : string ; (** the font name *) - font_editable : bool ; (** indicates if the value can be changed *) - font_f_apply : (string -> unit) ; - (** the function to call to apply the new value of the parameter *) - font_help : string option ; (** optional help string *) - font_expand : bool ; (** expand the entry widget or not *) - } ;; - - -type hotkey_param = { - hk_label : string ; (** the label of the parameter *) - mutable hk_value : (Gdk.Tags.modifier list * int) ; - (** The value, as a list of modifiers and a key code *) - hk_editable : bool ; (** indicates if the value can be changed *) - hk_f_apply : ((Gdk.Tags.modifier list * int) -> unit) ; - (** the function to call to apply the new value of the paramter *) - hk_help : string option ; (** optional help string *) - hk_expand : bool ; (** expand or not *) - } - type modifiers_param = { md_label : string ; (** the label of the parameter *) mutable md_value : Gdk.Tags.modifier list ; @@ -248,17 +98,11 @@ type modifiers_param = { type parameter_kind = String_param of string string_param | List_param of (GData.tooltips -> <box: GObj.widget ; apply : unit>) - | Filename_param of string string_param | Bool_param of bool_param | Text_param of string string_param | Combo_param of combo_param | Custom_param of custom_param - | Color_param of color_param - | Date_param of date_param - | Font_param of font_param - | Hotkey_param of hotkey_param | Modifiers_param of modifiers_param - | Html_param of string string_param ;; (** This type represents the structure of the configuration window. *) @@ -275,28 +119,3 @@ type return_button = | Return_cancel (** The user closed the window with the cancel button or the window manager but never clicked on the apply button.*) - -(** {2 Bindings in the html editor} *) - -type html_binding = { - mutable html_key : (Gdk.Tags.modifier list * int) ; - mutable html_begin : string ; - mutable html_end : string ; - } - -let htmlbinding_cp_wrapper = - let w = Config_file.tuple3_wrappers - key_cp_wrapper - Config_file.string_wrappers - Config_file.string_wrappers - in - { - to_raw = (fun v -> w.to_raw (v.html_key, v.html_begin, v.html_end)) ; - of_raw = - (fun r -> let (k,b,e) = w.of_raw r in - { html_key = k ; html_begin = b ; html_end = e } - ) ; - } - -class htmlbinding_cp = - [html_binding] Config_file.option_cp htmlbinding_cp_wrapper diff --git a/ide/utils/editable_cells.ml b/ide/utils/editable_cells.ml deleted file mode 100644 index 33968b8dd0..0000000000 --- a/ide/utils/editable_cells.ml +++ /dev/null @@ -1,113 +0,0 @@ -open Gobject - -let create l = - let hbox = GPack.hbox () in - let scw = GBin.scrolled_window - ~hpolicy:`AUTOMATIC - ~vpolicy:`AUTOMATIC - ~packing:(hbox#pack ~expand:true) () in - - let columns = new GTree.column_list in - let command_col = columns#add Data.string in - let coq_col = columns#add Data.string in - let store = GTree.list_store columns - in - -(* populate the store *) - let _ = List.iter (fun (x,y) -> - let row = store#append () in - store#set ~row ~column:command_col x; - store#set ~row ~column:coq_col y) - l - in - let view = GTree.view ~model:store ~packing:scw#add_with_viewport () in - - (* Alternate colors for the rows *) - view#set_rules_hint true; - - let renderer_comm = GTree.cell_renderer_text [`EDITABLE true] in - ignore (renderer_comm#connect#edited - ~callback:(fun (path:Gtk.tree_path) (s:string) -> - store#set - ~row:(store#get_iter path) - ~column:command_col s)); - let first = - GTree.view_column ~title:"Coq Command to try" - ~renderer:(renderer_comm,["text",command_col]) - () - in ignore (view#append_column first); - - let renderer_coq = GTree.cell_renderer_text [`EDITABLE true] in - ignore(renderer_coq#connect#edited - ~callback:(fun (path:Gtk.tree_path) (s:string) -> - store#set - ~row:(store#get_iter path) - ~column:coq_col s)); - let second = - GTree.view_column ~title:"Coq Command to insert" - ~renderer:(renderer_coq,["text",coq_col]) - () - in ignore (view#append_column second); - - let vbox = GPack.button_box `VERTICAL ~packing:hbox#pack ~layout:`SPREAD () - in - let up = GButton.button ~stock:`GO_UP ~label:"Up" ~packing:(vbox#pack ~expand:true ~fill:false) () in - let down = GButton.button - ~stock:`GO_DOWN - ~label:"Down" - ~packing:(vbox#pack ~expand:true ~fill:false) () - in - let add = GButton.button ~stock:`ADD - ~label:"Add" - ~packing:(vbox#pack ~expand:true ~fill:false) - () - in - let remove = GButton.button ~stock:`REMOVE - ~label:"Remove" - ~packing:(vbox#pack ~expand:true ~fill:false) () - in - - ignore (add#connect#clicked - ~callback:(fun b -> - let n = store#append () in - view#selection#select_iter n)); - ignore (remove#connect#clicked - ~callback:(fun b -> match view#selection#get_selected_rows with - | [] -> () - | path::_ -> - let iter = store#get_iter path in - ignore (store#remove iter); - )); - ignore (up#connect#clicked - ~callback:(fun b -> - match view#selection#get_selected_rows with - | [] -> () - | path::_ -> - let iter = store#get_iter path in - ignore (GtkTree.TreePath.prev path); - let upiter = store#get_iter path in - ignore (store#swap iter upiter); - )); - ignore (down#connect#clicked - ~callback:(fun b -> - match view#selection#get_selected_rows with - | [] -> () - | path::_ -> - let iter = store#get_iter path in - GtkTree.TreePath.next path; - try let upiter = store#get_iter path in - ignore (store#swap iter upiter) - with _ -> () - )); - let get_data () = - let start_path = GtkTree.TreePath.from_string "0" in - let start_iter = store#get_iter start_path in - let rec all acc = - let new_acc = (store#get ~row:start_iter ~column:command_col, - store#get ~row:start_iter ~column:coq_col)::acc - in - if store#iter_next start_iter then all new_acc else List.rev new_acc - in all [] - in - (hbox,get_data) - diff --git a/ide/utils/okey.ml b/ide/utils/okey.ml deleted file mode 100644 index 580f1fbcb3..0000000000 --- a/ide/utils/okey.ml +++ /dev/null @@ -1,196 +0,0 @@ -(*********************************************************************************) -(* Cameleon *) -(* *) -(* Copyright (C) 2005 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. *) -(* *) -(* This program is free software; you can redistribute it and/or modify *) -(* it under the terms of the GNU Library General Public License as *) -(* published by the Free Software Foundation; either version 2 of the *) -(* License, or any later version. *) -(* *) -(* This program is distributed in the hope that it will be useful, *) -(* but WITHOUT ANY WARRANTY; without even the implied warranty of *) -(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) -(* GNU Library General Public License for more details. *) -(* *) -(* You should have received a copy of the GNU Library General Public *) -(* License along with this program; if not, write to the Free Software *) -(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA *) -(* 02111-1307 USA *) -(* *) -(* Contact: Maxence.Guesdon@inria.fr *) -(* *) -(*********************************************************************************) - -type modifier = Gdk.Tags.modifier - -type handler = { - cond : (unit -> bool) ; - cback : (unit -> unit) ; - } - -type handler_spec = int * int * Gdk.keysym - (** mods * mask * key *) - -let int_of_modifier = function - `SHIFT -> 1 - | `LOCK -> 2 - | `CONTROL -> 4 - | `MOD1 -> 8 - | `MOD2 -> 16 - | `MOD3 -> 32 - | `MOD4 -> 64 - | `MOD5 -> 128 - | `BUTTON1 -> 256 - | `BUTTON2 -> 512 - | `BUTTON3 -> 1024 - | `BUTTON4 -> 2048 - | `BUTTON5 -> 4096 - | `HYPER -> 1 lsl 22 - | `META -> 1 lsl 20 - | `RELEASE -> 1 lsl 30 - | `SUPER -> 1 lsl 21 - -let print_modifier l = - List.iter - (fun m -> - print_string - (((function - `SHIFT -> "SHIFT" - | `LOCK -> "LOCK" - | `CONTROL -> "CONTROL" - | `MOD1 -> "MOD1" - | `MOD2 -> "MOD2" - | `MOD3 -> "MOD3" - | `MOD4 -> "MOD4" - | `MOD5 -> "MOD5" - | `BUTTON1 -> "B1" - | `BUTTON2 -> "B2" - | `BUTTON3 -> "B3" - | `BUTTON4 -> "B4" - | `BUTTON5 -> "B5" - | `HYPER -> "HYPER" - | `META -> "META" - | `RELEASE -> "" - | `SUPER -> "SUPER") - m)^" ") - ) - l; - print_newline () - -let int_of_modifiers l = - List.fold_left (fun acc -> fun m -> acc + (int_of_modifier m)) 0 l - -module H = - struct - type t = handler_spec * handler - let equal (m,k) (mods, mask, key) = - (k = key) && ((m land mask) = mods) - - let filter_with_mask mods mask key l = - List.filter (fun a -> (fst a) <> (mods, mask, key)) l - - let find_handlers mods key l = - List.map snd - (List.filter - (fun ((m,ma,k),_) -> equal (mods,key) (m,ma,k)) - l - ) - - end - -let (table : (int, H.t list ref) Hashtbl.t) = Hashtbl.create 13 - -let key_press w ev = - let key = GdkEvent.Key.keyval ev in - let modifiers = GdkEvent.Key.state ev in - try - let (r : H.t list ref) = Hashtbl.find table (Oo.id w) in - let l = H.find_handlers (int_of_modifiers modifiers) key !r in - match l with - [] -> false - | _ -> - List.iter - (fun h -> - if h.cond () then - try h.cback () - with e -> Minilib.log (Printexc.to_string e) - else () - ) - l; - true - with - Not_found -> - false - -let associate_key_press w = - ignore ((w#event#connect#key_press ~callback: (key_press w)) : GtkSignal.id) - -let default_modifiers = ref ([] : modifier list) -let default_mask = ref ([`MOD2 ; `MOD3 ; `MOD4 ; `MOD5 ; `LOCK] : modifier list) - -let set_default_modifiers l = default_modifiers := l -let set_default_mask l = default_mask := l - -let remove_widget (w : < event : GObj.event_ops ; ..>) () = - try - let r = Hashtbl.find table (Oo.id w) in - r := [] - with - Not_found -> - () - -let add1 ?(remove=false) w - ?(cond=(fun () -> true)) - ?(mods= !default_modifiers) - ?(mask= !default_mask) - k callback = - - let r = - try Hashtbl.find table (Oo.id w) - with Not_found -> - let r = ref [] in - Hashtbl.add table (Oo.id w) r; - ignore (w#connect#destroy ~callback: (remove_widget w)); - associate_key_press w; - r - in - let n_mods = int_of_modifiers mods in - let n_mask = lnot (int_of_modifiers mask) in - let new_h = { cond = cond ; cback = callback } in - if remove then - ( - let l = H.filter_with_mask n_mods n_mask k !r in - r := ((n_mods, n_mask, k), new_h) :: l - ) - else - r := ((n_mods, n_mask, k), new_h) :: !r - -let add w - ?(cond=(fun () -> true)) - ?(mods= !default_modifiers) - ?(mask= !default_mask) - k callback = - add1 w ~cond ~mods ~mask k callback - -let add_list w - ?(cond=(fun () -> true)) - ?(mods= !default_modifiers) - ?(mask= !default_mask) - k_list callback = - List.iter (fun k -> add w ~cond ~mods ~mask k callback) k_list - -let set w - ?(cond=(fun () -> true)) - ?(mods= !default_modifiers) - ?(mask= !default_mask) - k callback = - add1 ~remove: true w ~cond ~mods ~mask k callback - -let set_list w - ?(cond=(fun () -> true)) - ?(mods= !default_modifiers) - ?(mask= !default_mask) - k_list callback = - List.iter (fun k -> set w ~cond ~mods ~mask k callback) k_list diff --git a/ide/utils/okey.mli b/ide/utils/okey.mli deleted file mode 100644 index 84ea4df449..0000000000 --- a/ide/utils/okey.mli +++ /dev/null @@ -1,115 +0,0 @@ -(*********************************************************************************) -(* Cameleon *) -(* *) -(* Copyright (C) 2005 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. *) -(* *) -(* This program is free software; you can redistribute it and/or modify *) -(* it under the terms of the GNU Library General Public License as *) -(* published by the Free Software Foundation; either version 2 of the *) -(* License, or any later version. *) -(* *) -(* This program is distributed in the hope that it will be useful, *) -(* but WITHOUT ANY WARRANTY; without even the implied warranty of *) -(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) -(* GNU Library General Public License for more details. *) -(* *) -(* You should have received a copy of the GNU Library General Public *) -(* License along with this program; if not, write to the Free Software *) -(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA *) -(* 02111-1307 USA *) -(* *) -(* Contact: Maxence.Guesdon@inria.fr *) -(* *) -(*********************************************************************************) - -(** Okey interface. - - Once the lib is compiled and installed, you can use it by referencing - it with the [Okey] module. You must add [okey.cmo] or [okey.cmx] - on the commande line when you link. -*) - -type modifier = Gdk.Tags.modifier - -(** Set the default modifier list. The first default value is [[]].*) -val set_default_modifiers : modifier list -> unit - -(** Set the default modifier mask. The first default value is - [[`MOD2 ; `MOD3 ; `MOD4 ; `MOD5 ; `LOCK]]. - The mask defines the modifiers not taken into account - when looking for the handler of a key press event. -*) -val set_default_mask : modifier list -> unit - -(** [add widget key callback] associates the [callback] function to the event - "key_press" with the given [key] for the given [widget]. - - @param remove when true, the previous handlers for the given key and modifier - list are not kept. - @param cond this function is a guard: the [callback] function is not called - if the [cond] function returns [false]. - The default [cond] function always returns [true]. - - @param mods the list of modifiers. If not given, the default modifiers - are used. - You can set the default modifiers with function {!Okey.set_default_modifiers}. - - @param mask the list of modifiers which must not be taken - into account to trigger the given handler. [mods] - and [mask] must not have common modifiers. If not given, the default mask - is used. - You can set the default modifiers mask with function {!Okey.set_default_mask}. -*) -val add : - < connect : < destroy : callback: (unit -> unit) -> GtkSignal.id; .. >; - event : GObj.event_ops; get_oid : int; .. > -> - ?cond: (unit -> bool) -> - ?mods: modifier list -> - ?mask: modifier list -> - Gdk.keysym -> - (unit -> unit) -> - unit - -(** It calls {!Okey.add} for each given key.*) -val add_list : - < connect : < destroy : callback: (unit -> unit) -> GtkSignal.id; .. >; - event : GObj.event_ops; get_oid : int; .. > -> - ?cond: (unit -> bool) -> - ?mods: modifier list -> - ?mask: modifier list -> - Gdk.keysym list -> - (unit -> unit) -> - unit - -(** Like {!Okey.add} but the previous handlers for the - given modifiers and key are not kept.*) -val set : - < connect : < destroy : callback: (unit -> unit) -> GtkSignal.id; .. >; - event : GObj.event_ops; get_oid : int; .. > -> - ?cond: (unit -> bool) -> - ?mods: modifier list -> - ?mask: modifier list -> - Gdk.keysym -> - (unit -> unit) -> - unit - -(** It calls {!Okey.set} for each given key.*) -val set_list : - < connect : < destroy : callback: (unit -> unit) -> GtkSignal.id; .. >; - event : GObj.event_ops; get_oid : int; .. > -> - ?cond: (unit -> bool) -> - ?mods: modifier list -> - ?mask: modifier list -> - Gdk.keysym list -> - (unit -> unit) -> - unit - -(** Remove the handlers associated to the given widget. - This is automatically done when a widget is destroyed but - you can do it yourself. *) -val remove_widget : - < connect : < destroy : callback: (unit -> unit) -> GtkSignal.id; .. >; - event : GObj.event_ops; get_oid : int; .. > -> - unit -> - unit diff --git a/ide/wg_Completion.ml b/ide/wg_Completion.ml index 6c53fc0133..aeae3e1fdb 100644 --- a/ide/wg_Completion.ml +++ b/ide/wg_Completion.ml @@ -86,7 +86,7 @@ let signals = [ end_s#disconnect; ] in object (self : 'a) - inherit GUtil.ml_signals signals as super + inherit GUtil.ml_signals signals method start_completion = start_s#connect ~after method update_completion = update_s#connect ~after method end_completion = end_s#connect ~after diff --git a/ide/wg_MessageView.ml b/ide/wg_MessageView.ml index 7728ad2360..0330b8eff1 100644 --- a/ide/wg_MessageView.ml +++ b/ide/wg_MessageView.ml @@ -43,6 +43,7 @@ let message_view () : message_view = ~tag_table:Tags.Message.table () in let text_buffer = new GText.buffer buffer#as_buffer in + let mark = buffer#create_mark ~left_gravity:false buffer#start_iter in let box = GPack.vbox () in let scroll = GBin.scrolled_window ~vpolicy:`AUTOMATIC ~hpolicy:`AUTOMATIC ~packing:(box#pack ~expand:true) () in @@ -69,12 +70,13 @@ let message_view () : message_view = new message_view_signals_impl box#as_widget push method clear = - buffer#set_text "" + buffer#set_text ""; + buffer#move_mark (`MARK mark) ~where:buffer#start_iter method push level msg = let tags = match level with - | Pp.Error -> [Tags.Message.error] - | Pp.Warning -> [Tags.Message.warning] + | Feedback.Error -> [Tags.Message.error] + | Feedback.Warning -> [Tags.Message.warning] | _ -> [] in let rec non_empty = function @@ -83,12 +85,13 @@ let message_view () : message_view = | Xml_datatype.Element (_, _, children) -> List.exists non_empty children in if non_empty (Richpp.repr msg) then begin - Ideutils.insert_xml buffer ~tags msg; - buffer#insert (*~tags*) "\n"; + let mark = `MARK mark in + Ideutils.insert_xml ~mark buffer ~tags msg; + buffer#insert ~iter:(buffer#get_iter_at_mark mark) "\n"; push#call (level, msg) end - method add msg = self#push Pp.Notice msg + method add msg = self#push Feedback.Notice msg method add_string s = self#add (Richpp.richpp_of_string s) diff --git a/ide/wg_ProofView.ml b/ide/wg_ProofView.ml index 4d95fdd0df..47c86045a5 100644 --- a/ide/wg_ProofView.ml +++ b/ide/wg_ProofView.ml @@ -91,7 +91,7 @@ let mode_tactic sel_cb (proof : #GText.view_skel) goals hints = match goals with let () = proof#buffer#insert head_str in let () = insert_hyp hyps_hints hyps in let () = - let tags = Tags.Proof.goal :: if goal_hints <> [] then + let _ = if goal_hints <> [] then let tag = proof#buffer#create_tag [] in let () = hook_tag_cb tag goal_hints sel_cb on_hover in [tag] diff --git a/ide/wg_ScriptView.ml b/ide/wg_ScriptView.ml index 83fbda4874..218cedb363 100644 --- a/ide/wg_ScriptView.ml +++ b/ide/wg_ScriptView.ml @@ -287,7 +287,7 @@ let completion = new Wg_Completion.complete_model ct view#buffer in let popup = new Wg_Completion.complete_popup completion (view :> GText.view) in object (self) - inherit GSourceView2.source_view (Gobject.unsafe_cast tv) as super + inherit GSourceView2.source_view (Gobject.unsafe_cast tv) val undo_manager = new undo_manager view#buffer diff --git a/ide/wg_Segment.ml b/ide/wg_Segment.ml index c2799e40b1..dbc1740ef6 100644 --- a/ide/wg_Segment.ml +++ b/ide/wg_Segment.ml @@ -60,6 +60,8 @@ object (self) val mutable default : color = `WHITE val mutable pixmap : GDraw.pixmap = GDraw.pixmap ~width:1 ~height:1 () val clicked = new GUtil.signal () + val mutable need_refresh = false + val refresh_timer = Ideutils.mktimer () initializer box#misc#set_size_request ~height (); @@ -88,13 +90,15 @@ object (self) let cb show = if show then self#misc#show () else self#misc#hide () in stick show_progress_bar self cb; (** Initial pixmap *) - draw#set_pixmap pixmap + draw#set_pixmap pixmap; + refresh_timer.Ideutils.run ~ms:300 + ~callback:(fun () -> if need_refresh then self#refresh (); true) method set_model md = model <- Some md; let changed_cb = function | `INSERT | `REMOVE -> - if self#misc#visible then self#refresh () + if self#misc#visible then need_refresh <- true | `SET (i, color) -> if self#misc#visible then self#fill_range color i (i + 1) in @@ -125,6 +129,7 @@ object (self) method private refresh () = match model with | None -> () | Some md -> + need_refresh <- false; pixmap#set_foreground default; pixmap#rectangle ~x:0 ~y:0 ~width ~height ~filled:true (); let make (k, cur, accu) v = match cur with diff --git a/ide/xml_lexer.mli b/ide/xml_lexer.mli new file mode 100644 index 0000000000..e61cb055f7 --- /dev/null +++ b/ide/xml_lexer.mli @@ -0,0 +1,44 @@ +(* + * Xml Light, an small Xml parser/printer with DTD support. + * Copyright (C) 2003 Nicolas Cannasse (ncannasse@motion-twin.com) + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License as published by the Free Software Foundation; either + * version 2.1 of the License, or (at your option) any later version. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + *) + +type error = + | EUnterminatedComment + | EUnterminatedString + | EIdentExpected + | ECloseExpected + | ENodeExpected + | EAttributeNameExpected + | EAttributeValueExpected + | EUnterminatedEntity + +exception Error of error + +type token = + | Tag of string * (string * string) list * bool + | PCData of string + | Endtag of string + | Eof + +type pos = int * int * int * int + +val init : Lexing.lexbuf -> unit +val close : unit -> unit +val token : Lexing.lexbuf -> token +val pos : Lexing.lexbuf -> pos +val restore : pos -> unit diff --git a/ide/xml_lexer.mll b/ide/xml_lexer.mll new file mode 100644 index 0000000000..290f2c89ab --- /dev/null +++ b/ide/xml_lexer.mll @@ -0,0 +1,317 @@ +{(* + * Xml Light, an small Xml parser/printer with DTD support. + * Copyright (C) 2003 Nicolas Cannasse (ncannasse@motion-twin.com) + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License as published by the Free Software Foundation; either + * version 2.1 of the License, or (at your option) any later version. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + *) + +open Lexing + +type error = + | EUnterminatedComment + | EUnterminatedString + | EIdentExpected + | ECloseExpected + | ENodeExpected + | EAttributeNameExpected + | EAttributeValueExpected + | EUnterminatedEntity + +exception Error of error + +type pos = int * int * int * int + +type token = + | Tag of string * (string * string) list * bool + | PCData of string + | Endtag of string + | Eof + +let last_pos = ref 0 +and current_line = ref 0 +and current_line_start = ref 0 + +let tmp = Buffer.create 200 + +let idents = Hashtbl.create 0 + +let _ = begin + Hashtbl.add idents "nbsp;" " "; + Hashtbl.add idents "gt;" ">"; + Hashtbl.add idents "lt;" "<"; + Hashtbl.add idents "amp;" "&"; + Hashtbl.add idents "apos;" "'"; + Hashtbl.add idents "quot;" "\""; +end + +let init lexbuf = + current_line := 1; + current_line_start := lexeme_start lexbuf; + last_pos := !current_line_start + +let close lexbuf = + Buffer.reset tmp + +let pos lexbuf = + !current_line , !current_line_start , + !last_pos , + lexeme_start lexbuf + +let restore (cl,cls,lp,_) = + current_line := cl; + current_line_start := cls; + last_pos := lp + +let newline lexbuf = + incr current_line; + last_pos := lexeme_end lexbuf; + current_line_start := !last_pos + +let error lexbuf e = + last_pos := lexeme_start lexbuf; + raise (Error e) + +} + +let newline = ['\n'] +let break = ['\r'] +let space = [' ' '\t'] +let identchar = ['A'-'Z' 'a'-'z' '_' '0'-'9' ':' '-' '.'] +let ident = ['A'-'Z' 'a'-'z' '_' ':'] identchar* +let entitychar = ['A'-'Z' 'a'-'z'] +let pcchar = [^ '\r' '\n' '<' '>' '&'] + +rule token = parse + | newline | (newline break) | break + { + newline lexbuf; + PCData "\n" + } + | "<!--" + { + last_pos := lexeme_start lexbuf; + comment lexbuf; + token lexbuf + } + | "<?" + { + last_pos := lexeme_start lexbuf; + header lexbuf; + token lexbuf; + } + | '<' space* '/' space* + { + last_pos := lexeme_start lexbuf; + let tag = ident_name lexbuf in + ignore_spaces lexbuf; + close_tag lexbuf; + Endtag tag + } + | '<' space* + { + last_pos := lexeme_start lexbuf; + let tag = ident_name lexbuf in + ignore_spaces lexbuf; + let attribs, closed = attributes lexbuf in + Tag(tag, attribs, closed) + } + | "&#" + { + last_pos := lexeme_start lexbuf; + Buffer.reset tmp; + Buffer.add_string tmp (lexeme lexbuf); + PCData (pcdata lexbuf) + } + | '&' + { + last_pos := lexeme_start lexbuf; + Buffer.reset tmp; + Buffer.add_string tmp (entity lexbuf); + PCData (pcdata lexbuf) + } + | pcchar+ + { + last_pos := lexeme_start lexbuf; + Buffer.reset tmp; + Buffer.add_string tmp (lexeme lexbuf); + PCData (pcdata lexbuf) + } + | eof { Eof } + | _ + { error lexbuf ENodeExpected } + +and ignore_spaces = parse + | newline | (newline break) | break + { + newline lexbuf; + ignore_spaces lexbuf + } + | space + + { ignore_spaces lexbuf } + | "" + { () } + +and comment = parse + | newline | (newline break) | break + { + newline lexbuf; + comment lexbuf + } + | "-->" + { () } + | eof + { raise (Error EUnterminatedComment) } + | _ + { comment lexbuf } + +and header = parse + | newline | (newline break) | break + { + newline lexbuf; + header lexbuf + } + | "?>" + { () } + | eof + { error lexbuf ECloseExpected } + | _ + { header lexbuf } + +and pcdata = parse + | newline | (newline break) | break + { + Buffer.add_char tmp '\n'; + newline lexbuf; + pcdata lexbuf + } + | pcchar+ + { + Buffer.add_string tmp (lexeme lexbuf); + pcdata lexbuf + } + | "&#" + { + Buffer.add_string tmp (lexeme lexbuf); + pcdata lexbuf; + } + | '&' + { + Buffer.add_string tmp (entity lexbuf); + pcdata lexbuf + } + | "" + { Buffer.contents tmp } + +and entity = parse + | entitychar+ ';' + { + let ident = lexeme lexbuf in + try + Hashtbl.find idents (String.lowercase ident) + with + Not_found -> "&" ^ ident + } + | _ | eof + { raise (Error EUnterminatedEntity) } + +and ident_name = parse + | ident + { lexeme lexbuf } + | _ | eof + { error lexbuf EIdentExpected } + +and close_tag = parse + | '>' + { () } + | _ | eof + { error lexbuf ECloseExpected } + +and attributes = parse + | '>' + { [], false } + | "/>" + { [], true } + | "" (* do not read a char ! *) + { + let key = attribute lexbuf in + let data = attribute_data lexbuf in + ignore_spaces lexbuf; + let others, closed = attributes lexbuf in + (key, data) :: others, closed + } + +and attribute = parse + | ident + { lexeme lexbuf } + | _ | eof + { error lexbuf EAttributeNameExpected } + +and attribute_data = parse + | space* '=' space* '"' + { + Buffer.reset tmp; + last_pos := lexeme_end lexbuf; + dq_string lexbuf + } + | space* '=' space* '\'' + { + Buffer.reset tmp; + last_pos := lexeme_end lexbuf; + q_string lexbuf + } + | _ | eof + { error lexbuf EAttributeValueExpected } + +and dq_string = parse + | '"' + { Buffer.contents tmp } + | '\\' [ '"' '\\' ] + { + Buffer.add_char tmp (lexeme_char lexbuf 1); + dq_string lexbuf + } + | '&' + { + Buffer.add_string tmp (entity lexbuf); + dq_string lexbuf + } + | eof + { raise (Error EUnterminatedString) } + | _ + { + Buffer.add_char tmp (lexeme_char lexbuf 0); + dq_string lexbuf + } + +and q_string = parse + | '\'' + { Buffer.contents tmp } + | '\\' [ '\'' '\\' ] + { + Buffer.add_char tmp (lexeme_char lexbuf 1); + q_string lexbuf + } + | '&' + { + Buffer.add_string tmp (entity lexbuf); + q_string lexbuf + } + | eof + { raise (Error EUnterminatedString) } + | _ + { + Buffer.add_char tmp (lexeme_char lexbuf 0); + q_string lexbuf + } diff --git a/ide/xml_parser.ml b/ide/xml_parser.ml new file mode 100644 index 0000000000..8db3f9e8ba --- /dev/null +++ b/ide/xml_parser.ml @@ -0,0 +1,232 @@ +(* + * Xml Light, an small Xml parser/printer with DTD support. + * Copyright (C) 2003 Nicolas Cannasse (ncannasse@motion-twin.com) + * Copyright (C) 2003 Jacques Garrigue + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License as published by the Free Software Foundation; either + * version 2.1 of the License, or (at your option) any later version. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + *) + +open Printf +open Xml_datatype + +type xml = Xml_datatype.xml + +type error_pos = { + eline : int; + eline_start : int; + emin : int; + emax : int; +} + +type error_msg = + | UnterminatedComment + | UnterminatedString + | UnterminatedEntity + | IdentExpected + | CloseExpected + | NodeExpected + | AttributeNameExpected + | AttributeValueExpected + | EndOfTagExpected of string + | EOFExpected + | Empty + +type error = error_msg * error_pos + +exception Error of error + +exception File_not_found of string + +type t = { + mutable check_eof : bool; + mutable concat_pcdata : bool; + source : Lexing.lexbuf; + stack : Xml_lexer.token Stack.t; +} + +type source = + | SChannel of in_channel + | SString of string + | SLexbuf of Lexing.lexbuf + +exception Internal_error of error_msg +exception NoMoreData + +let xml_error = ref (fun _ -> assert false) +let file_not_found = ref (fun _ -> assert false) + +let is_blank s = + let len = String.length s in + let break = ref true in + let i = ref 0 in + while !break && !i < len do + let c = s.[!i] in + (* no '\r' because we replaced them in the lexer *) + if c = ' ' || c = '\n' || c = '\t' then incr i + else break := false + done; + !i = len + +let _raises e f = + xml_error := e; + file_not_found := f + +let make source = + let source = match source with + | SChannel chan -> Lexing.from_channel chan + | SString s -> Lexing.from_string s + | SLexbuf lexbuf -> lexbuf + in + let () = Xml_lexer.init source in + { + check_eof = false; + concat_pcdata = true; + source = source; + stack = Stack.create (); + } + +let check_eof p v = p.check_eof <- v + +let pop s = + try + Stack.pop s.stack + with + Stack.Empty -> + Xml_lexer.token s.source + +let push t s = + Stack.push t s.stack + +let canonicalize l = + let has_elt = List.exists (function Element _ -> true | _ -> false) l in + if has_elt then List.filter (function PCData s -> not (is_blank s) | _ -> true) l + else l + +let rec read_xml do_not_canonicalize s = + let rec read_node s = + match pop s with + | Xml_lexer.PCData s -> PCData s + | Xml_lexer.Tag (tag, attr, true) -> Element (tag, attr, []) + | Xml_lexer.Tag (tag, attr, false) -> + let elements = read_elems tag s in + let elements = + if do_not_canonicalize then elements else canonicalize elements + in + Element (tag, attr, elements) + | t -> + push t s; + raise NoMoreData + + and read_elems tag s = + let elems = ref [] in + (try + while true do + let node = read_node s in + match node, !elems with + | PCData c , (PCData c2) :: q -> + elems := PCData (c2 ^ c) :: q + | _, l -> + elems := node :: l + done + with + NoMoreData -> ()); + match pop s with + | Xml_lexer.Endtag s when s = tag -> List.rev !elems + | t -> raise (Internal_error (EndOfTagExpected tag)) + in + match read_node s with + | (Element _) as node -> + node + | PCData c -> + if is_blank c then + read_xml do_not_canonicalize s + else + raise (Xml_lexer.Error Xml_lexer.ENodeExpected) + +let convert = function + | Xml_lexer.EUnterminatedComment -> UnterminatedComment + | Xml_lexer.EUnterminatedString -> UnterminatedString + | Xml_lexer.EIdentExpected -> IdentExpected + | Xml_lexer.ECloseExpected -> CloseExpected + | Xml_lexer.ENodeExpected -> NodeExpected + | Xml_lexer.EAttributeNameExpected -> AttributeNameExpected + | Xml_lexer.EAttributeValueExpected -> AttributeValueExpected + | Xml_lexer.EUnterminatedEntity -> UnterminatedEntity + +let error_of_exn xparser = function + | NoMoreData when pop xparser = Xml_lexer.Eof -> Empty + | NoMoreData -> NodeExpected + | Internal_error e -> e + | Xml_lexer.Error e -> convert e + | e -> + (*let e = Errors.push e in: We do not record backtrace here. *) + raise e + +let do_parse do_not_canonicalize xparser = + try + Xml_lexer.init xparser.source; + let x = read_xml do_not_canonicalize xparser in + if xparser.check_eof && pop xparser <> Xml_lexer.Eof then raise (Internal_error EOFExpected); + Xml_lexer.close (); + x + with any -> + Xml_lexer.close (); + raise (!xml_error (error_of_exn xparser any) xparser.source) + +let parse ?(do_not_canonicalize=false) p = + do_parse do_not_canonicalize p + +let error_msg = function + | UnterminatedComment -> "Unterminated comment" + | UnterminatedString -> "Unterminated string" + | UnterminatedEntity -> "Unterminated entity" + | IdentExpected -> "Ident expected" + | CloseExpected -> "Element close expected" + | NodeExpected -> "Xml node expected" + | AttributeNameExpected -> "Attribute name expected" + | AttributeValueExpected -> "Attribute value expected" + | EndOfTagExpected tag -> sprintf "End of tag expected : '%s'" tag + | EOFExpected -> "End of file expected" + | Empty -> "Empty" + +let error (msg,pos) = + if pos.emin = pos.emax then + sprintf "%s line %d character %d" (error_msg msg) pos.eline + (pos.emin - pos.eline_start) + else + sprintf "%s line %d characters %d-%d" (error_msg msg) pos.eline + (pos.emin - pos.eline_start) (pos.emax - pos.eline_start) + +let line e = e.eline + +let range e = + e.emin - e.eline_start , e.emax - e.eline_start + +let abs_range e = + e.emin , e.emax + +let pos source = + let line, lstart, min, max = Xml_lexer.pos source in + { + eline = line; + eline_start = lstart; + emin = min; + emax = max; + } + +let () = _raises (fun x p -> + (* local cast : Xml.error_msg -> error_msg *) + Error (x, pos p)) + (fun f -> File_not_found f) diff --git a/ide/xml_parser.mli b/ide/xml_parser.mli new file mode 100644 index 0000000000..ac2eab352f --- /dev/null +++ b/ide/xml_parser.mli @@ -0,0 +1,106 @@ +(* + * Xml Light, an small Xml parser/printer with DTD support. + * Copyright (C) 2003 Nicolas Cannasse (ncannasse@motion-twin.com) + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License as published by the Free Software Foundation; either + * version 2.1 of the License, or (at your option) any later version. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + *) + +(** Xml Light Parser + + While basic parsing functions can be used in the {!Xml} module, this module + is providing a way to create, configure and run an Xml parser. + +*) + + +(** An Xml node is either + [Element (tag-name, attributes, children)] or [PCData text] *) +type xml = Xml_datatype.xml + +(** Abstract type for an Xml parser. *) +type t + +(** {6:exc Xml Exceptions} *) + +(** Several exceptions can be raised when parsing an Xml document : {ul + {li {!Xml.Error} is raised when an xml parsing error occurs. the + {!Xml.error_msg} tells you which error occurred during parsing + and the {!Xml.error_pos} can be used to retrieve the document + location where the error occurred at.} + {li {!Xml.File_not_found} is raised when an error occurred while + opening a file with the {!Xml.parse_file} function.} + } + *) + +type error_pos + +type error_msg = + | UnterminatedComment + | UnterminatedString + | UnterminatedEntity + | IdentExpected + | CloseExpected + | NodeExpected + | AttributeNameExpected + | AttributeValueExpected + | EndOfTagExpected of string + | EOFExpected + | Empty + +type error = error_msg * error_pos + +exception Error of error + +exception File_not_found of string + +(** Get a full error message from an Xml error. *) +val error : error -> string + +(** Get the Xml error message as a string. *) +val error_msg : error_msg -> string + +(** Get the line the error occurred at. *) +val line : error_pos -> int + +(** Get the relative character range (in current line) the error occurred at.*) +val range : error_pos -> int * int + +(** Get the absolute character range the error occurred at. *) +val abs_range : error_pos -> int * int + +val pos : Lexing.lexbuf -> error_pos + +(** Several kind of resources can contain Xml documents. *) +type source = +| SChannel of in_channel +| SString of string +| SLexbuf of Lexing.lexbuf + +(** This function returns a new parser with default options. *) +val make : source -> t + +(** When a Xml document is parsed, the parser may check that the end of the + document is reached, so for example parsing ["<A/><B/>"] will fail instead + of returning only the A element. You can turn on this check by setting + [check_eof] to [true] {i (by default, check_eof is false, unlike + in the original Xmllight)}. *) +val check_eof : t -> bool -> unit + +(** Once the parser is configured, you can run the parser on a any kind + of xml document source to parse its contents into an Xml data structure. + + When [do_not_canonicalize] is set, the XML document is given as + is, without trying to remove blank PCDATA elements. *) +val parse : ?do_not_canonicalize:bool -> t -> xml diff --git a/ide/xml_printer.ml b/ide/xml_printer.ml new file mode 100644 index 0000000000..40ab4ce9cb --- /dev/null +++ b/ide/xml_printer.ml @@ -0,0 +1,145 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +open Xml_datatype + +type xml = Xml_datatype.xml + +type target = TChannel of out_channel | TBuffer of Buffer.t + +type t = target + +let make x = x + +let buffer_pcdata tmp text = + let puts = Buffer.add_string tmp in + let putc = Buffer.add_char tmp in + let l = String.length text in + for p = 0 to l-1 do + match text.[p] with + | ' ' -> puts " "; + | '>' -> puts ">" + | '<' -> puts "<" + | '&' -> + if p < l - 1 && text.[p + 1] = '#' then + putc '&' + else + puts "&" + | '\'' -> puts "'" + | '"' -> puts """ + | c -> putc c + done + +let buffer_attr tmp (n,v) = + let puts = Buffer.add_string tmp in + let putc = Buffer.add_char tmp in + putc ' '; + puts n; + puts "=\""; + let l = String.length v in + for p = 0 to l - 1 do + match v.[p] with + | '\\' -> puts "\\\\" + | '"' -> puts "\\\"" + | '<' -> puts "<" + | '&' -> puts "&" + | c -> putc c + done; + putc '"' + +let to_buffer tmp x = + let pcdata = ref false in + let puts = Buffer.add_string tmp in + let putc = Buffer.add_char tmp in + let rec loop = function + | Element (tag,alist,[]) -> + putc '<'; + puts tag; + List.iter (buffer_attr tmp) alist; + puts "/>"; + pcdata := false; + | Element (tag,alist,l) -> + putc '<'; + puts tag; + List.iter (buffer_attr tmp) alist; + putc '>'; + pcdata := false; + List.iter loop l; + puts "</"; + puts tag; + putc '>'; + pcdata := false; + | PCData text -> + if !pcdata then putc ' '; + buffer_pcdata tmp text; + pcdata := true; + in + loop x + +let pcdata_to_string s = + let b = Buffer.create 13 in + buffer_pcdata b s; + Buffer.contents b + +let to_string x = + let b = Buffer.create 200 in + to_buffer b x; + Buffer.contents b + +let to_string_fmt x = + let tmp = Buffer.create 200 in + let puts = Buffer.add_string tmp in + let putc = Buffer.add_char tmp in + let rec loop ?(newl=false) tab = function + | Element (tag, alist, []) -> + puts tab; + putc '<'; + puts tag; + List.iter (buffer_attr tmp) alist; + puts "/>"; + if newl then putc '\n'; + | Element (tag, alist, [PCData text]) -> + puts tab; + putc '<'; + puts tag; + List.iter (buffer_attr tmp) alist; + puts ">"; + buffer_pcdata tmp text; + puts "</"; + puts tag; + putc '>'; + if newl then putc '\n'; + | Element (tag, alist, l) -> + puts tab; + putc '<'; + puts tag; + List.iter (buffer_attr tmp) alist; + puts ">\n"; + List.iter (loop ~newl:true (tab^" ")) l; + puts tab; + puts "</"; + puts tag; + putc '>'; + if newl then putc '\n'; + | PCData text -> + buffer_pcdata tmp text; + if newl then putc '\n'; + in + loop "" x; + Buffer.contents tmp + +let print t xml = + let tmp, flush = match t with + | TChannel oc -> + let b = Buffer.create 200 in + b, (fun () -> Buffer.output_buffer oc b; flush oc) + | TBuffer b -> + b, (fun () -> ()) + in + to_buffer tmp xml; + flush () diff --git a/ide/xml_printer.mli b/ide/xml_printer.mli new file mode 100644 index 0000000000..f24f51fff5 --- /dev/null +++ b/ide/xml_printer.mli @@ -0,0 +1,29 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +type xml = Xml_datatype.xml + +type t +type target = TChannel of out_channel | TBuffer of Buffer.t + +val make : target -> t + +(** Print the xml data structure to a source into a compact xml string (without + any user-readable formating ). *) +val print : t -> xml -> unit + +(** Print the xml data structure into a compact xml string (without + any user-readable formating ). *) +val to_string : xml -> string + +(** Print the xml data structure into an user-readable string with + tabs and lines break between different nodes. *) +val to_string_fmt : xml -> string + +(** Print PCDATA as a string by escaping XML entities. *) +val pcdata_to_string : string -> string diff --git a/ide/xmlprotocol.ml b/ide/xmlprotocol.ml index 232630e5b2..aecb317bcb 100644 --- a/ide/xmlprotocol.ml +++ b/ide/xmlprotocol.ml @@ -39,7 +39,7 @@ let to_search_cst = do_match "search_cst" (fun s args -> match s with | "subtype_pattern" -> SubType_Pattern (to_string (singleton args)) | "in_module" -> In_Module (to_list to_string (singleton args)) | "include_blacklist" -> Include_Blacklist - | _ -> raise Marshal_error) + | x -> raise (Marshal_error("search",PCData x))) let of_coq_object f ans = let prefix = of_list of_string ans.coq_object_prefix in @@ -56,7 +56,7 @@ let to_coq_object f = function coq_object_qualid = qualid; coq_object_object = obj; } -| _ -> raise Marshal_error +| x -> raise (Marshal_error("coq_object",x)) let of_option_value = function | IntValue i -> constructor "option_value" "intvalue" [of_option of_int i] @@ -68,7 +68,7 @@ let to_option_value = do_match "option_value" (fun s args -> match s with | "boolvalue" -> BoolValue (to_bool (singleton args)) | "stringvalue" -> StringValue (to_string (singleton args)) | "stringoptvalue" -> StringOptValue (to_option to_string (singleton args)) - | _ -> raise Marshal_error) + | x -> raise (Marshal_error("*value",PCData x))) let of_option_state s = Element ("option_state", [], [ @@ -82,8 +82,20 @@ let to_option_state = function opt_depr = to_bool depr; opt_name = to_string name; opt_value = to_option_value value } - | _ -> raise Marshal_error + | x -> raise (Marshal_error("option_state",x)) +let to_stateid = function + | Element ("state_id",["val",i],[]) -> + let id = int_of_string i in + Stateid.of_int id + | _ -> raise (Invalid_argument "to_state_id") + +let of_stateid i = Element ("state_id",["val",string_of_int (Stateid.to_int i)],[]) + +let of_richpp x = Element ("richpp", [], [Richpp.repr x]) +let to_richpp xml = match xml with + | Element ("richpp", [], [x]) -> Richpp.richpp_of_xml x + | x -> raise Serialize.(Marshal_error("richpp",x)) let of_value f = function | Good x -> Element ("value", ["val", "good"], [f x]) @@ -91,8 +103,9 @@ let of_value f = function let loc = match loc with | None -> [] | Some (s, e) -> [("loc_s", string_of_int s); ("loc_e", string_of_int e)] in - let id = Stateid.to_xml id in - Element ("value", ["val", "fail"] @ loc, [id; Richpp.of_richpp msg]) + let id = of_stateid id in + Element ("value", ["val", "fail"] @ loc, [id; of_richpp msg]) + let to_value f = function | Element ("value", attrs, l) -> let ans = massoc "val" attrs in @@ -103,14 +116,14 @@ let to_value f = function let loc_s = int_of_string (Serialize.massoc "loc_s" attrs) in let loc_e = int_of_string (Serialize.massoc "loc_e" attrs) in Some (loc_s, loc_e) - with Marshal_error | Failure _ -> None + with Marshal_error _ | Failure _ -> None in - let (id, msg) = match l with [id; msg] -> (id, msg) | _ -> raise Marshal_error in - let id = Stateid.of_xml id in - let msg = Richpp.to_richpp msg in + let (id, msg) = match l with [id; msg] -> (id, msg) | _ -> raise (Marshal_error("val",PCData "no id attribute")) in + let id = to_stateid id in + let msg = to_richpp msg in Fail (id, loc, msg) - else raise Marshal_error -| _ -> raise Marshal_error + else raise (Marshal_error("good or fail",PCData ans)) +| x -> raise (Marshal_error("value",x)) let of_status s = let of_so = of_option of_string in @@ -126,25 +139,25 @@ let to_status = function status_proofname = to_option to_string name; status_allproofs = to_list to_string prfs; status_proofnum = to_int pnum; } - | _ -> raise Marshal_error + | x -> raise (Marshal_error("status",x)) let of_evar s = Element ("evar", [], [PCData s.evar_info]) let to_evar = function | Element ("evar", [], data) -> { evar_info = raw_string data; } - | _ -> raise Marshal_error + | x -> raise (Marshal_error("evar",x)) let of_goal g = - let hyp = of_list Richpp.of_richpp g.goal_hyp in - let ccl = Richpp.of_richpp g.goal_ccl in + let hyp = of_list of_richpp g.goal_hyp in + let ccl = of_richpp g.goal_ccl in let id = of_string g.goal_id in Element ("goal", [], [id; hyp; ccl]) let to_goal = function | Element ("goal", [], [id; hyp; ccl]) -> - let hyp = to_list Richpp.to_richpp hyp in - let ccl = Richpp.to_richpp ccl in + let hyp = to_list to_richpp hyp in + let ccl = to_richpp ccl in let id = to_string id in { goal_hyp = hyp; goal_ccl = ccl; goal_id = id; } - | _ -> raise Marshal_error + | x -> raise (Marshal_error("goal",x)) let of_goals g = let of_glist = of_list of_goal in @@ -162,7 +175,7 @@ let to_goals = function let given_up = to_list to_goal given_up in { fg_goals = fg; bg_goals = bg; shelved_goals = shelf; given_up_goals = given_up } - | _ -> raise Marshal_error + | x -> raise (Marshal_error("goals",x)) let of_coq_info info = let version = of_string info.coqtop_version in @@ -176,7 +189,7 @@ let to_coq_info = function protocol_version = to_string protocol; release_date = to_string release; compile_date = to_string compile; } - | _ -> raise Marshal_error + | x -> raise (Marshal_error("coq_info",x)) end include Xml_marshalling @@ -286,7 +299,7 @@ end = struct | Coq_object t -> (of_coq_object (convert t)) | Pair (t1,t2) -> (of_pair (convert t1) (convert t2)) | Union (t1,t2) -> (of_union (convert t1) (convert t2)) - | State_id -> Stateid.to_xml + | State_id -> of_stateid | Search_cst -> of_search_cst in convert ty @@ -309,7 +322,7 @@ end = struct | Coq_object t -> (to_coq_object (convert t)) | Pair (t1,t2) -> (to_pair (convert t1) (convert t2)) | Union (t1,t2) -> (to_union (convert t1) (convert t2)) - | State_id -> Stateid.of_xml + | State_id -> to_stateid | Search_cst -> to_search_cst in convert ty @@ -422,7 +435,7 @@ end = struct (pr_xml (of_bool true)) (pr_xml (of_bool false)); Printf.printf "%s:\n\n%s\n\n" (print_val_t String) (pr_xml (of_string "hello")); Printf.printf "%s:\n\n%s\n\n" (print_val_t Int) (pr_xml (of_int 256)); - Printf.printf "%s:\n\n%s\n\n" (print_val_t State_id) (pr_xml (Stateid.to_xml Stateid.initial)); + Printf.printf "%s:\n\n%s\n\n" (print_val_t State_id) (pr_xml (of_stateid Stateid.initial)); Printf.printf "%s:\n\n%s\n\n" (print_val_t (List Int)) (pr_xml (of_list of_int [3;4;5])); Printf.printf "%s:\n\n%s\n%s\n\n" (print_val_t (Option Int)) (pr_xml (of_option of_int (Some 3))) (pr_xml (of_option of_int None)); @@ -594,7 +607,7 @@ let abstract_eval_call : type a. _ -> a call -> a value = fun handler c -> | PrintAst x -> mkGood (handler.print_ast x) | Annotate x -> mkGood (handler.annotate x) with any -> - let any = Errors.push any in + let any = CErrors.push any in Fail (handler.handle_exn any) (** brain dead code, edit if protocol messages are added/removed *) @@ -682,7 +695,7 @@ let to_call : xml -> unknown_call = | "StopWorker" -> Unknown (StopWorker (mkCallArg stop_worker_sty_t a)) | "PrintAst" -> Unknown (PrintAst (mkCallArg print_ast_sty_t a)) | "Annotate" -> Unknown (Annotate (mkCallArg annotate_sty_t a)) - | _ -> raise Marshal_error) + | x -> raise (Marshal_error("call",PCData x))) (** Debug printing *) @@ -750,4 +763,130 @@ let document to_string_fmt = (Fail (Stateid.initial,Some (15,34),Richpp.richpp_of_string "error message")))); document_type_encoding to_string_fmt +(* Moved from feedback.mli : This is IDE specific and we don't want to + pollute the core with it *) + +open Feedback + +let of_message_level = function + | Debug -> + Serialize.constructor "message_level" "debug" [] + | Info -> Serialize.constructor "message_level" "info" [] + | Notice -> Serialize.constructor "message_level" "notice" [] + | Warning -> Serialize.constructor "message_level" "warning" [] + | Error -> Serialize.constructor "message_level" "error" [] +let to_message_level = + Serialize.do_match "message_level" (fun s args -> match s with + | "debug" -> Debug + | "info" -> Info + | "notice" -> Notice + | "warning" -> Warning + | "error" -> Error + | x -> raise Serialize.(Marshal_error("error level",PCData x))) + +let of_message lvl loc msg = + let lvl = of_message_level lvl in + let xloc = of_option of_loc loc in + let content = of_richpp msg in + Xml_datatype.Element ("message", [], [lvl; xloc; content]) + +let to_message xml = match xml with + | Xml_datatype.Element ("message", [], [lvl; xloc; content]) -> + Message(to_message_level lvl, to_option to_loc xloc, to_richpp content) + | x -> raise (Marshal_error("message",x)) + +let is_message xml = + try begin match to_message xml with + | Message(l,c,m) -> Some (l,c,m) + | _ -> None + end with | Marshal_error _ -> None + +let to_feedback_content = do_match "feedback_content" (fun s a -> match s,a with + | "addedaxiom", _ -> AddedAxiom + | "processed", _ -> Processed + | "processingin", [where] -> ProcessingIn (to_string where) + | "incomplete", _ -> Incomplete + | "complete", _ -> Complete + | "globref", [loc; filepath; modpath; ident; ty] -> + GlobRef(to_loc loc, to_string filepath, + to_string modpath, to_string ident, to_string ty) + | "globdef", [loc; ident; secpath; ty] -> + GlobDef(to_loc loc, to_string ident, to_string secpath, to_string ty) + | "inprogress", [n] -> InProgress (to_int n) + | "workerstatus", [ns] -> + let n, s = to_pair to_string to_string ns in + WorkerStatus(n,s) + | "goals", [loc;s] -> Goals (to_loc loc, to_string s) + | "custom", [loc;name;x]-> Custom (to_loc loc, to_string name, x) + | "filedependency", [from; dep] -> + FileDependency (to_option to_string from, to_string dep) + | "fileloaded", [dirpath; filename] -> + FileLoaded (to_string dirpath, to_string filename) + | "message", [x] -> to_message x + | x,l -> raise (Marshal_error("feedback_content",PCData (x ^ " with attributes " ^ string_of_int (List.length l))))) + +let of_feedback_content = function + | AddedAxiom -> constructor "feedback_content" "addedaxiom" [] + | Processed -> constructor "feedback_content" "processed" [] + | ProcessingIn where -> + constructor "feedback_content" "processingin" [of_string where] + | Incomplete -> constructor "feedback_content" "incomplete" [] + | Complete -> constructor "feedback_content" "complete" [] + | GlobRef(loc, filepath, modpath, ident, ty) -> + constructor "feedback_content" "globref" [ + of_loc loc; + of_string filepath; + of_string modpath; + of_string ident; + of_string ty ] + | GlobDef(loc, ident, secpath, ty) -> + constructor "feedback_content" "globdef" [ + of_loc loc; + of_string ident; + of_string secpath; + of_string ty ] + | InProgress n -> constructor "feedback_content" "inprogress" [of_int n] + | WorkerStatus(n,s) -> + constructor "feedback_content" "workerstatus" + [of_pair of_string of_string (n,s)] + | Goals (loc,s) -> + constructor "feedback_content" "goals" [of_loc loc;of_string s] + | Custom (loc, name, x) -> + constructor "feedback_content" "custom" [of_loc loc; of_string name; x] + | FileDependency (from, depends_on) -> + constructor "feedback_content" "filedependency" [ + of_option of_string from; + of_string depends_on] + | FileLoaded (dirpath, filename) -> + constructor "feedback_content" "fileloaded" [ + of_string dirpath; + of_string filename ] + | Message (l,loc,m) -> constructor "feedback_content" "message" [ of_message l loc m ] + +let of_edit_or_state_id = function + | Edit id -> ["object","edit"], of_edit_id id + | State id -> ["object","state"], of_stateid id + +let of_feedback msg = + let content = of_feedback_content msg.contents in + let obj, id = of_edit_or_state_id msg.id in + let route = string_of_int msg.route in + Element ("feedback", obj @ ["route",route], [id;content]) + +let to_feedback xml = match xml with + | Element ("feedback", ["object","edit";"route",route], [id;content]) -> { + id = Edit(to_edit_id id); + route = int_of_string route; + contents = to_feedback_content content } + | Element ("feedback", ["object","state";"route",route], [id;content]) -> { + id = State(to_stateid id); + route = int_of_string route; + contents = to_feedback_content content } + | x -> raise (Marshal_error("feedback",x)) + +let is_feedback = function + | Element ("feedback", _, _) -> true + | _ -> false + (* vim: set foldmethod=marker: *) + diff --git a/ide/xmlprotocol.mli b/ide/xmlprotocol.mli index 265a50c47c..1bb9989704 100644 --- a/ide/xmlprotocol.mli +++ b/ide/xmlprotocol.mli @@ -56,3 +56,17 @@ val document : (xml -> string) -> unit val pr_call : 'a call -> string val pr_value : 'a value -> string val pr_full_value : 'a call -> 'a value -> string + +(** * Serialization of rich documents *) +val of_richpp : Richpp.richpp -> Xml_datatype.xml +val to_richpp : Xml_datatype.xml -> Richpp.richpp + +(** * Serializaiton of feedback *) +val of_feedback : Feedback.feedback -> xml +val to_feedback : xml -> Feedback.feedback +val is_feedback : xml -> bool + +val is_message : xml -> (Feedback.level * Loc.t option * Richpp.richpp) option +val of_message : Feedback.level -> Loc.t option -> Richpp.richpp -> xml +(* val to_message : xml -> Feedback.message *) + |