aboutsummaryrefslogtreecommitdiffstats
path: root/lib/tv/src/tv_db_search.erl
diff options
context:
space:
mode:
authorErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
committerErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
commit84adefa331c4159d432d22840663c38f155cd4c1 (patch)
treebff9a9c66adda4df2106dfd0e5c053ab182a12bd /lib/tv/src/tv_db_search.erl
downloadotp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz
otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2
otp-84adefa331c4159d432d22840663c38f155cd4c1.zip
The R13B03 release.OTP_R13B03
Diffstat (limited to 'lib/tv/src/tv_db_search.erl')
-rw-r--r--lib/tv/src/tv_db_search.erl485
1 files changed, 485 insertions, 0 deletions
diff --git a/lib/tv/src/tv_db_search.erl b/lib/tv/src/tv_db_search.erl
new file mode 100644
index 0000000000..edd3c188e2
--- /dev/null
+++ b/lib/tv/src/tv_db_search.erl
@@ -0,0 +1,485 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%%*********************************************************************
+%%%
+%%% Description: Code for the search window.
+%%%
+%%%*********************************************************************
+-module(tv_db_search).
+
+
+
+-export([create_window/1,
+ resize_window/1,
+ reset_window/1,
+ destroy_window/1,
+ mark_busy/1,
+ mark_nonbusy/1,
+ get_input_and_search/3,
+ update_search/4,
+ string_to_term/1
+ ]).
+
+
+
+
+-include("tv_int_def.hrl").
+-include("tv_int_msg.hrl").
+-include("tv_db_int_def.hrl").
+
+
+
+
+-define(WIN_WIDTH, 445).
+-define(SMALL_WIN_HEIGHT, 117).
+-define(BIG_WIN_HEIGHT, 335).
+-define(FRAME_WIDTH, 429). % 334
+-define(OLD_FRAME_WIDTH, 334).
+-define(FRAME_HEIGHT, 105).
+-define(FRAME_XPOS, (10-2)).
+-define(FRAME_YPOS, 10).
+-define(ENTRY_XPOS, 9).
+-define(ENTRY_YPOS, 31).
+-define(ENTRY_WIDTH, (?OLD_FRAME_WIDTH-10-2*?ENTRY_XPOS-5)).
+-define(LISTBOX_WIDTH, ?WIN_WIDTH-2*?FRAME_XPOS+1).
+-define(LISTBOX_HEIGHT, 162).
+-define(LISTBOX_XPOS, ?FRAME_XPOS-2).
+-define(LISTBOX_YPOS, ?SMALL_WIN_HEIGHT+8).
+-define(BTN_WIDTH, 80).
+-define(BTN_HEIGHT, 30).
+-define(BTN_XPOS, ?OLD_FRAME_WIDTH-6).
+-define(BG_COLOUR, {217,217,217}).
+
+
+
+
+
+
+create_window(true) ->
+ gs:config(win, [raise]);
+create_window(false) ->
+ gs:window(win, gs:start(), [{width,?WIN_WIDTH},
+ {height,?SMALL_WIN_HEIGHT},
+ {data,small},
+ {bg,?BG_COLOUR},
+ {title,"[TV] Search Object"},
+ {destroy,true},
+ {configure,true},
+ {cursor,arrow}
+ ]),
+
+ F = gs:frame(win, [{width,?FRAME_WIDTH},
+ {height,?FRAME_HEIGHT},
+ {x,?FRAME_XPOS},
+ {y,?FRAME_YPOS},
+ {bw,2},
+ {bg,?BG_COLOUR}
+ ]),
+
+ gs:label(F, [{width,80},
+ {height,25},
+ {x,?ENTRY_XPOS+2},
+ {y,8},
+ {align,w},
+ {bg,?BG_COLOUR},
+ {fg, {0,0,0}},
+ {label, {text,"Search for:"}}
+ ]),
+
+ gs:entry(entry, F, [{width,?ENTRY_WIDTH},
+ {height,30},
+ {x,?ENTRY_XPOS},
+ {y,?ENTRY_YPOS},
+ {insert, {0,"<Search expression>"}},
+ {bg, {255,255,255}},
+ {fg, {0,0,0}},
+ {cursor,text},
+ {justify,left},
+ {keypress,true},
+ {setfocus,true}
+ ]),
+
+ Group = list_to_atom("expr" ++ pid_to_list(self())),
+ RadioWidth = round(?ENTRY_WIDTH / 2),
+ gs:radiobutton(expr_term, F, [{width,RadioWidth - 45},
+ {height,25},
+ {x,?ENTRY_XPOS},
+ {y,?ENTRY_YPOS+40},
+ {group,Group},
+ {align, c},
+ {label,{text,"as term"}},
+ {select,true}
+ ]),
+ gs:radiobutton(expr_regexp, F, [{width,RadioWidth + 45},
+ {height,25},
+ {x,?ENTRY_XPOS+RadioWidth-20-26},
+ {y,?ENTRY_YPOS+40},
+ {group,Group},
+ {align,c},
+ {label,{text,"as regular expression"}}
+ ]),
+
+ gs:button(search, F, [{width,?BTN_WIDTH},
+ {height,?BTN_HEIGHT},
+ {x,?BTN_XPOS},
+ {y,11},
+ {label, {text,"Search"}},
+ {bg,?BG_COLOUR},
+ {fg, {0,0,0}}
+ ]),
+ gs:button(cancel, F, [{width,?BTN_WIDTH},
+ {height,?BTN_HEIGHT},
+ {x,?BTN_XPOS},
+ {y,?BTN_HEIGHT+11+10},
+ {label, {text,"Cancel"}},
+ {data,cancel},
+ {bg,?BG_COLOUR},
+ {fg, {0,0,0}}
+ ]),
+ expand_window(),
+ gs:config(entry, [{select, {0,1000}}]),
+ gs:config(win, [{map,true}]).
+
+
+
+
+resize_window(false) ->
+ done;
+resize_window(true) ->
+ gs:config(win, [{width,?WIN_WIDTH},
+ {height,?BIG_WIN_HEIGHT}
+ ]).
+
+
+
+
+reset_window(false) ->
+ done;
+reset_window(true) ->
+ gs:config(listbox, [clear]),
+ gs:config(objects_found, [{label, {text,""}}]).
+
+
+
+
+destroy_window(false) ->
+ done;
+destroy_window(true) ->
+ gs:destroy(win).
+
+
+
+mark_busy(false) ->
+ done;
+mark_busy(true) ->
+ gs:config(win, [{cursor,busy}]),
+ gs:config(entry, [{cursor,busy}]).
+
+
+
+
+mark_nonbusy(false) ->
+ done;
+mark_nonbusy(true) ->
+ gs:config(win, [{cursor,arrow}]),
+ gs:config(entry, [{cursor,text}]).
+
+
+
+
+get_input_and_search(DbList, IsRegExp, ListAsStr) ->
+ get_input_and_search(DbList, IsRegExp, true, ListAsStr).
+
+
+
+
+get_input_and_search(DbList, IsRegExp, Notify, ListAsStr) ->
+ Str = get_entry_text(),
+ StrConvRes = case IsRegExp of
+ true ->
+ string_to_regexp(Str);
+ false ->
+ string_to_term(Str)
+ end,
+
+ case StrConvRes of
+ {ok, TermOrRE} ->
+ search(IsRegExp, TermOrRE, DbList, ListAsStr);
+ {error, {_Reason, Msg}} when Notify ->
+ gs:config(win, [beep]),
+ tv_utils:notify(win, "TV Notification", Msg);
+ {error, {_Reason, _Msg}} ->
+ done
+ end.
+
+
+
+update_search(false, _DbList, _IsRegExp, _ListAsStr) ->
+ done;
+update_search(true, DbList, true, ListAsStr) ->
+ get_input_and_search(DbList, false, false, ListAsStr);
+update_search(true, DbList, false, ListAsStr) ->
+ get_input_and_search(DbList, true, false, ListAsStr).
+
+
+
+get_entry_text() ->
+ gs:read(entry,text).
+
+
+
+string_to_regexp(Str) ->
+ case regexp:parse(Str) of
+ {ok, RegExp} ->
+ {ok, RegExp};
+ _Error ->
+ case get(error_msg_mode) of
+ normal ->
+ {error, {not_a_regexp, "Please enter a regular expression!"}};
+ haiku ->
+ {error, {not_a_regexp, ["Being incorrect",
+ "The regular expression",
+ "Must now be retyped."]}}
+ end
+ end.
+
+
+
+string_to_term(Str) ->
+ case catch erl_scan:string(Str ++ ". ") of
+ {ok, ScannedStr, _No} ->
+ case erl_parse:parse_term(ScannedStr) of
+ {ok, Term} ->
+ {ok, Term};
+ _Other ->
+ %% May be a PID, have to check this, since erl_scan
+ %% currently cannot handle this case... :-(
+ case catch list_to_pid(Str) of
+ Pid when is_pid(Pid) ->
+ {ok, Pid};
+ _Error ->
+ case get(error_msg_mode) of
+ normal ->
+ {error, {not_a_term, "Please enter a valid term!"}};
+ haiku ->
+ {error, {not_a_term, ["Aborted effort.",
+ "Reflect, repent and retype:",
+ "Enter valid term."]}}
+ end
+ end
+ end;
+ _Error ->
+ case get(error_msg_mode) of
+ normal ->
+ {error, {not_a_term, "Please enter a valid term!"}};
+ haiku ->
+ {error, {not_a_term, ["Aborted effort.",
+ "Reflect, repent and retype:",
+ "Enter valid term."]}}
+ end
+ end.
+
+
+
+search(IsRegExp, SearchValue, DbList, ListAsStr) ->
+ gs:config(cancel, [{label, {text,"Stop"}}]),
+ mark_busy(true),
+ reset_window(true),
+ SearchRes = traverse(SearchValue, DbList, 1, length(DbList), [], IsRegExp, ListAsStr),
+ gs:config(cancel, [{label, {text,"Cancel"}}]),
+ mark_nonbusy(true),
+ SearchRes.
+
+
+
+
+
+expand_window() ->
+ gs:listbox(listbox, win, [{width,?LISTBOX_WIDTH},
+ {height,?LISTBOX_HEIGHT},
+ {x,?LISTBOX_XPOS},
+ {y,?LISTBOX_YPOS},
+ {bg, {255,255,255}},
+ {fg, {0,0,0}},
+ {scrollbg,?BG_COLOUR},
+ {scrollfg,?BG_COLOUR},
+ {hscroll,bottom},
+ {vscroll,right},
+ {click,true},
+ {doubleclick,false},
+ {selectmode,single}
+ ]),
+ gs:label(objects_found, win, [{width,?LISTBOX_WIDTH},
+ {height,25},
+ {x,?LISTBOX_XPOS},
+ {y,?LISTBOX_YPOS+?LISTBOX_HEIGHT+13},
+ {align,w},
+ {bg,?BG_COLOUR},
+ {fg, {0,0,0}}
+ ]),
+ gs:config(win, [{width,?WIN_WIDTH},
+ {height,?BIG_WIN_HEIGHT}
+ ]).
+
+
+
+
+
+
+
+traverse(Pattern, [Object | T], Row, Length, Acc, IsRegExp, ListAsStr) ->
+ SearchRes =
+ case IsRegExp of
+ true ->
+ search_for_regexp(Pattern, Object, ListAsStr);
+ false ->
+ compare_terms(Pattern, Object)
+ end,
+
+ NewAcc
+ = case SearchRes of
+ found ->
+ RowStr = integer_to_list(Row),
+ LengthStr = integer_to_list(Length),
+ ObjectStr = case ListAsStr of
+ true ->
+ lists:flatten(tv_io_lib:format("~p", [Object]));
+ false ->
+ lists:flatten(tv_io_lib:write(Object))
+ end,
+
+ gs:config(listbox,
+ [{add,
+ " Row " ++ RowStr ++ ":" ++
+ lists:duplicate(length(LengthStr)-length(RowStr), " ") ++
+ " " ++ ObjectStr}
+ ]),
+ gs:config(objects_found,
+ [{label,
+ {text,integer_to_list(length(Acc)+1) ++
+ " object(s) found"}}
+ ]),
+ [{Row,Object} | Acc];
+ not_found ->
+ Acc
+ end,
+ receive
+ {gs,cancel,click,_Data,_Args} ->
+ gs:config(objects_found,
+ [{label,
+ {text,integer_to_list(gs:read(listbox,size)) ++
+ " object(s) found"}}
+ ]),
+ lists:reverse(NewAcc)
+ after
+ 0 ->
+ traverse(Pattern, T, Row+1, Length, NewAcc, IsRegExp, ListAsStr)
+ end;
+traverse(_Pattern, [], _N, _Length, Acc, _IsRegExp, _ListAsStr) ->
+ gs:config(objects_found,
+ [{label,
+ {text,integer_to_list(gs:read(listbox,size)) ++
+ " object(s) found"}}
+ ]),
+ lists:reverse(Acc).
+
+
+
+
+search_for_regexp(Pattern, Elem, ListAsStr) ->
+ ListToSearch =
+ case ListAsStr of
+ true ->
+ lists:flatten(tv_io_lib:format("~p", [Elem]));
+ false ->
+ lists:flatten(tv_io_lib:write(Elem))
+ end,
+
+ case regexp:first_match(ListToSearch, Pattern) of
+ {match, _, _} ->
+ found;
+ _Other ->
+ not_found
+ %% The code below shall be used instead if it is desired to
+ %% compare each *element* in the tuples to the regular expression,
+ %% i.e., treat each element as a new line/string.
+ %% The difference is most easily explained through an example:
+ %% If we treat each tuple as a new line/string, the regular expression
+ %% "^{win" will match the string "{win, 1, 2, 3}", but not the string
+ %% "{1, {win,2}}".
+ %% If we treat each element as a new line/string, the RE "^{win" will match
+ %% both strings above.
+
+ %% SearchList = tuple_to_list(Elem),
+ %% case lists:dropwhile(
+ %% fun(H) ->
+ %% nomatch == regexp:first_match(lists:flatten(io_lib:write(H)),
+ %% Pattern)
+ %% end,
+ %% SearchList) of
+ %% [] ->
+ %% not_found;
+ %% _AnyList ->
+ %% found
+ %% end
+ end.
+
+
+
+
+
+compare_terms(Term, Elem) when not is_tuple(Elem), not is_list(Elem), Term =/= Elem ->
+ not_found;
+compare_terms(Term, Term) ->
+ %% Even the case Term = "{}" or "[]"!!!
+ found;
+compare_terms(Term, Elem) when is_list(Elem) ->
+ traverse_list(Term, Elem);
+compare_terms(Term, Elem) when is_tuple(Elem) ->
+ traverse_tuple(Term, Elem, 1, size(Elem)).
+
+
+
+
+
+traverse_tuple(Pattern, Tuple, N, Stop) when N =< Stop ->
+ Elem = element(N,Tuple),
+ case compare_terms(Pattern, Elem) of
+ found ->
+ found;
+ not_found ->
+ traverse_tuple(Pattern, Tuple, N+1, Stop)
+ end;
+traverse_tuple(_Pattern, _Tuple, N, Stop) when N > Stop ->
+ not_found.
+
+
+
+
+
+
+traverse_list(Pattern, [H | T]) ->
+ case compare_terms(Pattern, H) of
+ found ->
+ found;
+ not_found ->
+ traverse_list(Pattern, T)
+ end;
+traverse_list(_Pattern, []) ->
+ not_found.
+