The R13B03 release.OTP_R13B03

1 files changed, 338 insertions, 0 deletions

diff --git a/lib/debugger/src/dbg_ui_filedialog_win.erl b/lib/debugger/src/dbg_ui_filedialog_win.erl
new file mode 100644
index 0000000000..f7d76076a5
--- /dev/null
+++ b/lib/debugger/src/dbg_ui_filedialog_win.erl
@@ -0,0 +1,338 @@
+%%
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 2002-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%
+%%
+
+-module(dbg_ui_filedialog_win).
+
+%% External exports
+-export([create_win/6, create_win/7, get_window/1,
+	 tag/2,
+	 handle_event/2]).
+
+-record(winInfo, {window,        % gsobj()
+		  extra,         % fun()
+		  cwd,           % string()
+		  pattern        % string()
+		 }).
+
+%%====================================================================
+%% External exports
+%%====================================================================
+
+%%--------------------------------------------------------------------
+%% create_win(GS, Title, Pos, Mode, Filter, Extra)
+%% create_win(GS, Title, Pos, Mode, Filter, Extra, FileName) -> #winInfo{}
+%%   GS  = term()
+%%   Title = string()
+%%   Pos = {X,Y}
+%%   Mode = normal | multiselect
+%%   Filter = string() File name that may include * symbols.
+%%   Extra = fun(File) -> {true, tag} | true | {error, term()}
+%%   FileName = string() Suggested file name when saving
+%%--------------------------------------------------------------------
+create_win(GS, Title, {X,Y}, Mode, Filter, Extra) ->
+    create_win(GS, Title, {X,Y}, Mode, Filter, Extra, null).
+create_win(GS, Title, {X,Y}, Mode, Filter, Extra, FileName) ->
+    Pad = 8,
+    Wlb = 480, Hlb = 130,
+
+    Font = dbg_ui_win:font(normal),
+
+    {Wlbl, Hlbl} = dbg_ui_win:min_size(["Directories"], 80, 20),
+    {Wbtn, Hbtn} = dbg_ui_win:min_size(["Filter","Cancel"], 70, 30),
+
+    %% Window
+    Win = gs:window(GS, [{title,Title}, {x, X}, {y,Y}, {destroy,true}]),
+
+    %% 'Filter' label and entry (for selecting directory)
+    gs:label(Win, [{label, {text,"Filter"}}, {font, Font}, {align, sw},
+		   {x, Pad+2}, {y, Pad}, {width,Wlbl}, {height,Hlbl}]),
+    gs:entry('Filter', Win, [{x, Pad}, {y, Pad+Hlbl},
+			     {width, Wlb}, {height, Hbtn},
+			     {keypress, true}]),
+
+    %% Listboxes (showing directories and files)
+    Xmid = Pad + Wlb/2,
+    Y2 = Pad + Hlbl + Hbtn + Pad,
+    gs:label(Win, [{label, {text,"Directories"}},
+		   {font, Font}, {align, sw},
+		   {x, Pad+2}, {y, Y2},
+		   {width, Wlbl}, {height, Hlbl}]),
+    gs:label(Win, [{label, {text,"Files"}},
+		   {font, Font}, {align, sw},
+		   {x, Xmid+Pad/2+2}, {y, Y2},
+		   {width, Wlbl}, {height, Hlbl}]),
+    gs:listbox('Dirs', Win, [{x, Pad}, {y, Y2+Hlbl},
+			     {width, Wlb/2-Pad/2}, {height, Hlb},
+			     {vscroll, right},
+			     {click, true}, {doubleclick, true}]),
+    gs:listbox('Files', Win, [{x, Xmid+Pad/2}, {y, Y2+Hlbl},
+			      {width, Wlb/2-Pad/2}, {height, Hlb},
+			      {vscroll, right},
+			      {click, true}, {doubleclick, true}]),
+
+    %% 'Selection' label and entry (for selecting file)
+    Y3 = Y2 + Hlbl + Hlb,
+    gs:label(Win, [{label, {text,"Selection"}}, {font,Font}, {align,sw},
+		   {x, Pad+2}, {y, Y3}, {width, Wlbl}, {height, Hlbl}]),
+    gs:entry('Selection', Win, [{x, Pad}, {y, Y3+Hlbl},
+				{width, Wlb}, {height, Hbtn},
+				{keypress, true}]),
+
+    %% Buttons
+    Y4 = Y3 + Hlbl + Hbtn + Pad,
+    Wb = Wlb - Wbtn,
+    Opts = [{y, Y4}, {width, Wbtn}, {height, Hbtn}, {font, Font}],
+    case Mode of
+	normal ->
+	    gs:button(Win, [{label, {text,"Ok"}}, {x, Pad},
+			    {data, select} | Opts]),
+	    gs:button(Win, [{label, {text,"Filter"}}, {x, Wlb/2-Wbtn/2},
+			    {data, filter} | Opts]),
+	    gs:button(Win, [{label, {text,"Cancel"}}, {x, Pad+Wb},
+			    {data, done} | Opts]);
+	multiselect ->
+	    gs:button(Win, [{label, {text,"Choose"}}, {x, Pad},
+			    {data, select} | Opts]),
+	    gs:button(Win, [{label, {text,"All"}}, {x, Pad+Wb/3},
+			    {data, multiselect} | Opts]),
+	    gs:button(Win, [{label, {text,"Filter"}}, {x, Pad+2*Wb/3},
+			    {data, filter} | Opts]),
+	    gs:button(Win, [{label, {text,"Done"}}, {x, Pad+Wb},
+			    {data, done} | Opts])
+    end,
+
+    %% Insert contents
+    {ok, Home} = file:get_cwd(),
+    {Cwd, Pattern} = update_win(Filter, Extra, Home),
+    if
+	is_list(FileName) ->
+	    gs:config('Selection', {text, filename:join(Cwd,FileName)});
+	true -> ignore
+    end,
+
+    Wwin = Pad + Wlb + Pad,
+    Hwin = Y4 + Hbtn + Pad,
+    gs:config(Win, [{width, Wwin}, {height, Hwin}, {map, true}]),
+
+    #winInfo{window=Win, extra=Extra, cwd=Cwd, pattern=Pattern}.
+
+%%--------------------------------------------------------------------
+%% get_window(WinInfo) -> Window
+%%   WinInfo = #winInfo{}
+%%   Window = gsobj()
+%%--------------------------------------------------------------------
+get_window(WinInfo) ->
+    WinInfo#winInfo.window.
+
+%%--------------------------------------------------------------------
+%% tag(WinInfo, File)
+%%   WinInfo = #winInfo{}
+%%   File = string()
+%%--------------------------------------------------------------------
+tag(WinInfo, File0) ->
+    File = relfile(WinInfo#winInfo.cwd, File0),
+    case member(File, gs:read('Files', items)) of
+	{true, Index} -> gs:config('Files', {change, {Index, tag(File)}});
+	false -> ignore
+    end.
+
+tag(Str) -> [$*|Str].
+untag([$*|Str]) -> Str;
+untag([$(|Str]) -> [$)|Rts] = lists:reverse(Str),lists:reverse(Rts);
+untag(Str) -> Str.
+
+member(E, L) ->        member(E, L, 0).
+member(E, [E|_], I) -> {true, I};
+member(E, [_|T], I) -> member(E, T, I+1);
+member(_E, [], _I) ->  false.
+
+%%--------------------------------------------------------------------
+%% handle_event(GSEvent, WinInfo) -> Command
+%%   GSEvent = {gs, Id, Event, Data, Arg}
+%%   WinInfo = #winInfo{}
+%%   Command = ignore
+%%           | {stopped, Dir}
+%%           | {win, WinInfo}
+%%           | {select, File} | {multiselect, Dir, FileNames}
+%%--------------------------------------------------------------------
+handle_event({gs, _Id, destroy, _Data, _Args}, WinInfo) ->
+    {stopped, WinInfo#winInfo.cwd};
+
+handle_event({gs, 'Filter', keypress, _Data, ['Return'|_]}, WinInfo) ->
+    handle_event({gs, null, click, filter, null}, WinInfo);
+handle_event({gs, 'Selection', keypress, _Data, ['Return'|_]}, WinInfo) ->
+    handle_event({gs, null, click, select, null}, WinInfo);
+
+handle_event({gs, 'Dirs', click, _Data, [0,"..",true|_]}, WinInfo) ->
+    Filter = filename:join(filename:dirname(WinInfo#winInfo.cwd),
+			   WinInfo#winInfo.pattern),
+    gs:config('Filter', {text, Filter}),
+    ignore;
+handle_event({gs, 'Dirs', click, _Data, [_Index,Str,true|_]}, WinInfo) ->
+    Filter = filename:join([WinInfo#winInfo.cwd, Str,
+			    WinInfo#winInfo.pattern]),
+    gs:config('Filter', {text, Filter}),
+    ignore;
+handle_event({gs, 'Dirs', doubleclick, _Data, _Arg}, WinInfo) ->
+    handle_event({gs, null, click, filter, null}, WinInfo);
+
+handle_event({gs, 'Files', click, _Data, [_Index,Str,true|_]}, WinInfo) ->
+    Selection = filename:join(WinInfo#winInfo.cwd, untag(Str)),
+    gs:config('Selection', {text, Selection}),
+    ignore;
+handle_event({gs, 'Files', doubleclick, _Data, _Arg}, WinInfo) ->
+    handle_event({gs, null, click, select, null}, WinInfo);
+  
+handle_event({gs, _Id, click, select, _Arg}, _WinInfo) ->
+    {select, gs:read('Selection', text)};
+handle_event({gs, _Id, click, multiselect, _Arg}, WinInfo) ->
+    Files = lists:map(fun(File) -> untag(File) end,
+		      gs:read('Files', items)),
+    {multiselect, WinInfo#winInfo.cwd, Files};
+handle_event({gs, _Id, click, filter, _Arg}, WinInfo) ->
+    {Cwd, Pattern} = update_win(gs:read('Filter', text),
+				WinInfo#winInfo.extra,
+				WinInfo#winInfo.cwd),
+    {win, WinInfo#winInfo{cwd=Cwd, pattern=Pattern}};
+handle_event({gs, _Id, click, done, _Arg}, WinInfo) ->
+    {stopped, WinInfo#winInfo.cwd};
+    
+handle_event(_GSEvent, _WinInfo) ->
+    ignore.
+
+%%====================================================================
+%% Internal functions
+%%====================================================================
+
+update_win(Filter, ExtraFilter, Prev) ->
+    {Res, {Filter2, Cwd, FilePattern}} = check_filter(Filter, Prev),
+
+    Dirs = [".." | get_subdirs(Cwd)],
+
+    gs:config('Filter', {text, Filter2}),
+    gs:config('Dirs', {items, Dirs}),
+    gs:config('Selection', {text, Cwd}),
+
+    case Res of
+	ok ->
+	    Matching = lists:sort(filelib:wildcard(Filter2, erl_prim_loader)),
+	    Files = extra_filter(Matching, Cwd, ExtraFilter),
+	    gs:config('Files', {items, Files});
+	error ->
+	    gs:config('Files', beep)
+    end,
+
+    {Cwd, FilePattern}.
+
+%% check_filter(Filter, Prev) -> {ok, Res} | {error, Res}
+%%   Res = {Filter, Cwd, FilePattern}
+%%   Filter = Prev = Cwd = FilePattern = string()
+check_filter(Filter0, Prev) ->
+    Filter = case filename:pathtype(Filter0) of
+		 absolute -> Filter0;
+		 _Relative -> filename:absname(Filter0, Prev)
+	     end,
+    Comps = filename:split(Filter),
+    Last = lists:last(Comps),
+    FilePattern = case is_pattern(Last) of
+		      true -> Last;
+		      false -> "*"
+		  end,
+    {Cwd, Rest} = max_existing(Comps),
+    case Rest of
+	[] ->
+	    %% Filter = existing file or directory
+	    Res = case filelib:is_dir(Filter, erl_prim_loader) of
+		      true -> {filename:join(Filter, "*"), Filter, "*"};
+		      false -> {Filter, filename:dirname(Filter),
+				filename:basename(Filter)}
+		  end,
+	    {ok, Res};
+	[FilePattern] ->
+	    %% Filter = existing dir and valid pattern
+	    {ok, {Filter, Cwd, FilePattern}}; 
+	Comps ->
+	    %% Filter = garbage
+	    {error, {Prev, Prev, "*"}};
+	[Name|_Names] ->
+	    %% Filter = existing dir ++ pattern or non-existing file/dir
+	    case is_pattern(Name) of
+		true -> {ok, {Filter, Cwd, FilePattern}};
+		false -> {error, {Cwd, Cwd, ""}}
+	    end
+    end.
+
+max_existing([Name | Names]) ->
+    case filelib:is_file(Name, erl_prim_loader) of
+	true -> max_existing(Name, Names);
+	false -> {[], [Name | Names]}
+    end.
+max_existing(Dir, [Name | Names]) ->
+    Dir2 = filename:join(Dir, Name),
+    case filelib:is_file(Dir2, erl_prim_loader) of
+	true when Names==[] -> {Dir2, []};
+	true -> max_existing(Dir2, Names);
+	false -> {Dir, [Name | Names]}
+    end.
+
+is_pattern(Str) ->
+    lists:member($*, Str).
+
+extra_filter([File|Files], Dir, Fun) ->
+    case Fun(File) of
+	true ->
+	    [relfile(Dir, File) | extra_filter(Files, Dir, Fun)];
+	{true,tag} ->
+	    [[$*|relfile(Dir,File)] | extra_filter(Files, Dir, Fun)];
+	{true,disable} ->
+	    [[$(|relfile(Dir,File)]++[$)] | extra_filter(Files, Dir, Fun)];
+	{error, _Reason} -> extra_filter(Files, Dir, Fun)
+    end;
+extra_filter([], _Dir, _Fun) -> [].
+
+get_subdirs(Dir) ->
+    case erl_prim_loader:list_dir(Dir) of
+	{ok, FileNames} ->
+	    X = lists:filter(fun(FileName) ->
+				     File = filename:join(Dir, FileName),
+				     filelib:is_dir(File, erl_prim_loader)
+			     end,
+			     FileNames),
+	    lists:sort(X);
+	_Error ->
+	    []
+    end.
+
+%% Return the "remainder" of a file name relative a dir name, examples:
+%%   relfile("/home/gunilla", "/home/gunilla/m.erl") -> "m.erl"
+%%   relfile("/home/gunilla/dir", "/home/gunilla/dir/m.erl") -> "dir/m.erl"
+%%   relfile("/home/gunilla", "/home/arne/m.erl") -> "/home/arne/m.erl"
+relfile(Dir, File) ->
+    case compare(Dir, File) of
+	error -> File;
+	RelFile -> RelFile
+    end.
+
+compare([_|Dir], [_|File]) ->
+    compare(Dir, File);
+compare([], [$/|File]) ->
+    File;
+compare(_, _) ->
+    error.
+