1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2008-2018. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20
21%%
22-module(dbg_wx_win).
23
24%% External exports
25-export([init/0,
26	 create_menus/4, %% For wx
27	 add_break/3, update_break/2, delete_break/1,
28	 motion/2,
29	 confirm/2, notify/2, entry/4, open_help/2,
30	 to_string/1, to_string/2,
31	 find_icon/1
32	]).
33
34-record(break, {mb, smi, emi, dimi, demi}).
35-include_lib("wx/include/wx.hrl").
36
37%%====================================================================
38%% External exports
39%%====================================================================
40
41%%--------------------------------------------------------------------
42%% init() -> GS
43%%   GS = term()
44%%--------------------------------------------------------------------
45init() ->
46    _ = wx:new(),
47    ok.
48
49%%--------------------------------------------------------------------
50%% create_menus(MenuBar, [Menu])
51%%   MenuBar = gsobj()
52%%   Menu = {Name, [Item]}
53%%     Name = atom()
54%%     Item = {Name, N} | {Name, N, Type} | {Name, N, cascade, [Item]}
55%%          | separator
56%%       N = no | integer()
57%%       Type = check | radio
58%% Create the specified menus and menuitems.
59%%
60%% Normal menuitems are specified as {Name, N}. Generates the event:
61%%   {gs, _Id, click, {menuitem, Name}, _Arg}
62%%
63%% Check and radio menuitems are specified as {Name, N, check|radio}.
64%% They are assumed to be children to a cascade menuitem! (And all children
65%% to one cascade menuitem are assumed to be either check OR radio
66%% menuitems)!
67%% Selecting a check/radio menuitem generates the event:
68%%   {gs, _Id, click, {menu, Menu}, _Arg}
69%% where Menu is the name of the parent, the cascade menuitem.
70%% Use selected(Menu) to retrieve which check/radio menuitems are
71%% selected.
72%%--------------------------------------------------------------------
73
74create_menus(MB, [{Title,Items}|Ms], Win, Id0) ->
75    Menu = wxMenu:new([]),
76    put(Title,Menu),
77    Id = create_menu_item(Menu, Items, Win, Id0, true),
78    wxMenuBar:append(MB,Menu,menu_name(Title,ignore)),
79    create_menus(MB,Ms,Win,Id);
80create_menus(_MB,[], _Win,Id) ->
81    Id.
82
83create_menu_item(Menu, [separator|Is], Win, Id,Connect) ->
84    _ = wxMenu:appendSeparator(Menu),
85    create_menu_item(Menu,Is,Win,Id+1,Connect);
86create_menu_item(Menu, [{Name, _N, cascade, Items}|Is], Win, Id0,Connect) ->
87    Sub = wxMenu:new([]),
88    Id = create_menu_item(Sub, Items, Win, Id0, false),
89    _ = wxMenu:append(Menu, ?wxID_ANY, menu_name(Name,ignore), Sub),
90    %% Simulate GS sub checkBox/RadioBox behaviour
91    Self = self(),
92    Butts = [{MI,get(MI)} || {MI,_,_} <- Items],
93    IsChecked = fun({MiName,MI},Acc) ->
94			case wxMenuItem:isChecked(MI) of
95			    true -> [MiName|Acc];
96			    false -> Acc
97			end
98		end,
99    Filter = fun(Ev,_) ->
100		     Enabled = lists:foldl(IsChecked, [], Butts),
101		     Self ! Ev#wx{userData={Name, Enabled}}
102	     end,
103    _ = wxMenu:connect(Win, command_menu_selected,
104		       [{id,Id0},{lastId, Id-1},{callback,Filter}]),
105    create_menu_item(Menu, Is, Win, Id, Connect);
106create_menu_item(Menu, [{Name,Pos}|Is], Win, Id, Connect) ->
107    MenuId = case lists:member(Name, ['Debugger']) of
108		 true -> ?wxID_HELP;
109		 _ ->    Id
110	     end,
111    Item = wxMenu:append(Menu, MenuId, menu_name(Name,Pos)),
112    put(Name,Item),
113    if Connect ->
114	    wxMenu:connect(Win, command_menu_selected, [{id,MenuId},{userData, Name}]);
115       true -> ignore
116    end,
117    create_menu_item(Menu,Is,Win,Id+1, Connect);
118create_menu_item(Menu, [{Name,N,check}|Is], Win, Id, Connect) ->
119    Item = wxMenu:appendCheckItem(Menu, Id, menu_name(Name,N)),
120    put(Name,Item),
121    if Connect ->
122	    wxMenu:connect(Win, command_menu_selected, [{id,Id},{userData, Name}]);
123       true -> ignore
124    end,
125    create_menu_item(Menu,Is,Win,Id+1,Connect);
126create_menu_item(Menu, [{Name, N, radio}|Is], Win, Id,Connect) ->
127    Item = wxMenu:appendRadioItem(Menu, Id, menu_name(Name,N)),
128    put(Name,Item),
129    if Connect ->
130	    wxMenu:connect(Win, command_menu_selected, [{id,Id},{userData, Name}]);
131       true -> ignore
132    end,
133    create_menu_item(Menu,Is,Win,Id+1,Connect);
134create_menu_item(_, [], _, Id,_) ->
135    Id.
136
137%%--------------------------------------------------------------------
138%% add_break(Name, Point) -> #break{}
139%%   Name = atom()
140%%   Point = {Mod, Line}
141%% The break will generate the following events:
142%%   #wx{userData= {break, Point, Event}}
143%%     Event = delete | {trigger, Action} | {status, Status}
144%%       Action = enable | disable | delete
145%%       Status = active | inactive
146%%--------------------------------------------------------------------
147add_break(Win, MenuName, Point) ->
148    %% Create a name for the breakpoint
149    {Mod, Line} = Point,
150    Label = to_string("~w ~5w", [Mod, Line]),
151
152    Menu = get(MenuName),
153    %% Create a menu for the breakpoint
154    Add = fun(Item,Action) ->
155		  Id = wxMenuItem:getId(Item),
156		  wxMenu:connect(Win, command_menu_selected,
157				 [{id,Id}, {userData, Action}])
158	  end,
159    Sub = wxMenu:new([]),
160    Dis = wxMenu:append(Sub, ?wxID_ANY, "Disable"),
161    Add(Dis, {break,Point,status}),
162    Del = wxMenu:append(Sub, ?wxID_ANY, "Delete"),
163    Add(Del, {break,Point,delete}),
164    Trigger = wxMenu:new([]),
165    Enable = wxMenu:appendRadioItem(Trigger, ?wxID_ANY,"Enable"),
166    Add(Enable, {break,Point,{trigger,enable}}),
167    TDisable = wxMenu:appendRadioItem(Trigger, ?wxID_ANY,"Disable"),
168    Add(TDisable, {break,Point,{trigger,disable}}),
169    Delete = wxMenu:appendRadioItem(Trigger, ?wxID_ANY,"Delete"),
170    Add(Delete, {break,Point,{trigger,delete}}),
171
172    _ = wxMenu:append(Sub, ?wxID_ANY, "Trigger Action", Trigger),
173    MenuBtn = wxMenu:append(Menu,?wxID_ANY, Label, Sub),
174
175    #break{mb={Menu,MenuBtn},
176	   smi=Dis, emi=Enable, dimi=TDisable, demi=Delete}.
177
178%%--------------------------------------------------------------------
179%% update_break(Break, Options)
180%%   Break = #break{}
181%%   Options = [Status, Action, Mods, Cond]
182%%     Status = active | inactive
183%%     Action = enable | disable | delete
184%%     Mods = null (not used)
185%%     Cond = null | {Mod, Func}
186%%--------------------------------------------------------------------
187update_break(Break, Options) ->
188    [Status, Trigger|_] = Options,
189
190    Label = case Status of
191		active -> "Disable";
192		inactive -> "Enable"
193	    end,
194    wxMenuItem:setText(Break#break.smi, Label),
195
196    TriggerMI = case Trigger of
197		    enable -> Break#break.emi;
198		    disable -> Break#break.dimi;
199		    delete -> Break#break.demi
200		end,
201    wxMenuItem:check(TriggerMI).
202
203%%--------------------------------------------------------------------
204%% delete_break(Break)
205%%   Break = #break{}
206%%--------------------------------------------------------------------
207delete_break(Break) ->
208    {Menu, MenuBtn} = Break#break.mb,
209    wxMenu:'Destroy'(Menu,MenuBtn).
210
211%%--------------------------------------------------------------------
212%% motion(X, Y) -> {X, Y}
213%%   X = Y = integer()
214%%--------------------------------------------------------------------
215motion(X, Y) ->
216    receive
217	{gs, _Id, motion, _Data, [NX,NY]} ->
218	    motion(NX, NY)
219    after 0 ->
220	    {X, Y}
221    end.
222
223
224%%--------------------------------------------------------------------
225%% confirm(MonWin, String) -> ok | cancel
226%%--------------------------------------------------------------------
227
228confirm(Win,Message) ->
229    MD = wxMessageDialog:new(Win,to_string(Message),
230			     [{style, ?wxOK bor ?wxCANCEL},
231			      {caption, "Confirm"}]),
232    Res = case wxDialog:showModal(MD) of
233	      ?wxID_OK -> ok;
234	      _ -> cancel
235	  end,
236    wxDialog:destroy(MD),
237    Res.
238
239%%--------------------------------------------------------------------
240%% notify(MonWin, String) -> ok
241%%--------------------------------------------------------------------
242
243notify(Win,Message) ->
244    MD = wxMessageDialog:new(Win,to_string(Message),
245			     [{style, ?wxOK},
246			      {caption, "Confirm"}]),
247    wxDialog:showModal(MD),
248    wxDialog:destroy(MD),
249    ok.
250
251%%--------------------------------------------------------------------
252%% entry(Parent, Title, Prompt, {Type, Value}) -> {Prompt, Val} | cancel
253%%--------------------------------------------------------------------
254
255entry(Parent, Title, Prompt, {Type, Value}) ->
256    Ted = wxTextEntryDialog:new(Parent, to_string(Prompt),
257				[{caption, to_string(Title)},
258				 {value, Value}]),
259
260    case wxDialog:showModal(Ted) of
261	?wxID_OK ->
262	    Res = case verify(Type, wxTextEntryDialog:getValue(Ted)) of
263		      {edit,NewVal} ->
264			  {Prompt,NewVal};
265		      ignore ->
266			  cancel
267		  end,
268	    wxTextEntryDialog:destroy(Ted),
269	    Res;
270	_ ->
271	    cancel
272    end.
273
274
275verify(Type, Str) ->
276    case erl_scan:string(Str, 1, [text]) of
277	{ok, Tokens, _EndLine} when Type==term ->
278	    case erl_eval:extended_parse_term(Tokens++[{dot, erl_anno:new(1)}]) of
279		{ok, Value} -> {edit, Value};
280		_Error ->
281		    ignore
282	    end;
283	{ok, [{Type, _Line, Value}], _EndLine} when Type/=term ->
284	    {edit, Value};
285	_Err ->
286	    ignore
287    end.
288
289%%--------------------------------------------------------------------
290%% open_help/2
291%%    opens browser with help file
292%%--------------------------------------------------------------------
293open_help(_Parent, HelpHtmlFile) ->
294    wx_misc:launchDefaultBrowser("file://" ++ HelpHtmlFile).
295
296%%--------------------------------------------------------------------
297%% to_string(Term) -> [integer()]
298%% to_string(Format,Args) -> [integer()]
299%%--------------------------------------------------------------------
300
301to_string(Atom) when is_atom(Atom) ->
302    atom_to_list(Atom);
303to_string(Integer) when is_integer(Integer) ->
304    integer_to_list(Integer);
305to_string([]) -> "";
306to_string(List) when is_list(List) ->
307    try unicode:characters_to_list(List)
308    catch _:_ ->
309            io_lib:format("~tp",[List])
310    end;
311to_string(Term) ->
312    io_lib:format("~tp",[Term]).
313
314to_string(Format,Args) ->
315    io_lib:format(Format, Args).
316
317menu_name(Atom, N) when is_atom(Atom) ->
318    menu_name(atom_to_list(Atom),N);
319menu_name("Help", _) -> %% Mac needs this to be exactly this
320    "&Help";
321menu_name(Str, Pos) when is_integer(Pos) ->
322    {S1,[Key|_]=S2} = lists:split(Pos,Str),
323    S1 ++ [$&|S2] ++ "\tCtrl+" ++ string:uppercase([Key]);
324menu_name(Str,_) ->
325    Str.
326
327%%--------------------------------------------------------------------
328%% find_icon(File) -> Path or exists
329%%--------------------------------------------------------------------
330
331find_icon(File) ->
332    PrivDir = code:priv_dir(debugger),
333    PrivIcon = filename:append(PrivDir, File),
334    case filelib:is_regular(PrivIcon) of
335	true -> PrivIcon;
336	false ->
337	    CurrDir = filename:dirname(code:which(?MODULE)),
338	    CurrIcon = filename:append(CurrDir, File),
339	    true = filelib:is_regular(CurrIcon),
340	    CurrIcon
341    end.
342
343