Commits

Sébastien Ferré committed ddb3325

Table view of query solutions + ordering/hidding columns + pagging

  • Participants
  • Parent commits 4716c07

Comments (0)

Files changed (6)

 
 
     let rec extension_of_fol ~obs (store : #Store.store) : fol_prop -> Ext.t =
+      (* TODO: return free variables *)
       fun p ->
 	extension_fol_prop ~obs store p
     and extension_fol_prop ~obs store : fol_prop -> fol_ext = function
     let uri_BackwardPropertyEntry = Qname (prefix, "BackwardPropertyEntry")
     let uri_StructureEntry = Qname (prefix, "StructureEntry")
     let uri_EntityEntry = Qname (prefix, "EntityEntry")
+    let uri_AnswerSelection = Qname (prefix, "AnswerSelection")
     let uri_session = Qname (prefix, "session")
     let uri_login = Qname (prefix, "login")
     let uri_date = Qname (prefix, "date")
     method place = place
     method focus = place#focus
     method assertion = place#assertion
+    method answers = place#answers ~obs:Tarpit.blind_observer
     method extents = place#extents ~obs:Tarpit.blind_observer
     method views = views
     method int_preselect = int_preselect
 
     method store = store
 
-    method root : Lisql.AST.focus = Lisql.AST.focus_top
+    method root : Lisql.AST.focus = Lisql.AST.focus_what
 
     method home : Lisql.AST.focus =
       store#get_home_focus ~obs:Tarpit.blind_observer
   let tag_query = buffer # create_tag [`BACKGROUND str_color_query] in (*  [`UNDERLINE `SINGLE] in *)
   let tag_update = buffer # create_tag [`BACKGROUND str_color_update] in
   (* graphical display *)
-  let hbox = GPack.hbox ~spacing:8 ~packing:pack () in
+  let vbox = GPack.vbox ~spacing:8 ~packing:pack () in
+
+  let query_menubar = GMenu.menu_bar ~packing:vbox#pack () in
+  let query_menubar_factory = new GMenu.factory query_menubar in
+
+  let move_menu = query_menubar_factory#add_submenu "Move" in
+  let move_menu_factory = new GMenu.factory move_menu in
+  let cmd_up = move_menu_factory#add_item "Focus Up" in
+
+  let insert_menu = query_menubar_factory#add_submenu "Insert" in
+  let insert_menu_factory = new GMenu.factory insert_menu in
+  let cmd_name = insert_menu_factory#add_item "?X" in
+  let cmd_union = insert_menu_factory#add_item "__ or ?" in
+  let cmd_minus = insert_menu_factory#add_item "__ and not ?" in
+  let cmd_incomplete = insert_menu_factory#add_item "..." in
+
+  let switch_menu = query_menubar_factory#add_submenu "Switch" in
+  let switch_menu_factory = new GMenu.factory switch_menu in
+  let cmd_compl = switch_menu_factory#add_item "not __" in
+  let cmd_every = switch_menu_factory#add_item "every __" in
+  let cmd_only = switch_menu_factory#add_item "only __" in
+  let cmd_quote = switch_menu_factory#add_item "{ __ }" in
+  let cmd_opt = switch_menu_factory#add_item "opt __" in
+  let cmd_trans = switch_menu_factory#add_item "trans __" in
+
+  let other_menu = query_menubar_factory#add_submenu "Other" in
+  let other_menu_factory = new GMenu.factory other_menu in
+  let cmd_describe = other_menu_factory#add_item "Describe" in
+  let cmd_subject = other_menu_factory#add_item "Subject" in
+  let cmd_select = other_menu_factory#add_item "Select" in
+  let cmd_delete = other_menu_factory#add_item "Delete" in
+
   let sw = GBin.scrolled_window ~shadow_type:`ETCHED_IN
-      ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC ~packing:(fun w -> hbox#pack ~expand:true ~fill:true w) () in
+      ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC ~packing:(fun w -> vbox#pack ~expand:true ~fill:true w) () in
   let view = GText.view ~buffer:buffer
       ~editable:false
       ~cursor_visible:true
       ~width:width_chars
       ~height:2
       ~packing:(*fun w -> hbox#pack ~expand:true ~fill:true w*)  sw#add () in
+
+(*
   let vbox_buttons = GPack.vbox ~spacing:8 ~packing:hbox#pack () in
   let button_up = GButton.button ~label:"Focus Up" ~packing:vbox_buttons#pack () in
   let button_union = GButton.button ~label:"_ or ?" ~packing:vbox_buttons#pack () in
   let button_select = GButton.button ~label:"Select" ~packing:vbox_buttons#pack () in
   let button_delete = GButton.button ~label:"Delete" ~packing:vbox_buttons#pack () in
   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
 	self#transf Lisql.focus_delete));
       ignore (view#connect#paste_clipboard ~callback:(fun _ ->
 	self#transf (Lisql.focus_default_link history#store clipboard)));
-      button_up # connect # clicked ~callback:
+      cmd_up # connect # activate ~callback:
 	(fun () ->
 	  Logui.item Logui.uri_FocusUp (fun obs -> []);
 	  self#transf Lisql.AST.focus_up);
-      button_union # connect # clicked ~callback:
+      cmd_union # connect # activate ~callback:
 	(fun () ->
 	  Logui.item Logui.uri_Or (fun obs -> []);
 	  self#transf (Lisql.focus_union Lisql.AST.top_p1));
-      button_minus # connect # clicked ~callback:
+      cmd_minus # connect # activate ~callback:
 	(fun () ->
 	  Logui.item Logui.uri_Minus (fun obs -> []);
 	  self#transf (Lisql.focus_minus Lisql.AST.top_p1));
-      button_compl # connect # clicked ~callback:
+      cmd_compl # connect # activate ~callback:
 	(fun () -> 
 	  Logui.item Logui.uri_Not (fun obs -> []);
 	  self#transf Lisql.focus_compl);
-      button_every # connect # clicked ~callback:
+      cmd_every # connect # activate ~callback:
 	(fun () ->
 	  Logui.item Logui.uri_ToggleEvery (fun obs -> []);
 	  self#transf Lisql.focus_toggle_every);
-      button_only # connect # clicked ~callback:
+      cmd_only # connect # activate ~callback:
 	(fun () ->
 	  Logui.item Logui.uri_ToggleOnly (fun obs -> []);
 	  self#transf Lisql.focus_toggle_only);
-      button_subject # connect # clicked ~callback:
+      cmd_subject # connect # activate ~callback:
 	(fun () ->
 	  Logui.item Logui.uri_For (fun obs -> []);
 	  self#transf (Lisql.focus_subject history#current#place#new_var));
-      button_quote # connect # clicked ~callback:
+      cmd_quote # connect # activate ~callback:
 	(fun () ->
 	  Logui.item Logui.uri_QuoteUnquote (fun obs -> []);
 	  self#transf (Lisql.focus_toggle_quote history#store ~src:!current_src));
-      button_opt # connect # clicked ~callback:
+      cmd_opt # connect # activate ~callback:
 	(fun () ->
 	  Logui.item Logui.uri_Opt (fun obs -> []);
 	  self#transf (Lisql.focus_toggle_opt history#store));
-      button_trans # connect # clicked ~callback:
+      cmd_trans # connect # activate ~callback:
 	(fun () ->
 	  Logui.item Logui.uri_Trans (fun obs -> []);
 	  self#transf (Lisql.focus_toggle_trans history#store));
-      button_name # connect # clicked ~callback:
+      cmd_name # connect # activate ~callback:
 	(fun () ->
 	  Logui.item Logui.uri_Name (fun obs -> []);
 	  self#transf (Lisql.focus_name history#store history#current#place#new_var));
-      button_describe # connect # clicked ~callback:
+      cmd_describe # connect # activate ~callback:
 	(fun () ->
 	  Logui.item Logui.uri_Describe (fun obs -> []);
 	  self#transf (Lisql.focus_describe history#store));
-      button_select # connect # clicked ~callback:
+      cmd_select # connect # activate ~callback:
 	(fun () ->
 	  Logui.item Logui.uri_Select (fun obs -> []);
 	  self#transf Lisql.focus_select);
-      button_delete # connect # clicked ~callback:
+      cmd_delete # connect # activate ~callback:
 	(fun () ->
 	  Logui.item Logui.uri_Delete (fun obs -> []);
 	  self#transf Lisql.focus_delete);
-      button_incomplete # connect # clicked ~callback:
+      cmd_incomplete # connect # activate ~callback:
 	(fun () ->
 	  Logui.item Logui.uri_Etc (fun obs -> []);
 	  self#transf (Lisql.focus_inter history#store Lisql.AST.incomplete));
    tooltips#set_tip button_edit#coerce
    ~text:"Edit the current query";
  *)
-      tooltips#set_tip button_up#coerce
+      tooltips#set_tip cmd_up#coerce
 	~text:"Move the focus up";
-      tooltips#set_tip button_union#coerce
+      tooltips#set_tip cmd_union#coerce
 	~text:"Add or create an alternative (or) to the current query focus";
-      tooltips#set_tip button_minus#coerce
+      tooltips#set_tip cmd_minus#coerce
 	~text:"Add or create an exception (and not) to the current query focus";
-      tooltips#set_tip button_compl#coerce
+      tooltips#set_tip cmd_compl#coerce
 	~text:"Apply negation (not) to the current query focus";
-      tooltips#set_tip button_every#coerce
+      tooltips#set_tip cmd_every#coerce
 	~text:"Toggle the use of the 'every' determiner";
-      tooltips#set_tip button_only#coerce
+      tooltips#set_tip cmd_only#coerce
 	~text:"Toggle the use of the 'only' determiner";
-      tooltips#set_tip button_subject#coerce
+      tooltips#set_tip cmd_subject#coerce
 	~text:"Reformulate the sentence so as to put the current focus as subject";
-      tooltips#set_tip button_quote#coerce
+      tooltips#set_tip cmd_quote#coerce
 	~text:"Quote/unquote the subquery at the current focus";
-      tooltips#set_tip button_opt#coerce
+      tooltips#set_tip cmd_opt#coerce
 	~text:"Toggle reflexive closure on the property at the current focus";
-      tooltips#set_tip button_trans#coerce
+      tooltips#set_tip cmd_trans#coerce
 	~text:"Toggle transitive closure on the property at the current focus";
-      tooltips#set_tip button_name#coerce
+      tooltips#set_tip cmd_name#coerce
 	~text:"Give a variable name to the current query focus";
-      tooltips#set_tip button_describe#coerce
+      tooltips#set_tip cmd_describe#coerce
 	~text:"Expand the name at current focus with its description";
-      tooltips#set_tip button_select#coerce
+      tooltips#set_tip cmd_select#coerce
 	~text:"Set the current query focus as the whole query";
-      tooltips#set_tip button_delete#coerce
+      tooltips#set_tip cmd_delete#coerce
 	~text:"Delete the current query focus (it will be replaced by ?)";
-      tooltips#set_tip button_incomplete#coerce
+      tooltips#set_tip cmd_incomplete#coerce
 	~text:"Mark the object at the focus as having an incomplete description";
   end
 
       ()
   end
 
+class list_answers_callbacks =
+  object
+    method row_activated : Name.t option list -> unit = fun line -> ()
+  end
+
+class list_answers ~pack =
+  let vbox = GPack.vbox ~spacing:4 ~packing:pack () in
+  let sw = GBin.scrolled_window ~shadow_type:`ETCHED_IN
+      ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC ~packing:(vbox#pack ~expand:true ~fill:true) () in
+  let hbox = GPack.hbox ~spacing:8 ~packing:vbox#pack () in
+  let label_nb_answers = GMisc.label ~text:"No answer" ~packing:hbox#pack () in
+  let button_top = GButton.button ~stock:`GOTO_TOP (*~label:"Top"*) (*~relief:`NONE*) ~packing:hbox#pack () in
+  let button_up = GButton.button ~stock:`GO_UP (*~label:"Up"*) (*~relief:`NONE*) ~packing:hbox#pack () in
+  let entry_start = GEdit.entry ~width_chars:6 ~xalign:1. ~packing:hbox#pack () in
+  let _ = GMisc.label ~text:" - " ~packing:hbox#pack () in
+  let entry_end = GEdit.entry ~width_chars:6 ~xalign:1. ~packing:hbox#pack () in
+  let button_down = GButton.button ~stock:`GO_DOWN (*~label:"Down"*) (*~relief:`NONE*) ~packing:hbox#pack () in
+  let button_bottom = GButton.button ~stock:`GOTO_BOTTOM (*~label:"Bottom"*) (*~relief:`NONE*) ~packing:hbox#pack () in
+
+  let function_top = "<top>" in
+  let function_up = "<up>" in
+  let function_down = "<down>" in
+  let function_bottom = "<bottom>" in
+  object (self)
+    val mutable callbacks = new list_answers_callbacks
+    method connect c = callbacks <- c
+
+(*
+    val h_line = Hashtbl.create 101
+    method get_line path : Name.t option list option =
+      try Some (Hashtbl.find h_line path)
+      with Not_found -> None
+*)
+
+    val mutable page_start = 1
+    val mutable page_size = 10
+    method page_start = page_start
+    method page_end = min (page_start + page_size - 1) history#current#answers#count
+    method page_size = page_size
+    method page_pos pos = min (max 1 pos) history#current#answers#count
+
+    val h_order : (Lisql.AST.var, Lisql.Semantics.order) Hashtbl.t = Hashtbl.create 11
+    method get_order v = try Hashtbl.find h_order v with _ -> `PAGE_RANK
+
+    val mutable hidden : Lisql.AST.var LSet.t = LSet.empty ()
+    method get_hidden v = LSet.mem v hidden
+
+    method private refresh_aux =
+      List.iter ~f:sw#remove sw#children;
+      let answers = history#current#answers in
+      label_nb_answers#set_text (Printf.sprintf "%d answers" answers#count);
+      entry_start#set_text (string_of_int self#page_start);
+      entry_end#set_text (string_of_int self#page_end);
+      let lv = answers#columns in
+      if lv <> []
+      then begin
+	let table = GPack.table
+	    ~columns:(List.length lv)
+	    ~rows:(1 + self#page_size)
+	    ~homogeneous:false
+	    ~row_spacings:8
+	    ~col_spacings:16
+	    ~border_width:1
+	    ~packing:sw#add_with_viewport
+	    () in
+	let _ =
+	  List.fold_left
+	    ~f:(fun col v ->
+	      let hidden = self#get_hidden v in
+	      let order = self#get_order v in
+	      let menubar = GMenu.menu_bar () in
+	      let menubar_factory = new GMenu.factory menubar in
+	      let menu = menubar_factory#add_submenu v in
+	      GToolbox.build_menu menu
+		~entries:( `C ("hidden", hidden, (fun b -> self#set_hidden v b)) ::
+			   `S ::
+			   `R [ ("page rank", order = `PAGE_RANK, (function true -> self#set_order v `PAGE_RANK | _ -> ()));
+				("descending", order = `DESC, (function true -> self#set_order v `DESC | _ -> ()));
+				("ascending", order = `ASC, (function true -> self#set_order v `ASC | _ -> ())) ] ::
+			   (if col = 0
+			   then []
+			   else [`S; `I ("Move left", (fun () -> self#move_column_left v)) ]) );
+	      table#attach ~left:col ~top:0 ~fill:`X menubar#coerce;
+	      col+1)
+	    ~init:0
+	    lv in
+	let _ =
+	  answers#fold
+	    ~offset:(self#page_start - 1)
+	    ~limit:self#page_size
+	    ~visible_orders:(List.map (fun v -> if self#get_hidden v then None else Some (self#get_order v)) answers#columns)
+	    (fun row line ->
+	      List.fold_left
+		~f:(fun col name_opt ->
+		  ( match name_opt with
+		  | None -> ()
+		  | Some name ->
+		      let label_cell = GMisc.label ~text:(preview_of_name ~obs:Tarpit.blind_observer name) ~xalign:0. () in
+		      table#attach ~left:col ~top:row ~fill:`X label_cell#coerce);
+		  col+1)
+		~init:0
+		line;
+	      row+1)
+	    1 in
+	  () end
+      else begin
+	ignore (GMisc.label ~text:"Name entities in the query with variables for a list of query answers." ~packing:sw#add ())
+      end
+
+(*
+    method private refresh_aux =
+      Hashtbl.clear h_line;
+      List.iter ~f:sw#remove sw#children;
+      let answers = history#current#answers in
+      label_nb_answers#set_text (Printf.sprintf "%d answers" answers#count);
+      let lv = answers#columns in
+      if lv <> []
+      then begin
+	let cols_list = new GTree.column_list in
+	let cols = List.map ~f:(fun _ -> cols_list#add string) lv in
+	let model = GTree.list_store cols_list in
+	let view = GTree.view ~model:model ~headers_visible:true ~packing:sw#add () in
+	let view_cols =
+	  List.map2
+	    ~f:(fun v col ->
+	      let vcol = GTree.view_column ~title:(self#column_title v) ()
+		  ~renderer:(GTree.cell_renderer_text [], ["text",col]) in
+	      view#append_column vcol;
+	      vcol#set_clickable true;
+	      vcol#connect#clicked ~callback:
+		(fun () ->
+		  self#change_order v;
+		  self#refresh_aux);
+	      vcol)
+	    lv cols in
+	view#connect#after#row_activated
+   ~callback:(fun path vcol =
+   match self#get_line path with
+   | Some line -> callbacks#row_activated line
+   | None -> () (* TODO : action lines *));
+	entry_start#set_text (string_of_int self#page_start);
+	entry_end#set_text (string_of_int self#page_end);
+	answers#fold
+	  ~offset:(self#page_start - 1)
+	  ~limit:self#page_size
+	  ~orders:(List.map self#get_order answers#columns)
+	  (fun () line ->
+	    let iter = model#append () in
+	    Hashtbl.replace h_line (model#get_path iter) line;
+	    List.iter2
+	      ~f:(fun col name_opt ->
+		match name_opt with
+		| None -> ()
+		| Some name -> model#set ~row:iter ~column:col (preview_of_name ~obs:Tarpit.blind_observer name))
+	      cols line)
+	  ()
+      end
+      else begin
+	ignore (GMisc.label ~text:"Name entities in the query with variables for a list of query answers." ~packing:sw#add ())
+      end
+*)
+
+    method refresh =
+      page_start <- 1;
+      self#refresh_aux
+
+    method page_down =
+      if self#page_end < history#current#answers#count
+      then begin
+	page_start <- page_start + page_size;
+	self#refresh_aux
+      end
+
+    method page_top =
+      if page_start <> 1
+      then begin
+	page_start <- 1;
+	self#refresh_aux
+      end
+
+    method page_up =
+      if page_start - page_size >= 1
+      then begin
+	page_start <- page_start - page_size;
+	self#refresh_aux
+      end
+
+    method page_bottom =
+      page_start <- ((history#current#answers#count - 1) / page_size) * page_size + 1;
+      self#refresh_aux
+
+    method set_start =
+      (try page_start <- self#page_pos (int_of_string entry_start#text) with _ -> ());
+      self#refresh_aux
+
+    method set_end =
+      (try page_size <- (self#page_pos (int_of_string entry_end#text) - self#page_start + 1) with _ -> ());
+      self#refresh_aux
+
+    method set_order v ord = 
+      ( match ord with
+      | `PAGE_RANK -> Hashtbl.remove h_order v
+      | _ -> Hashtbl.replace h_order v ord);
+      self#refresh_aux
+
+    method set_hidden v b =
+      (if b then hidden <- LSet.add v hidden else hidden <- LSet.remove v hidden);
+      self#refresh_aux
+
+    method move_column_left v =
+      history#current#answers#move_column_left v;
+      self#refresh_aux
+
+    initializer
+      button_top#connect#clicked ~callback:(fun () -> self#page_top);
+      button_down#connect#clicked ~callback:(fun () -> self#page_down);
+      button_up#connect#clicked ~callback:(fun () -> self#page_up);
+      button_bottom#connect#clicked ~callback:(fun () -> self#page_bottom);
+      entry_start#connect#activate ~callback:(fun () -> self#set_start);
+      entry_end#connect#activate ~callback:(fun () -> self#set_end);
+      ()
+  end
+
+let paned_global = GPack.paned `VERTICAL ~packing:(vbox#pack ~expand:true ~fill:true) ()
 
-let paned_global = GPack.paned `HORIZONTAL ~packing:(vbox#pack ~expand:true ~fill:true) ()
+let paned_intension = GPack.paned `HORIZONTAL ~packing:(paned_global#pack1 ~resize:true ~shrink:true) ()
 
 let focus_ef = new entry_feature ~full:false ()
 let wq = new text_query
     ~width_chars:30
-    ~pack:(paned_global#pack1 ~resize:true ~shrink:false)
+    ~pack:(paned_intension#pack1 ~resize:true ~shrink:false)
     ~focus_widget:focus_ef
 
-let vbox = GPack.vbox ~spacing:4 ~packing:(paned_global#pack2 ~resize:true ~shrink:true) ()
+let vbox = GPack.vbox ~spacing:4 ~packing:(paned_intension#pack2 ~resize:true ~shrink:true) ()
 
 let ml = new more_less ~pack:vbox#pack ()
 
 
 let navig = new multi_tree_features wq ~pack:(vbox#pack ~expand:true ~fill:true) (*paned_sw#pack1 ~resize:true ~shrink:true*)
 
+let ans = new list_answers ~pack:(paned_global#pack2 ~resize:true ~shrink:true)
 
 (* global *)
 
   wq#refresh;
   ml#refresh;
   ef#refresh;
-  navig#refresh force
+  navig#refresh force;
+  ans#refresh
 
 let refresh force = Common.prof "Gui.refresh" (fun () ->
   refresh_ui force)
       method data_received () = menu_paste ()
     end);
 
-  
+  ans#connect
+    (object
+      method row_activated line =
+	Logui.item Logui.uri_AnswerSelection (fun obs -> []); (* TODO: line description as feature list *)
+	let subst = List.combine history#current#answers#columns line in
+	let subst = Common.mapfilter (function (v,None) -> None | (v,Some n) -> Some (v,n)) subst in
+	menu_cd (Lisql.focus_subst subst history#current#focus)
+    end);
+
   window#set_default_size ~width:1000 ~height:800;
   window#add_accel_group accel_group;
   window#show ();
-  paned_set_ratio paned_global 2 5;
+  paned_set_ratio paned_global 2 3;
+  paned_set_ratio paned_intension 2 5;
   navig#set_ratio_extent 1 2;
   navig#set_ratio_facets 1 2;
   List.iter

File src/lisql.ml

       focus_name store v (AtP1 (f, Qu1 (q,f,k)))
   | _ -> None
 
+let focus_subst (subst : (var * Name.t) list) : transf =
+  fun foc ->
+    let s = decontext_focus foc in
+    let env = List.map (fun (v,n) -> (v, Name n)) subst in
+    let s' = subst_s env s in
+    Some (focus_of_s s')
+
 let focus_describe store : transf = function
   | AtP1 (Name n,k) ->
       let d = store#description ~obs:Tarpit.blind_observer n in
 	| COr l -> List.exists aux l in
       aux int
 
+    let answers ~obs store (int : intent) : Lisql_semantics.answers = Common.prof "Lisql.ConceptS1.answers" (fun () ->
+      let rec aux gv = function
+	| CExists c -> vars_p1 c, Lisql_semantics.fol_p1 ~obs store gv var_this c
+	| CAnd l ->
+	    List.fold_left
+	      (fun (lv,fol) p -> let lv1, fol1 = aux gv p in LSet.union lv lv1, Prop.And (fol, fol1))
+	      (LSet.empty (), Prop.Atom Fol.FTrue) l
+	| COr [] -> assert false
+	| COr (p::l) ->
+	    List.fold_left
+	      (fun (lv,fol) p -> let lv1, fol1 = aux gv p in LSet.union lv lv1, Prop.Or (fol, fol1))
+	      (aux gv p) l
+      in
+      let gv = new gen_var in
+      let lv, fol = aux gv int in
+      let lv = List.rev lv (*var_this :: lv*) in
+      let _, _, fol = Fol.eval_fol_prop (LSet.empty ()) fol in
+      let ext = Fol.extension_of_fol ~obs store fol in
+      new Lisql_semantics.answers store lv (ext#relation (store :> Extension.store) lv))
+
     let rec intent_s (int : intent) : context_s -> intent = function
       | NilS -> int
       | SuchThat0 (x,_,k') ->
     method vars = Concept.vars foc_int
     method new_var = new_var_s a
 
+    val view_answers = (new Tarpit.view : Lisql_semantics.answers Tarpit.view)
+    initializer
+      view_answers#define (fun obs ->
+	Concept.answers ~obs store foc_int)
+(*	Lisql_semantics.answers ~obs store a) *)
+    method answers ~obs = view_answers#contents ~obs
+
     method entails_increment ~obs x = Concept.entails ~obs store foc_int x
 
     val view_extents = (new Tarpit.view : extents Tarpit.view)
 	    with Not_found ->
 	      let ext_view = new Tarpit.view in
 	      ext_view#define (fun obs ->
-		let ext = Semantics.extension ~obs self q in
+		let ext = Semantics.extension_p1 ~obs self q in
 		ext#fold (self :> Extension.store)
 		  (fun res m ->
 		    try Ext.add (self#get_entity (List.assoc var_root m)) res

File src/lisql_ast.ml

 let var_root = "root"
 let var_this = "this"
 let var_focus = "focus"
+let var_What = "What"
 
 class gen_var =
   object
 
 let focus_of_s a =
   match focus_first_s NilS a with
-  | Some (AtP1 (Thing, Qu1 (Exists, _, Is0 (_,c, NilS)))) -> AtP1 (c, Is1 (Qu (Exists, Thing), c, NilS))
+  | Some (AtP1 ((Var _ | Name _ as c1), Qu1 (Exists, _, Is0 (_,c2, NilS)))) -> AtP1 (c2, Is1 (Qu (Exists, c1), c2, NilS))
   | Some foc -> foc
   | None -> assert false
 
 let focus_top =
   focus_of_s top_s
 
+let focus_what = focus_of_s (Is (Qu (Exists, Var var_What), Thing))
+
 let rec focus_next_prefix ?(filter = fun foc -> true) : transf = fun foc ->
   match focus_down foc with
   | Some foc' -> focus_next_prefix_aux ~filter foc'

File src/lisql_semantics.ml

 *)
 
 module Ext = Intset.Intmap
+module Rel = Intreln.Intmap
 module Extension = Extension.Make
 module Code = Code.Make
 module Store = Store.Make
 (* translation from LISQL to FOL *)
 
 		(* returns the formula of a class, and whether membership to rdfs:Resource has been added *)
-let rec fol_of_assertion ~obs store gv a =
+let rec fol_of_assertion ~obs store a =
+  let gv = new gen_var in
   let f1 = fol_s ~obs store gv a in
   let _, _, f2 = Fol.eval_fol_prop (LSet.empty ()) f1 in
   f2
 
 let tell store ~src (a : s) : unit =
   Tarpit.effect (fun obs ->
-    let gv = new gen_var in
-    let fol = fol_of_assertion ~obs store gv a in
+    let fol = fol_of_assertion ~obs store a in
     let lc = Fol.assert_of_fol ~obs store fol in
     print_string "tell: ";
     List.iter (fun c -> print_string c#string; print_string "; ") lc;
     ignore (Code.list_run ~src:(Rdf.URI src) (store :> Code.store) [] lc))
 
 let ask ~obs store (a : s) : bool =
-  let gv = new gen_var in
-  let fol = fol_of_assertion ~obs store gv a in
+  let fol = fol_of_assertion ~obs store a in
   let ext = Fol.extension_of_fol ~obs store fol in
   ext#succeeds (store :> Extension.store) []
 
            (* extension *)
 
-let extension ~obs store ?(bounded_vars = LSet.empty ()) (f : p1) : Extension.t =
+let extension_s ~obs store (s : s) : Extension.t =
+  Common.prof "Lisql_semantics.extension_s" (fun () ->
+    let fol = fol_of_assertion ~obs store s in
+    let ext = Fol.extension_of_fol ~obs store fol in
+    ext)
+
+type order = [ `DESC | `ASC | `PAGE_RANK | `HIDDEN ]
+
+let rec fold_answers store (offset : int ref) (limit : int ref) (orders : order option list) (f : 'a -> Name.t option list -> 'a) (init : 'a) (rev_line : Name.t option list) rel : 'a =
+  match orders with
+  | [] ->
+      if !offset > 0 then
+	begin decr offset; init end
+      else if !limit = 0 then
+	init
+      else
+	begin decr limit; f init (List.rev rev_line) end
+  | None::sub_orders ->
+      let union_sub_rel =
+	Rel.fold_assoc
+	  (fun res _ sub_rel -> Rel.union res sub_rel)
+	  (Rel.empty (List.length sub_orders))
+	  rel in
+      fold_answers store offset limit sub_orders f init (None::rev_line) union_sub_rel
+  | (Some order)::sub_orders ->
+      let key_names =
+	Ext.fold
+	  (fun res oid ->
+	    let n_opt = if oid = 0 then None else Some (store#get_name oid) in
+	    (n_opt, oid)::res)
+	  [] (Rel.keys rel) in
+      let sorted_key_names = List.sort
+	  (fun (n1_opt,_) (n2_opt,_) ->
+	    match n1_opt, n2_opt with
+	    | Some n1, Some n2 ->
+		( match order with
+		| `DESC -> Pervasives.compare n1 n2 (* should use some Name.compare *)
+		| `ASC -> Pervasives.compare n2 n1
+		| `PAGE_RANK -> Pervasives.compare (store#get_pagerank n2) (store#get_pagerank n1)
+		| `HIDDEN -> assert false)
+	    | Some _, None -> -1
+	    | None, Some _ -> 1
+	    | None, None -> 0)
+	  key_names in
+      List.fold_left
+	(fun res (n_opt,o) ->
+	  let sub_rel = Rel.assoc o rel in
+	  fold_answers store offset limit sub_orders f res (n_opt::rev_line) sub_rel)
+	init sorted_key_names
+
+class answers store lv rel = 
+  object
+    val count : int = Rel.cardinal rel
+    method count = count
+
+    val mutable columns : Extension.var list = lv
+    method columns = columns
+
+    val mutable lines : Rel.t = rel
+    method fold : 'a. offset:int -> limit:int -> visible_orders:(order option list) -> ('a -> Name.t option list -> 'a) -> 'a -> 'a =
+      fun ~offset ~limit ~visible_orders f init ->
+	fold_answers store (ref offset) (ref limit) visible_orders f init [] lines
+
+    method move_column_left v =
+      let state, mask, lv' =
+	List.fold_right
+	  (fun w (state,mask,lv') ->
+	    if state = 1 then
+	      if v = w
+	      then 2, true::mask, lv'
+	      else 1, false::mask, w::lv'
+	    else if state = 2 then 3, false::mask, v::w::lv'
+	    else if state = 3 then 3, true::mask, w::lv'
+	    else assert false)
+	  columns (1,[],[]) in
+      if state = 3 then begin (* otherwise, v missing or first column *)
+	columns <- lv';
+	lines <- Rel.group_by mask lines
+      end
+  end
+
+let answers ~obs store (s : s) : answers =
+  Common.prof "Lisql_semantics.relation_s" (fun () ->
+    let lv = List.rev (vars_s s) in (* TODO: should be only free variables *)
+    let ext = extension_s ~obs store s in
+    new answers store lv (ext#relation (store :> Extension.store) lv))
+
+let extension_p1 ~obs store ?(bounded_vars = LSet.empty ()) (f : p1) : Extension.t =
   Common.prof "Root.extension" (fun () ->
     let _, fol = fol_of_class ~obs store bounded_vars var_root f in
     let ext = Fol.extension_of_fol ~obs store fol in
-    print_endline ("Lisql.extension of: " ^ ext#string);
+(*    print_endline ("Lisql.extension of: " ^ ext#string); *)
     ext)
 
 let extent_fold ~obs store (ff : 'a -> Extension.map -> 'a) (init : 'a) (m : Extension.map) (f : p1) : 'a =
   Common.prof "Root.extent_fold" (fun () ->
-    let ext = extension ~obs store f in
+    let ext = extension_p1 ~obs store f in
     ext#fold (store :> Extension.store) ff init m)
 
               (* get the extent of a concept *)
 	    with _ -> prerr_endline "Lisql.extent: root variable undefined"; res)
 	  Ext.empty [] f)
 
+  
+
 (*
 let extent_s_var ~obs store (s : s) (x : Extension.var) : Ext.t =
   Common.prof "Root.extent_s_var" (fun () ->
 
 let extent_inter ~obs store (e : Ext.t) (f : p1) : Ext.t =
   Common.prof "Root.extent_inter" (fun () ->
-    let ext = extension ~obs store f in
+    let ext = extension_p1 ~obs store f in
     Ext.filter
       (fun oid ->
 	ext#succeeds (store :> Extension.store)
 
 let extent_cross ~obs store (e : Ext.t) (r : p2) : Ext.t =
   Common.prof "Root.extent_cross" (fun () ->
-    let ext = extension ~obs store ~bounded_vars:(LSet.singleton var_this) (Role (reverse_p2 r, exists (Var var_this))) in
+    let ext = extension_p1 ~obs store ~bounded_vars:(LSet.singleton var_this) (Role (reverse_p2 r, exists (Var var_this))) in
     apply_ext ~obs store ext e)
 
 let extent_has_arg ~obs store funct arity (i : int) (e : Ext.t) : Ext.t =
       let args = Array.make arity Thing in
       args.(i-1) <- Var var_this;
       Struct (funct, args) in
-    let ext = extension ~obs store ~bounded_vars:(LSet.singleton var_this) q in
+    let ext = extension_p1 ~obs store ~bounded_vars:(LSet.singleton var_this) q in
     apply_ext ~obs store ext e)
 
 let extent_arg_of ~obs store funct arity (i : int) (e : Ext.t) : Ext.t =
   Common.prof "Lisql.extent_arg_of" (fun () ->
     let q = Arg (funct, i, Array.make arity Thing, Var var_this) in
-    let ext = extension ~obs store ~bounded_vars:(LSet.singleton var_this) q in
+    let ext = extension_p1 ~obs store ~bounded_vars:(LSet.singleton var_this) q in
     apply_ext ~obs store ext e)
 
 

File src/store.ml

 	  try Hashtbl.find h_name oid
 	  with Not_found -> Name.of_oid oid)
 
+	method compare_name (n1 : Name.t) (n2 : Name.t) : int =
+	  match n1, n2 with
+	  | Rdf.URI _, Rdf.URI _ -> Pervasives.compare (self#get_pagerank n2) (self#get_pagerank n1)
+	  | Rdf.URI _, _ -> -1
+	  | _, Rdf.URI _ -> 1
+	  | _ -> Pervasives.compare n1 n2
+
 	method new_resource : Name.t = Common.prof "Store.store#new_resource" (fun () ->
 	  let oid = self#alloc_oid in
 	  let name = Name.of_oid oid in