Sébastien Ferré avatar Sébastien Ferré committed 1ffb4c4

Added string filters to columns of the answer view.

Comments (0)

Files changed (2)

   let function_up = "<up>" in
   let function_down = "<down>" in
   let function_bottom = "<bottom>" in
+
+  let nb_headers = 2 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_size = page_size
     method page_pos pos = min (max 1 pos) history#current#answers#count
 
+    val mutable hidden : Lisql.AST.var LSet.t = LSet.empty ()
+    method get_hidden v = LSet.mem v hidden
+
     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
+    val h_pattern : (Lisql.AST.var, string) Hashtbl.t = Hashtbl.create 11
+    val mutable pattern_focus_var : Lisql.AST.var = ""
+    method get_pattern v = try Hashtbl.find h_pattern v with _ -> ""
+
+    method get_filter v =
+      match self#get_pattern v with
+      | "" -> `NONE
+      | s -> `REGEXPS (List.map Str.regexp_string_case_fold (Str.split (Str.regexp "[ '\",.;]+") s))
+
+
+    val mutable table = GPack.table ()
+    val mutable persistent_widgets : GObj.widget list = []
+    method add_persistent_widget w = persistent_widgets <- w::persistent_widgets
+    method mem_persistent_widget w = List.exists (fun w1 -> w#misc#get_oid = w1#misc#get_oid) persistent_widgets
+    method clean_persistent_widgets = persistent_widgets <- []
+
+
+    method refresh =
+      let answers = history#current#answers in
+      page_start <- 1;
+      label_nb_answers#set_text (Printf.sprintf "%d answers" answers#count);
+      self#refresh_aux
 
     method private refresh_aux =
       List.iter ~f:sw#remove sw#children;
+      self#clean_persistent_widgets;
       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
+	table <- GPack.table
 	    ~columns:(List.length lv)
-	    ~rows:(1 + self#page_size)
+	    ~rows:(nb_headers + 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 ->
 			   (if col = 0
 			   then []
 			   else [`S; `I ("Move left", (fun () -> self#move_column_left v)) ]) );
+	      self#add_persistent_widget menubar#coerce;
 	      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
+	  List.fold_left
+	    ~f:(fun col v ->
+	      let entry = GEdit.entry ~text:(self#get_pattern v) () in
+	      entry#connect#changed ~callback:(fun () -> self#set_pattern v entry#text);
+	      self#add_persistent_widget entry#coerce;
+	      table#attach ~left:col ~top:1 ~fill:`X entry#coerce;
+	      col+1)
+	    ~init:0
+	    lv in
+	self#refresh_contents end
       else begin
-	ignore (GMisc.label ~text:"Name entities in the query with variables for a list of query answers." ~packing:sw#add ())
+	ignore (GMisc.label ~text:"Name entities in the query with variables for a list of query answers." ~packing:sw#add_with_viewport ())
       end
 
-(*
-    method private refresh_aux =
-      Hashtbl.clear h_line;
-      List.iter ~f:sw#remove sw#children;
+    method refresh_contents =
       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);
+      entry_start#set_text (string_of_int self#page_start);
+      entry_end#set_text (string_of_int self#page_end);
+      List.iter ~f:(fun w -> if not (self#mem_persistent_widget w) then table#remove w) table#children;
+      let _ =
 	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
+	  ~columns:(List.map
+		      (fun v ->
+			if self#get_hidden v
+			then `HIDDEN
+			else `SHOWN (self#get_filter v, self#get_order v))
+		      answers#columns)
+	  (fun row line ->
+	    List.fold_left
 	      ~f:(fun col name_opt ->
-		match name_opt with
+		( 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
+		| 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)
+	  nb_headers in
+      ()
 
     method page_down =
       if self#page_end < history#current#answers#count
       then begin
 	page_start <- page_start + page_size;
-	self#refresh_aux
+	self#refresh_contents
       end
 
     method page_top =
       if page_start <> 1
       then begin
 	page_start <- 1;
-	self#refresh_aux
+	self#refresh_contents
       end
 
     method page_up =
       if page_start - page_size >= 1
       then begin
 	page_start <- page_start - page_size;
-	self#refresh_aux
+	self#refresh_contents
       end
 
     method page_bottom =
       page_start <- ((history#current#answers#count - 1) / page_size) * page_size + 1;
-      self#refresh_aux
+      self#refresh_contents
 
     method set_start =
       (try page_start <- self#page_pos (int_of_string entry_start#text) with _ -> ());
-      self#refresh_aux
+      self#refresh_contents
 
     method set_end =
       (try page_size <- (self#page_pos (int_of_string entry_end#text) - self#page_start + 1) with _ -> ());
-      self#refresh_aux
+      self#refresh_contents
+
+    method set_hidden v b =
+      (if b then hidden <- LSet.add v hidden else hidden <- LSet.remove v hidden);
+      self#refresh_contents
 
     method set_order v ord = 
       ( match ord with
       | `PAGE_RANK -> Hashtbl.remove h_order v
       | _ -> Hashtbl.replace h_order v ord);
-      self#refresh_aux
+      self#refresh_contents
 
-    method set_hidden v b =
-      (if b then hidden <- LSet.add v hidden else hidden <- LSet.remove v hidden);
-      self#refresh_aux
+    method set_pattern v re =
+      ( match re with
+      | "" -> Hashtbl.remove h_pattern v
+      | _ -> Hashtbl.replace h_pattern v re);
+      self#refresh_contents
 
     method move_column_left v =
       history#current#answers#move_column_left v;

src/lisql_semantics.ml

     let ext = Fol.extension_of_fol ~obs store fol in
     ext)
 
+
+(* answers *)
+
 type order = [ `DESC | `ASC | `PAGE_RANK ]
+type filter = [ `NONE |`REGEXPS of Str.regexp list ]
+type column = [ `HIDDEN | `SHOWN of filter * order ]
 
+let regexp_match re s =
+  try ignore (Str.search_forward re s 0); true with _ -> false
 
-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
+let rec fold_answers store (offset : int ref) (limit : int ref) (columns : column list)
+    (f : 'a -> Name.t option list -> 'a) (init : 'a) (rev_line : Name.t option list) rel : 'a =
+  match columns with
   | [] ->
       if !offset > 0 then
 	begin decr offset; init end
 	init
       else
 	begin decr limit; f init (List.rev rev_line) end
-  | None::sub_orders ->
+  | `HIDDEN::sub_columns ->
       let union_sub_rel =
 	Rel.fold_assoc
 	  (fun res _ sub_rel -> Rel.union res sub_rel)
-	  (Rel.empty (List.length sub_orders))
+	  (Rel.empty (List.length sub_columns))
 	  rel in
-      fold_answers store offset limit sub_orders f init (None::rev_line) union_sub_rel
-  | (Some order)::sub_orders ->
+      fold_answers store offset limit sub_columns f init (None::rev_line) union_sub_rel
+  | `SHOWN (filter,order)::sub_columns ->
       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)
+	    let ok =
+	      match n_opt, filter with
+	      | _, `NONE -> true
+	      | Some (Rdf.URI uri), `REGEXPS lre -> List.for_all (fun re -> regexp_match re uri) lre
+	      | Some (Rdf.Literal (str,_)), `REGEXPS lre -> List.for_all (fun re -> regexp_match re str) lre
+	      | _ -> false in
+	    if ok
+	    then (n_opt, oid)::res
+	    else res)
 	  [] (Rel.keys rel) in
       let sorted_key_names = List.sort
 	  (fun (n1_opt,_) (n2_opt,_) ->
 		( 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)
+		| `PAGE_RANK -> Pervasives.compare (store#get_pagerank n2) (store#get_pagerank n1))
 	    | Some _, None -> -1
 	    | None, Some _ -> 1
 	    | None, None -> 0)
       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)
+	  fold_answers store offset limit sub_columns f res (n_opt::rev_line) sub_rel)
 	init sorted_key_names
 
 class answers store lv rel = 
     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 fold : 'a. offset:int -> limit:int -> columns:(column list) -> ('a -> Name.t option list -> 'a) -> 'a -> 'a =
+      fun ~offset ~limit ~columns f init ->
+	fold_answers store (ref offset) (ref limit) columns f init [] lines
 
     method move_column_left v =
       let state, mask, lv' =
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.