Commits

Sébastien Ferré  committed 3e84300

Improved display of operators, and simplification of GUI.

  • Participants
  • Parent commits 4374120

Comments (0)

Files changed (2)

 let display_ctx_markup (buf : Buffer.t) =
   object (self)
     inherit Lisql_display.markup_ctx
-    method string s = Buffer.add_string buf s
+    method private string s = Buffer.add_string buf s
     method private span la s =
       self#string "<span";
       List.iter (fun (a,v) -> self#string " "; self#string a; self#string "=\""; self#string v; self#string "\"") la;
       self#string ">";
       self#string s;
       self#string "</span>"
+    method kwd s =
+      self#string (Glib.Markup.escape_text s)
     method var v =
       self#span [("foreground",str_color_variable)] (Glib.Markup.escape_text ("?" ^ v))
     method uri u k s iopt =
   object (self)
     inherit Lisql_display.markup_ctx
 
-    method string s = buffer#insert s
+    method private string s = buffer#insert s
+    method kwd s =
+      buffer#insert s
     method var v =
       buffer#insert ~tags:[tag_variable] ("?" ^ v)
     method uri u k s iopt =
   end
 
 
-(*
-let preview_of_uri ~obs uri =
-  Lisql.Pretty.print_to_string (history#store#preview_uri ~obs) uri
-
-let preview_of_name ~obs n =
-  Lisql.Pretty.print_to_string_indent (history#store#preview_name ~obs) n
-
-let preview_of_description ~obs np =
-  Lisql.Pretty.print_to_string_indent (Lisql.Pretty.print_s1 ~obs history#store ~focus:None) np
-
-let preview_of_assertion_indent_with_tags ~obs (a,foc) =
-  Lisql.Pretty.print_to_string_indent_with_tags (history#store#preview_assertion ~obs ~focus:(Some foc)) a
-*)
-
 let picture_of_name ~obs name =
   history#store#get_image ~obs name
 
 let _ = file_menu_factory#add_separator ()
 let import_file_menu = file_menu_factory#add_submenu "Import"
 let import_file_factory = new GMenu.factory import_file_menu
-let cmd_import_logfile = import_file_factory#add_item "Import Sewelis log..."
 let cmd_import_from_rdf = import_file_factory#add_item "Import RDF..."
 (*let cmd_import_from_xml = import_file_factory#add_item "Import XML..."*)
 let cmd_import_from_uri = import_file_factory#add_item "Import URI..."
 
 class text_query_callbacks =
   object
-    method toggle_edit : Lisql.AST.focus -> unit = fun _ -> ()
     method ctx_menu : string -> GMenu.menu -> unit = fun _ _ -> ()
     method focus : stat:bool -> Lisql.AST.focus -> unit = fun ~stat _ -> ()
     method transf : ?msg:string -> Lisql.AST.transf -> Lisql.AST.focus -> unit = fun ?msg _ _  -> ()
   let button_incomplete = GButton.button ~label:"..." ~packing:vbox_buttons#pack () in
 *)
   object (self)
-    val mutable edit_mode = false
 (*    val mutable clipboard = Lisql.AST.top_p1 *) (*TODO*)
     val h_foc_offsets = Hashtbl.create 7
 
     method transf f =
       callbacks#transf f history#current#focus
 
-    method edit_mode = edit_mode
-
-    method toggle_edit () =
-      if edit_mode
-      then
-	try
-	  let assertion = Lisql.Syntax.assertion_of_string (buffer # get_text ()) in
-	  edit_mode <- false;
-	  view # set_editable false;
-	  view # set_cursor_visible false;
-	  callbacks#toggle_edit (Lisql.AST.focus_of_s assertion : Lisql.AST.focus)
-	with Stream.Error msg ->
-	  syntax_error_logic msg
-      else begin
-	edit_mode <- true;
-	view # set_editable true;
-	view # set_cursor_visible true;
-	self # refresh
-      end
-
     method button_press ev =
       let button = GdkEvent.Button.button ev in
-      if (button = 1 || button = 2) && not edit_mode then
+      if (button = 1 || button = 2) then
 	try
 	  let win =
 	    match view#get_window `WIDGET with
       view # event # connect # button_press ~callback:self#button_press;
 
       (* tooltips *)
-(*
-   tooltips#set_tip view#coerce
-   ~text:"This is the query area that you can edit directly or by activating features in the navigation window";
-   tooltips#set_tip button_edit#coerce
-   ~text:"Edit the current query";
- *)
       tooltips#set_tip cmd_up#coerce
 	~text:"Move the focus up";
       tooltips#set_tip cmd_union#coerce
 let menu_toggle_symmetric uri =
   history#store#toggle_type ~src:!current_src (Rdf.URI uri) Owl.uri_SymmetricProperty
 
-(*
-let menu_import_logfile () =
-  file_dialog ~title:"Import a Sewelis logfile"
-    ~callback:(fun path ->
-      awaken (fun () -> history#store#import_logfile ~src:!current_src path) refresh_force)
-    ()
-*)
 
 let menu_import_rdf () =
   file_dialog ~title:"Import an RDF document"
   let cmd_set_home = query_menu_factory#add_item "Define as the home query" in
   let cmd_add_bookmark = query_menu_factory#add_item "Add to bookmarks" in
   let cmd_define_struct = query_menu_factory#add_item "Define a structure..." in
-  let _ = query_menu_factory#add_separator () in
-  let cmd_edit_apply = query_menu_factory#add_item (if wq#edit_mode then "Apply" else "Edit") in
   cmd_assert#connect#activate ~callback:menu_assert_query;
   cmd_retract#connect#activate ~callback:menu_retract_query;
   cmd_set_home#connect#activate ~callback:menu_set_home_query;
   cmd_add_bookmark#connect#activate ~callback:menu_add_bookmark;
   cmd_define_struct#connect#activate ~callback:menu_define_struct;
-  cmd_edit_apply#connect#activate ~callback:wq#toggle_edit;
   ()
 
 
    cmd_saveas#connect#activate ~callback:menu_saveas;
    cmd_close#connect#activate ~callback:menu_close;
  *)
-(*  cmd_import_logfile#connect#activate ~callback:menu_import_logfile; *)
   cmd_import_from_rdf#connect#activate ~callback:menu_import_rdf;
 (*  cmd_import_from_xml#connect#activate ~callback:menu_import_xml; *)
   cmd_import_from_uri#connect#activate ~callback:menu_import_uri;
 
   wq#connect
     (object
-      method toggle_edit = fun foc -> menu_cd (Some foc)
       method ctx_menu = query_menu_clicked
       method focus = focus_query
       method transf = query_transf_focus

File src/lisql_display.ml

 and display_p2 ~obs store k prec = function
   | Univ -> assert false
   | Self -> [`Kwd "is"]
-  | RAtom (ori,uri) ->
-      ( match string_of_uri_role ~obs store ori uri with
-      | Fwd, s -> [`URI (uri, `Property, s, None)]
-      | Bwd, s -> [`Kwd "is"; `Space; `URI (uri, `Property, s, None); `Space; `Kwd "of"] )
-(*
-  | RAtom (Fwd,p) -> `Kwd "has" :: `Space :: display_uri ~obs store `Property p
-  | RAtom (Bwd,p) -> `Kwd "is a" :: `Space :: display_uri ~obs store `Property p @ [`Space; `Kwd "of"]
-*)
+  | RAtom (ori,uri) -> display_p2_atom ~obs store ori uri
   | Opt r1 -> `Kwd "is or" :: `Space :: display_p2 ~obs store (Opt0 (r1,k)) prec_atom r1
   | Trans r1 -> display_p2 ~obs store (Trans0 (r1,k)) prec_atom r1 @ [`Space; `Kwd "transitively"]
   | Direct r1 -> display_p2 ~obs store (Direct0 (r1,k)) prec_atom r1 @ [`Space; `Kwd "directly"]
 	[`Not (display_p2 ~obs store (RNot0 (r1,k)) prec_atom r1)]
   | RMaybe r1 -> brackets_opt prec prec_not
 	[`Maybe (display_p2 ~obs store (RMaybe0 (r1,k)) prec_atom r1)]
+and display_p2_atom ~obs store ori p =
+  if p = Operator.leq then
+    match ori with
+    | Fwd -> [`Kwd "\226\137\164"] (*"<="*)
+    | Bwd -> [`Kwd "\226\137\165"] (*">="*)
+  else if p = Operator.lt then
+    match ori with
+    | Fwd -> [`Kwd "<"]
+    | Bwd -> [`Kwd ">"]
+  else if p = Operator.matches then
+    match ori with
+    | Fwd -> [`Kwd "matches"]
+    | Bwd -> [`Kwd "matched by"]
+  else if p = Operator.contains then
+    match ori with
+    | Fwd -> [`Kwd "contains"]
+    | Bwd -> [`Kwd "contained by"]
+  else
+    match string_of_uri_role ~obs store ori p with
+    | Fwd, s -> [`URI (p, `Property, s, None)]
+    | Bwd, s -> [`Kwd "is"; `Space; `URI (p, `Property, s, None); `Space; `Kwd "of"]
+(*
+  | RAtom (Fwd,p) -> `Kwd "has" :: `Space :: display_uri ~obs store `Property p
+  | RAtom (Bwd,p) -> `Kwd "is a" :: `Space :: display_uri ~obs store `Property p @ [`Space; `Kwd "of"]
+*)
 and display_struct_arg ~obs store k funct args arg_opt =
   [`Pair (false,
 	  [`URI (funct, `Functor, string_of_uri ~obs store funct, None);
     method open_focus (foc : focus) = ()
     method close_focus (foc : focus) = ()
 
-    method virtual string : string -> unit
-    method newline = self#string nl
-    method space = self#string " "
+    method virtual kwd : string -> unit
+    method newline = self#kwd nl
+    method space = self#kwd " "
     method virtual var : var -> unit
     method virtual uri : Uri.t -> kind -> string -> Uri.t option -> unit
     method virtual plain : string -> string -> unit
   | tok::l -> markup_token after_indent ctx tok; List.iter (markup_token false ctx) l
 and markup_token after_indent ctx = function
   | `Space -> ctx#space
-  | `Kwd s -> ctx#string s
+  | `Kwd s -> ctx#kwd s
   | `Var v -> ctx#var v
   | `URI (uri,kind,s,img) -> ctx#uri uri kind s img
   | `Plain (s,lang) -> ctx#plain s lang
   | `Typed (s, uri_dt, s_dt) -> ctx#typed s uri_dt s_dt
   | `Xml xml -> ctx#xml xml
-  | `Tuple [] -> ctx#string "()"
+  | `Tuple [] -> ctx#kwd "()"
   | `Tuple (toks::ltoks) ->
       if List.for_all is_short_display (toks::ltoks)
       then begin
-	ctx#string "(";
+	ctx#kwd "(";
 	markup false ctx toks;
-	List.iter (fun toks -> ctx#string ", "; markup false ctx toks) ltoks;
-	ctx#string ")" end
+	List.iter (fun toks -> ctx#kwd ", "; markup false ctx toks) ltoks;
+	ctx#kwd ")" end
       else begin
-	ctx#string "(";
+	ctx#kwd "(";
 	markup true ctx#indent toks;
-	List.iter (fun toks -> ctx#string ","; markup true ctx#indent toks) ltoks;
-	ctx#string ")"
+	List.iter (fun toks -> ctx#kwd ","; markup true ctx#indent toks) ltoks;
+	ctx#kwd ")"
       end
   | `List [] -> assert false
   | `List (toks::ltoks) ->
   | `And [] -> assert false
   | `And (toks::ltoks) ->
       markup false ctx toks;
-      List.iter (fun toks -> ctx#string " and "; ctx#newline; markup false ctx toks) ltoks
+      List.iter (fun toks -> ctx#kwd " and "; ctx#newline; markup false ctx toks) ltoks
   | `Or [] -> assert false
   | `Or (toks::ltoks) ->
       markup false ctx toks;
       List.iter
 	(fun toks ->
-	  ctx#newline; ctx#string " or ";
+	  ctx#newline; ctx#kwd " or ";
 	  if is_short_display toks
 	  then markup false ctx toks
 	  else markup true ctx#indent toks)
 	ltoks
   | `Not toks ->
-      ctx#string "not";
+      ctx#kwd "not";
       if is_short_display toks
       then begin ctx#space; markup false ctx toks end
       else markup true ctx#indent toks
   | `Maybe toks ->
-      ctx#string "maybe";
+      ctx#kwd "maybe";
       if is_short_display toks
       then begin ctx#space; markup false ctx toks end
       else markup true ctx#indent toks
       markup true ctx#indent toks
   | `CurlyBrackets toks ->
       if is_short_display toks
-      then begin ctx#string "{ "; markup false ctx toks; ctx#string " }" end
-      else begin ctx#string "{"; markup true ctx#indent toks; ctx#string " }" end
+      then begin ctx#kwd "{ "; markup false ctx toks; ctx#kwd " }" end
+      else begin ctx#kwd "{"; markup true ctx#indent toks; ctx#kwd " }" end
   | `Pair (force_indent,toks1,toks2) ->
       if not force_indent && is_short_display toks1 && is_short_display toks2
       then begin markup false ctx toks1; ctx#space; markup false ctx toks2 end