aboutsummaryrefslogtreecommitdiffstats
path: root/lib/toolbar/src
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/toolbar/src
downloadotp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz
otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2
otp-84adefa331c4159d432d22840663c38f155cd4c1.zip
The R13B03 release.OTP_R13B03
Diffstat (limited to 'lib/toolbar/src')
-rw-r--r--lib/toolbar/src/Makefile93
-rw-r--r--lib/toolbar/src/canvasbutton.erl236
-rw-r--r--lib/toolbar/src/toolbar.app.src30
-rw-r--r--lib/toolbar/src/toolbar.appup.src19
-rw-r--r--lib/toolbar/src/toolbar.erl578
-rw-r--r--lib/toolbar/src/toolbar.hrl34
-rw-r--r--lib/toolbar/src/toolbar_graphics.erl401
-rw-r--r--lib/toolbar/src/toolbar_lib.erl223
-rw-r--r--lib/toolbar/src/toolbar_toolconfig.erl544
9 files changed, 2158 insertions, 0 deletions
diff --git a/lib/toolbar/src/Makefile b/lib/toolbar/src/Makefile
new file mode 100644
index 0000000000..14e1451609
--- /dev/null
+++ b/lib/toolbar/src/Makefile
@@ -0,0 +1,93 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 1996-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%
+#
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+include ../vsn.mk
+VSN=$(TOOLBAR_VSN)
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/lib/toolbar-$(VSN)
+
+# ----------------------------------------------------
+# Common Macros
+# ----------------------------------------------------
+
+MODULES= \
+ canvasbutton \
+ toolbar \
+ toolbar_graphics \
+ toolbar_lib \
+ toolbar_toolconfig
+
+HRL_FILES= toolbar.hrl
+
+ERL_FILES= $(MODULES:%=%.erl)
+
+TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR)) $(APP_TARGET) $(APPUP_TARGET)
+
+APP_FILE = toolbar.app
+APP_SRC = $(APP_FILE).src
+APP_TARGET = $(EBIN)/$(APP_FILE)
+
+APPUP_FILE = toolbar.appup
+APPUP_SRC = $(APPUP_FILE).src
+APPUP_TARGET = $(EBIN)/$(APPUP_FILE)
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+ERL_COMPILE_FLAGS += +warn_obsolete_guard
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+
+debug opt: $(TARGET_FILES)
+
+clean:
+ rm -f $(TARGET_FILES)
+ rm -f errs core *~
+
+$(APP_TARGET): $(APP_SRC) ../vsn.mk
+ sed -e 's;%VSN%;$(VSN);' $< > $@
+
+$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk
+ sed -e 's;%VSN%;$(VSN);' $< > $@
+
+docs:
+
+# ----------------------------------------------------
+# Release Target
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+release_spec: opt
+ $(INSTALL_DIR) $(RELSYSDIR)/src
+ $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(RELSYSDIR)/src
+ $(INSTALL_DIR) $(RELSYSDIR)/ebin
+ $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin
+
+release_docs_spec:
+
diff --git a/lib/toolbar/src/canvasbutton.erl b/lib/toolbar/src/canvasbutton.erl
new file mode 100644
index 0000000000..38fce537bb
--- /dev/null
+++ b/lib/toolbar/src/canvasbutton.erl
@@ -0,0 +1,236 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-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(canvasbutton).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Erlang Toolbar
+%
+%%% Description %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Extension to GS used to imitate buttons but instead using images drawn
+% on a canvas. Enables usage of .gif files as button images and not only
+% .xbm (bitmap) files.
+%
+%%% Constants %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+-define(gray,{87,87,87}).
+%
+%%% Internal data structures %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% canvasbutton()
+-record(canvasbutton,{image,rect,ul,ll}).
+%
+% cboptions()
+-record(cboptions,
+ {imagefile=nofile, % nofile |
+ % string() Name of image file
+ x=0, % integer() X coordinate relative the canvas
+ y=0, % integer() Y coordinate relative the canvas
+ width=10, % integer() Button width
+ height=10, % integer() Button heigth
+ fg=black, % atom() Foreground color
+ data=[]}). % term() Data associated with button events
+%
+%%% Exports %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+-export([create/1,create/2,read/2,press/1,release/1]).
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%% Exported functions %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%----------------------------------------
+% create(Canvas) => create(Canvas,[])
+% create(Canvas,OptionList) => canvasbutton()
+% Canvas - GS canvas object
+% OptionList - [{Option,Value}]
+% Option, Value - see below
+% Create a canvasbutton with the given image on Canvas
+%
+% Option Value Default Comment
+% ----------------------------------------------------------------
+% image nofile | nofile Name of image file. Must be a bitmap
+% string() file (.xbm) or a GIF file (.gif).
+% x integer() 0 X coordinate relative to Canvas
+% y integer() 0 Y coordinate relative to Canvas
+% width integer() 10 Button width
+% height integer() 10 Button height
+% fg atom() black Foreground color, bitmaps only
+% data term() [] Data associated with button events
+%
+% The process calling this function will receive the following events:
+% {gs,GsObj,enter,{canvasbutton,Canvasbutton,Data},Args}
+% {gs,GsObj,leave,{canvasbutton,Canvasbutton,Data},Args}
+% {gs,GsObj,buttonpress,{canvasbutton,Canvasbutton,Data},Args}
+% {gs,GsObj,buttonrelease,{canvasbutton,Canvasbutton,Data},Args}
+% where GsObj and Args are a GS object and its Args field, respectively.
+%
+% Note that press/1 and release/1 has to be called explicitly to create
+% the illusion of the button being pressed or released.
+%----------------------------------------
+create(Canvas) ->
+ create(Canvas,[]).
+create(Canvas,OptionList) ->
+ Options = sort_out_options(OptionList),
+ X = Options#cboptions.x,
+ Y = Options#cboptions.y,
+ W = Options#cboptions.width,
+ H = Options#cboptions.height,
+
+ %% Buttons should have the same background color as the canvas
+ Bg = gs:read(Canvas,bc),
+
+ %% Draw image
+ Image = create_image(Options#cboptions.imagefile,Canvas,Bg,
+ Options#cboptions.fg,X,Y,W,H),
+
+ %% Draw upper left corner line
+ Ul = gs:create(line,Canvas,[{coords,[{X,Y+H},{X,Y},{X+W,Y}]},
+ {fg,white},{width,2}]),
+
+ %% Draw lower right corner line
+ Ll = gs:create(line,Canvas,[{coords,[{X,Y+H},{X+W,Y+H},{X+W,Y}]},
+ {fg,?gray},{width,2}]),
+
+
+ %% Draw a rectangle around all (for event catching when width and
+ %% height of button is larger than image)
+ Rect = gs:create(rectangle,Canvas,[{coords,[{X,Y},{X+W,Y+H}]},
+ {fill,Bg},
+ {buttonpress,true},
+ {buttonrelease,true},
+ {enter,true},{leave,true}]),
+
+ %% Now the canvas button is created
+ Canvasbutton = #canvasbutton{image=Image,rect=Rect,ul=Ul,ll=Ll},
+
+ Data = Options#cboptions.data,
+ gs:config(Rect,{data,{canvasbutton,Canvasbutton,Data}}),
+ gs:config(Image,{data,{canvasbutton,Canvasbutton,Data}}),
+ gs:config(Rect,lower),
+ gs:config(Image,raise),
+
+ Canvasbutton.
+
+%----------------------------------------
+% read(Canvasbutton,coords) => [{L,T},{R,B}]
+% Canvasbutton - canvasbutton()
+% Read a Canvasbutton's coordinates
+%----------------------------------------
+read(Canvasbutton,coords) ->
+ gs:read(Canvasbutton#canvasbutton.rect,coords).
+
+%----------------------------------------
+% press(Canvasbutton)
+% Canvasbutton - canvasbutton()
+% Create the illusion that Canvasbutton is pressed
+%----------------------------------------
+press(Canvasbutton) ->
+ gs:config(Canvasbutton#canvasbutton.ul,{fg,?gray}),
+ gs:config(Canvasbutton#canvasbutton.ll,{fg,white}),
+ case Canvasbutton#canvasbutton.image of
+ noimage ->
+ ignore;
+ Image ->
+ gs:config(Image,{move,{-1,-1}})
+ end.
+
+%----------------------------------------
+% release(Canvasbutton)
+% Canvasbutton - canvasbutton()
+% Create the illusion that Canvasbutton is released
+%----------------------------------------
+release(Canvasbutton) ->
+ gs:config(Canvasbutton#canvasbutton.ul,{fg,white}),
+ gs:config(Canvasbutton#canvasbutton.ll,{fg,?gray}),
+ case Canvasbutton#canvasbutton.image of
+ noimage ->
+ ignore;
+ Image ->
+ gs:config(Image,{move,{1,1}})
+ end.
+
+
+%%% Internal functions %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%----------------------------------------
+% create_image(ImageFile,Canvas,Bg,Fg,X,Y,W,H) => Image
+% ImageFile - string() Image file, must exist and be a bitmap file ending
+% with .xbm or a GIF file ending with .gif.
+% Canvas - GS canvas object
+% Bg - atom() Background color (bitmaps only)
+% Fg - atom() Foreground color (bitmaps only)
+% X, Y - int() X and Y coordinates for Image relative to Canvas
+% W, H - int() Width and height of Image
+% Image - GS canvas image object
+%----------------------------------------
+create_image(nofile,_,_,_,_,_,_,_) ->
+ noimage;
+create_image(ImageFile,Canvas,Bg,Fg,X,Y,W,H) ->
+ case lists:last(string:tokens(ImageFile,".")) of
+ "xbm" ->
+ gs:create(image,Canvas,
+ [{bitmap,ImageFile},
+ {bg,Bg},{fg,Fg},
+ {anchor,c},
+ {coords,[{X+1+W/2,Y+1+H/2}]},
+ {buttonpress,true},
+ {buttonrelease,true},
+ {enter,true},{leave,true}]);
+ "gif" ->
+ gs:create(image,Canvas,
+ [{load_gif,ImageFile},
+ {anchor,c},
+ {coords,[{X+W/2,Y+H/2}]},
+ {buttonpress,true},
+ {buttonrelease,true},
+ {enter,true},{leave,true}])
+ end.
+
+%----------------------------------------
+% sort_out_options(OptionList) => cboptions()
+% OptionList - see create/2
+% Insert members of option list into a cboptions record.
+%----------------------------------------
+sort_out_options(OptionList) ->
+ sort_out_options(OptionList,#cboptions{}).
+
+%----------------------------------------
+% sort_out_options(OptionList,Options) => cboptions()
+% OptionList - see create/2
+% Options - cboptions()
+% Called by sort_out_options/1.
+%----------------------------------------
+sort_out_options([{image,Image}|Rest],Options) ->
+ sort_out_options(Rest,Options#cboptions{imagefile=Image});
+sort_out_options([{x,X}|Rest],Options) ->
+ sort_out_options(Rest,Options#cboptions{x=X});
+sort_out_options([{y,Y}|Rest],Options) ->
+ sort_out_options(Rest,Options#cboptions{y=Y});
+sort_out_options([{width,Width}|Rest],Options) ->
+ sort_out_options(Rest,Options#cboptions{width=Width});
+sort_out_options([{height,Height}|Rest],Options) ->
+ sort_out_options(Rest,Options#cboptions{height=Height});
+sort_out_options([{fg,Fg}|Rest],Options) ->
+ sort_out_options(Rest,Options#cboptions{fg=Fg});
+sort_out_options([{data,Data}|Rest],Options) ->
+ sort_out_options(Rest,Options#cboptions{data=Data});
+sort_out_options([],Options) ->
+ Options.
diff --git a/lib/toolbar/src/toolbar.app.src b/lib/toolbar/src/toolbar.app.src
new file mode 100644
index 0000000000..16f03c497d
--- /dev/null
+++ b/lib/toolbar/src/toolbar.app.src
@@ -0,0 +1,30 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-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%
+%%
+{application, toolbar,
+ [{description, "Toolbar"},
+ {vsn, "%VSN%"},
+ {modules, [
+ toolbar,
+ toolbar_graphics,
+ toolbar_lib,
+ toolbar_toolconfig,
+ canvasbutton
+ ]},
+ {registered,[toolbar]},
+ {applications, [kernel, stdlib, gs]}]}.
diff --git a/lib/toolbar/src/toolbar.appup.src b/lib/toolbar/src/toolbar.appup.src
new file mode 100644
index 0000000000..7a435e9b22
--- /dev/null
+++ b/lib/toolbar/src/toolbar.appup.src
@@ -0,0 +1,19 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-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%
+%%
+{"%VSN%",[],[]}.
diff --git a/lib/toolbar/src/toolbar.erl b/lib/toolbar/src/toolbar.erl
new file mode 100644
index 0000000000..67967172fe
--- /dev/null
+++ b/lib/toolbar/src/toolbar.erl
@@ -0,0 +1,578 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-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(toolbar).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Erlang Toolbar
+%
+%%% Description %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Main module
+%
+%%% Includes %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+-include("toolbar.hrl").
+%
+%%% Exports %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+-export([start/0,version/0]).
+-export([update/0,quit/0]).
+-export([create_tool_file/0,add_gs_contribs/0]).
+
+%
+-define (STARTUP_TIMEOUT, 20000).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%% Exported functions %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%----------------------------------------
+% start() => ok | already_started
+%----------------------------------------
+start() ->
+ case whereis(toolbar) of
+ undefined ->
+ Self = self(),
+ PidInit = spawn(fun() -> init(Self) end),
+ init_ok (PidInit);
+
+ _Pid ->
+ already_started
+ end.
+
+
+
+%%% init_ok /1
+%%%
+%%% init_ok returns the pid from this process given from
+%%% init/1 after its initialization, or else it timeouts.
+%%%
+
+init_ok (PidInit) ->
+ %% Wait for a initialization completion message from
+ %% the spawned process before returning its Pid.
+ %%
+
+ receive
+ {initialization_complete, PidInit} ->
+ PidInit
+
+ %% (Conditional) Failure to start within the time limit will
+ %% result in termination
+
+ after
+ ?STARTUP_TIMEOUT ->
+ exit(PidInit, kill),
+ exit({startup_timeout, ?MODULE})
+ end.
+
+
+
+%----------------------------------------
+% version() -> string()
+% Returns the version number.
+%----------------------------------------
+version() ->
+ "1.1".
+
+%----------------------------------------
+% update() => ok | {error,not_started}
+% Make a search for new tools (*.tool files) in the current path.
+%----------------------------------------
+update() ->
+ call(update_toolbar).
+
+%----------------------------------------
+% quit() => ok | {error,not_started}
+% Quit the Toolbar.
+%----------------------------------------
+quit() ->
+ call(quit).
+
+%----------------------------------------
+% create_tool_file() => ok | {error,not_started}
+% Start the GUI for creating .tool files.
+%----------------------------------------
+create_tool_file() ->
+ call(create_tool_file).
+
+%----------------------------------------
+% add_gs_contribs() => ok | {error,not_started}
+% Add GS contributions.
+%----------------------------------------
+add_gs_contribs() ->
+ call(add_gs_contribs).
+
+
+%%% Internal functions %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%=============================================================================
+% Main loop
+%=============================================================================
+
+%----------------------------------------
+% init()
+%----------------------------------------
+init(PidCaller) ->
+ register (toolbar, self ()),
+
+ %% Start GS
+ S = gs:start([{kernel,true}]),
+
+ %% Draw main window
+ Window = toolbar_graphics:draw_window(S),
+
+ %% Add system defined Tool icons to main window
+ toolbar_graphics:cursor(Window,busy),
+ NewWindow = add_tools(Window,code:get_path()),
+ toolbar_graphics:cursor(Window,arrow),
+
+ %% Listen to configure events from the window
+ toolbar_graphics:listen_configure(NewWindow),
+
+ %% Notify caller that the process appears
+ %% to have been started.
+ PidCaller ! {initialization_complete, self()},
+
+ loop(S,NewWindow,null,undefined).
+
+%----------------------------------------
+% loop(S,Window,LoopData,TimerRef)
+% S - pid() GS
+% Window - tbwindow record (see toolbar_graphics.erl)
+% LoopData - term()
+% TimerRef - undefined | timer_ref()
+%----------------------------------------
+loop(S,Window,LoopData,TimerRef) ->
+ receive
+ %% test events
+ {ping, Pid} ->
+ Pid ! {toolbar, alive},
+ loop (S, Window, LoopData, TimerRef);
+
+ {stop, Pid} ->
+ Pid ! {toolbar, stopped},
+ finished;
+
+ %% ----- GS events ----- %%
+
+ {gs,_Object,Event,Data,Args} ->
+ case toolbar_graphics:event(LoopData,Event,Data,Args) of
+
+ noevent ->
+ loop(S,Window,LoopData,TimerRef);
+
+ %% Display short information message
+ {display,Msg} ->
+
+ {ok,Ref} = timer:apply_after(500,toolbar_graphics,
+ display_show,[Window,Msg]),
+ loop(S,Window,LoopData,Ref);
+
+ %% Clear display area
+ display_clear ->
+ timer:cancel(TimerRef),
+ toolbar_graphics:display_clear(Window),
+ loop(S,Window,LoopData,undefined);
+
+ %% New LoopData
+ {newData,NewLoopData} ->
+ loop(S,Window,NewLoopData,TimerRef);
+
+ %% Icon button clicked, start corresponding tool/uc
+ {start,Start} ->
+ WinObj = toolbar_graphics:get_window(Window),
+ start_tool(Start,WinObj),
+ loop(S,Window,LoopData,TimerRef);
+
+ %% Update Toolbar
+ update_toolbar ->
+ toolbar_graphics:cursor(Window,busy),
+ NewWindow = add_tools(Window,code:get_path()),
+ toolbar_graphics:cursor(Window,arrow),
+ loop(S,NewWindow,LoopData,TimerRef);
+
+ %% Start Tool Configuration tool
+ create_tool_file ->
+ toolbar_toolconfig:start(),
+ loop(S,Window,LoopData,TimerRef);
+
+ %% Add GS contributions
+ add_gs_contribs ->
+ toolbar_graphics:cursor(Window,busy),
+ GsDir = toolbar_lib:gs_contribs_dir(),
+ code:add_path(GsDir),
+ NewWindow = add_tools(Window,[GsDir]),
+ toolbar_graphics:cursor(Window,arrow),
+ loop(S,NewWindow,LoopData,TimerRef);
+
+ %% Help
+ {help,Html} ->
+ toolbar_graphics:cursor(Window,busy),
+ WinObj = toolbar_graphics:get_window(Window),
+ tool_utils:open_help(WinObj, Html),
+ toolbar_graphics:cursor(Window,arrow),
+ loop(S,Window,LoopData,TimerRef);
+
+ %% About help
+ about_help ->
+ WinObj = toolbar_graphics:get_window(Window),
+ Text = ["Help text is on HTML format",
+ "Requires Netscape to be up and running"],
+ tool_utils:notify(WinObj, Text),
+ loop(S,Window,LoopData,TimerRef);
+
+ %% Window has been resized, redraw it
+ {redraw,Size} ->
+ NewWindow = toolbar_graphics:redraw_window(Window,Size),
+ loop(S,NewWindow,LoopData,TimerRef);
+
+ %% Quit
+ quit ->
+ finished
+ end;
+
+ %% ----- Events from user ----- %%
+
+ %% Update Toolbar
+ update_toolbar ->
+ toolbar_graphics:cursor(Window,busy),
+ NewWindow = add_tools(Window,code:get_path()),
+ toolbar_graphics:cursor(Window,arrow),
+ loop(S,NewWindow,LoopData,TimerRef);
+
+ %% Quit
+ quit ->
+ finished;
+
+ %% Start Tool Configuration tool
+ create_tool_file ->
+ toolbar_toolconfig:start(),
+ loop(S,Window,LoopData,TimerRef);
+
+ %% Add GS contributions
+ add_gs_contribs ->
+ toolbar_graphics:cursor(Window,busy),
+ GsDir = toolbar_lib:gs_contribs_dir(),
+ code:add_path(GsDir),
+ NewWindow = add_tools(Window,[GsDir]),
+ toolbar_graphics:cursor(Window,arrow),
+ loop(S,NewWindow,LoopData,TimerRef);
+
+ Other ->
+ io:format("toolbar: unexp msg ~p~n",[Other]),
+ loop(S,Window,LoopData,TimerRef)
+ end.
+
+%----------------------------------------
+% call(Msg) => ok | {error,not_started}
+% Msg - term()
+% Send message to toolbar if it is started, otherwise return an error
+%----------------------------------------
+call(Msg) ->
+ case whereis(toolbar) of
+ undefined ->
+ {error,not_started};
+ _ ->
+ toolbar ! Msg,
+ ok
+ end.
+
+
+%=============================================================================
+% Addition of new tools
+%=============================================================================
+%----------------------------------------
+% add_tools(Window,Dirs) => NewWindow
+% Window, NewWindow - tbwindow record (see toolbar_graphics.erl)
+% Dirs - [string()] Directory names
+% Calls add_tools2/2 recursively for a number of directories
+%----------------------------------------
+add_tools(Window,[Dir|Rest]) when is_list(Dir) ->
+
+ %% Add all tools in the directory Dir
+ NewWindow = add_tools2(Window,tool_files(Dir)),
+
+ case filename:basename(Dir) of
+ %% Dir is an 'ebin' directory, check in '../priv' as well
+ "ebin" ->
+ NewerWindow =
+ add_tools2(NewWindow,
+ tool_files(filename:join(filename:dirname(Dir),
+ "priv"))),
+ add_tools(NewerWindow,Rest);
+ _ ->
+ add_tools(NewWindow,Rest)
+ end;
+add_tools(Window,[]) ->
+ Window.
+
+%----------------------------------------
+% add_tools2(Window,ToolFiles) => NewWindow
+% Window, NewWindow - tbwindow record (see toolbar_graphics.erl)
+% ToolFiles - [string()] *.tool file names
+% Calls add_tool/2 recursively for a number of .tool files in a directory
+%----------------------------------------
+add_tools2(Window,[ToolFile|Rest]) ->
+ case add_tool(Window,ToolFile) of
+ {ok,NewWindow} ->
+ add_tools2(NewWindow,Rest);
+ {error,_Reason} ->
+ add_tools2(Window,Rest)
+ end;
+add_tools2(Window,[]) ->
+ Window.
+
+%----------------------------------------
+% add_tool(Window,ToolFile) => {ok,NewWindow} | {error,Reason}
+% Window, NewWindow - tbwindow record (see toolbar_graphics.erl)
+% ToolFile - string() A .tool file
+% Reason - noname | nostart | version | format | read | open
+% Reads tool information from a .tool file and adds it to the toolbar
+% Returns the new window information
+%----------------------------------------
+add_tool(Window,ToolFile) ->
+ case tool_info(ToolFile) of
+ {ok,ToolInfo} ->
+ case toolbar_graphics:already_added(Window,ToolInfo) of
+ true ->
+ {ok,Window};
+ false ->
+ NewWindow = toolbar_graphics:add_icon(Window,ToolInfo),
+ {ok,NewWindow}
+ end;
+ {error,Reason} ->
+ %% Log
+ {error,Reason}
+ end.
+
+
+%=============================================================================
+% Functions for getting *.tool configuration files
+%=============================================================================
+
+%----------------------------------------
+% tool_files(Dir) => ToolFiles
+% Dir - string() Directory name
+% ToolFiles - [string()]
+% Return the list of all files in Dir ending with .tool (appended to Dir)
+%----------------------------------------
+tool_files(Dir) ->
+ case file:list_dir(Dir) of
+ {ok,Files} ->
+ filter_tool_files(Dir,Files);
+ {error,_Reason} ->
+ []
+ end.
+
+%----------------------------------------
+% filter_tool_files(Dir,Files) => ToolFiles
+% Dir - string() Directory name
+% Files, ToolFiles - [string()] File names
+% Filters out the files in Files ending with .tool and append them to Dir
+%----------------------------------------
+filter_tool_files(_Dir,[]) ->
+ [];
+filter_tool_files(Dir,[File|Rest]) ->
+ case filename:extension(File) of
+ ".tool" ->
+ [filename:join(Dir,File)|filter_tool_files(Dir,Rest)];
+ _ ->
+ filter_tool_files(Dir,Rest)
+ end.
+
+
+%=============================================================================
+% Functions for retrieving tool information from *.tool files
+%=============================================================================
+
+%----------------------------------------
+% tool_info(ToolFile) => {ok,ToolInfo} | {error,Reason}
+% ToolFile - string() .tool file
+% ToolInfo - toolinfo record
+% Reason - nofile | format | noname | nostart
+% Retreives tool information from ToolFile
+%----------------------------------------
+tool_info(ToolFile) ->
+ case file:consult(ToolFile) of
+ {error,open} ->
+ {error,nofile};
+ {error,read} ->
+ {error,format};
+ {ok,[{version,Vsn},InfoTuple]} when is_tuple(InfoTuple)->
+ case toolbar_lib:tool_info_syntax(Vsn,InfoTuple) of
+
+ %% Syntax check ok, start additional checks
+ {ok,InfoList} ->
+
+ tool_info2(filename:dirname(ToolFile),
+ InfoList,#toolinfo{});
+
+ %% Syntax error
+ Error ->
+ Error
+ end;
+ {ok,[{version,Vsn},ToolInfo]} when is_list(ToolInfo)->
+ case toolbar_lib:tool_info_syntax(Vsn,ToolInfo) of
+
+ %% Syntax check ok, start additional checks
+ {ok,InfoList} ->
+ tool_info2(filename:dirname(ToolFile),
+ InfoList,#toolinfo{});
+
+ %% Syntax error
+ Error ->
+ Error
+ end;
+ {ok,_Other} ->
+ {error,format}
+ end.
+
+%----------------------------------------
+% tool_info2(Dir,Info,ToolInfo) => {ok,ToolInfo}
+% Dir - string() Directory where this .tool file is situated
+% Info - [{Key,Val}] List of tuples in the .tool file
+% ToolInfo - toolinfo record being filled in
+% Used by tool_info2/1
+%----------------------------------------
+%%% Tool name
+tool_info2(Dir,[{tool,Name}|Rest],TI) ->
+ tool_info2(Dir,Rest,TI#toolinfo{tool=Name});
+
+%%% Start function
+tool_info2(Dir,[{start,{M,F,A}}|Rest],TI) ->
+ tool_info2(Dir,Rest,TI#toolinfo{start={M,F,A}});
+
+%%% Icon file
+%%% It must exist since the icon is drawn immediately after this .tool
+%%% file has been successfully read
+%%% It must also end with a .gif or .xbm suffix
+%%% Otherwise the icon is ignored!
+%%% Uses absolute path: If a relative path is given, it is assumed to be
+%%% relative to the directory of the .tool file
+tool_info2(Dir,[{icon,Icon}|Rest],TI) ->
+
+ %% Check that the image file ends with .xbm or .gif
+ case image_suffix(Icon) of
+ true ->
+
+ %% Add absolute path (if necessary)
+ File = absolute_path(Dir,Icon),
+
+ case toolbar_lib:legal_file(File) of
+ ok ->
+ tool_info2(Dir,Rest,TI#toolinfo{icon=File});
+ _Error ->
+ %% LOG File does not exist or cannot be read
+ tool_info2(Dir,Rest,TI)
+ end;
+
+ false ->
+ %% LOG Illegal icon file name
+ tool_info2(Dir,Rest,TI)
+ end;
+
+%%% Message string
+tool_info2(Dir,[{message,Msg}|Rest],TI) ->
+ tool_info2(Dir,Rest,TI#toolinfo{message=Msg});
+
+%%% Html file is found
+%%% Check if file exists at "view-time", not now!
+%%% Uses absolute path: If a relative path is given, it is assumed to be
+%%% relative to the directory of the .tool file
+tool_info2(Dir,[{html,Html}|Rest],TI) ->
+
+ %% Check if the HTML file is a remote URL or a local file
+ case Html of
+
+ %% http://... Remote URL, save as is
+ [$h,$t,$t,$p,$:,$/,$/|_] ->
+ tool_info2(Dir,Rest,TI#toolinfo{html=Html});
+
+ %% file:... Local file, save file with absolute path
+ [$f,$i,$l,$e,$:|File] ->
+ tool_info2(Dir,Rest,TI#toolinfo{html=absolute_path(Dir,File)});
+
+ %% Everything else is assumed to be a file name
+ %% Save file with absolute path
+ _ ->
+ tool_info2(Dir,Rest,TI#toolinfo{html=absolute_path(Dir,Html)})
+ end;
+
+%%% Info has been traversed
+tool_info2(_Dir,[],ToolInfo) ->
+ {ok,ToolInfo}.
+
+%----------------------------------------
+% image_suffix(File) => true | false
+% File - string() File name
+% Returns true if File end with an image suffix: gif or xbm
+%----------------------------------------
+image_suffix(File) ->
+ case filename:extension(File) of
+ ".gif" ->
+ true;
+ ".xbm" ->
+ true;
+ _ ->
+ false
+ end.
+
+%----------------------------------------
+% absolute_path(Dir,File) => string()
+% Dir, File - string()
+% Given a directory and a file name, return the appended result if the file
+% name does not already contain an absolute path.
+% Dir is supposed to be an absolute path, if it is '.', it is replaced
+% with the current working directory.
+%----------------------------------------
+absolute_path(".",File) ->
+ {ok,Cwd} = file:get_cwd(),
+ absolute_path(Cwd,File);
+absolute_path(Dir,File) ->
+ filename:join(Dir,File).
+
+
+%=============================================================================
+% Start of a tool
+%=============================================================================
+
+%----------------------------------------
+% start_tool({Module,Function,Arguments}, GSobj)
+% Module - atom() Module name
+% Function - atom() Function name
+% Argument - [term()] Function arguments
+% GSobj - gs_obj()
+% Applies the given function in order to start a tool.
+%----------------------------------------
+start_tool({M,F,A}, GSobj) ->
+ spawn(fun() -> start_tool(M, F, A, GSobj) end).
+
+start_tool(M,F,A,GSobj) ->
+ case catch apply(M,F,A) of
+ {'EXIT',Reason} ->
+ String1 = io_lib:format("Failed to call apply(~p,~p,~p)",
+ [M,F,A]),
+ String2 = io_lib:format("Reason: ~p",[Reason]),
+ tool_utils:notify(GSobj,[String1,String2]),
+ false;
+ _ ->
+ true
+ end.
diff --git a/lib/toolbar/src/toolbar.hrl b/lib/toolbar/src/toolbar.hrl
new file mode 100644
index 0000000000..1793cd1833
--- /dev/null
+++ b/lib/toolbar/src/toolbar.hrl
@@ -0,0 +1,34 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-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%
+%%
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Erlang Toolbar
+%
+%%% Common data structures %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Tool configuration information
+-record(toolinfo,
+ {tool,
+ start,
+ icon=nofile,
+ message="",
+ html=nofile}).
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
diff --git a/lib/toolbar/src/toolbar_graphics.erl b/lib/toolbar/src/toolbar_graphics.erl
new file mode 100644
index 0000000000..ad390440e3
--- /dev/null
+++ b/lib/toolbar/src/toolbar_graphics.erl
@@ -0,0 +1,401 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-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(toolbar_graphics).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Erlang Toolbar
+%
+%%% Description %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Toolbar graphics.
+% The Toolbar window looks something like this:
+%
+% |-----------------------------|
+% | File Tools Help |
+% |-----------------------------|
+% | |-----| |-----| |-----| |
+% | | | | | | | |
+% | |Icon1| |Icon2|...|IconN| |
+% | |-----| |-----| |-----| |
+% |-----------------------------|
+% | Help text area |
+% |-----------------------------|
+%
+%%% Includes %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+-include("toolbar.hrl").
+%
+%%% Internal data structures %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Toolbar window record
+-record(tbwindow,
+ {window,menubar,canvas,labelframe,
+ label,helpmenu,
+ no_of_buttons,
+ min_height,min_width,cur_height,icons}).
+%
+%%% Constants %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Window width
+-define(width,215).
+%
+% Icon width and height
+-define(icon,34).
+%
+% Margin around icons
+-define(pad,0).
+%
+% Default label width and height
+-define(wlabel,50).
+-define(hlabel,15).
+%
+% Default button width and height
+-define(wbutton,50).
+-define(hbutton,30).
+%
+%%% Exports %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+-export([event/4]).
+-export([draw_window/1,redraw_window/2,already_added/2,add_icon/2]).
+-export([get_window/1]).
+-export([cursor/2]).
+-export([listen_configure/1]).
+-export([display_show/2,display_clear/1]).
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%% Exported functions %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%----------------------------------------
+% event(Data,GsEvent,Data,Args) => Event
+% Data - term()
+% GsEvent - GS event
+% Data, Args - Data and Arg fields associated with the GS event
+% Event - {display,String} | display_clear | noevent | {start,{M,F,A}} |
+% update_toolbar | create_tool_file | add_gs_contribs |
+% {help,Html} | about_help | {redraw,{Width,Height}} | quit |
+% {newData,NewData}
+% String - string()
+% M, F - atom() Module and function name
+% A - [term()] Function argument
+% Html - string() HTML file | nofile
+% Width, Height - integer()
+% NewData - term()
+% Tries to convert a GS event to an internal toolbar event. The separation
+% is intented to keep the implementation details of the graphics hidden
+% for toolbar.erl. Pure graphical events triggered by the GS event will
+% be executed by this function.
+% The Data field is used for saving information between different events
+% (without having to use put/get or ets). Right now it is only used to save
+% the coordinates of the last canvasbutton pressed, making it possible to
+% check if the canvasbutton is released with the mouse moved outside the
+% button (= no action) or with the mouse still inside the button (= action).
+%----------------------------------------
+%%% Mouse enters a icon, display short help message
+event(_LoopData,enter,{canvasbutton,_Cbtn,{_Start,{message,String}}},_Args) ->
+ {display,String};
+
+%% Mouse leaves a icon, clear display area
+event(_LoopData,leave,{canvasbutton,_Cbtn,_Data},_Args) ->
+ display_clear;
+
+%% An icon is pressed, create graphical illusion of this
+event(_LoopData,buttonpress,{canvasbutton,Canvasbutton,_},_Args) ->
+ canvasbutton:press(Canvasbutton),
+ {newData,canvasbutton:read(Canvasbutton,coords)};
+
+%% An icon is released, create graphical illusion of this
+event(LoopData,buttonrelease,{canvasbutton,Cbtn,{{start,Start},_Msg}},
+ [_,X,Y|_]) ->
+ canvasbutton:release(Cbtn),
+ case within(X,Y,LoopData) of
+ true ->
+ {start,Start};
+ false ->
+ noevent
+ end;
+
+%%% Update Toolbar button pressed
+event(_LoopData,click,_Data,["Update Toolbar"|_]) ->
+ update_toolbar;
+
+%%% Tool configuration button pressed
+event(_LoopData,click,_Data,["Create Tool File..."|_]) ->
+ create_tool_file;
+
+%%% Add GS contribution button pressed
+event(_LoopData,click,_Data,["Add GS Contributions"|_]) ->
+ add_gs_contribs;
+
+%%% Help menu button selected
+event(_LoopData,click,{help,Html},_Args) ->
+ {help,Html};
+
+%%% About Help menu button selected
+event(_LoopData,click,about_help,_Args) ->
+ about_help;
+
+%% Window resized, redraw it
+event(_LoopData,configure,_Data,[Width,Height|_]) ->
+ {redraw,{Width,Height}};
+
+%%% Quit button pressed
+event(_LoopData,click,_Data,["Quit"|_]) ->
+ quit;
+
+%%% Window closed
+event(_LoopData,destroy,_Data,_Args) ->
+ quit;
+
+event(_LoopData,_GsEvent,_Data,_Args) ->
+ noevent.
+
+%=============================================================================
+% Main window functions
+%=============================================================================
+
+%----------------------------------------
+% draw_window(S) => Window
+% S - pid() GS
+% Window - tbwindow record
+% This functions create the main window, initially without any tool icons
+%----------------------------------------
+draw_window(S) ->
+
+ Norm = ?icon + 2*?pad,
+
+ %% Main window
+ Win = gs:create(window,S,[{title,"Erlang Tools"},{width,?width}]),
+
+ %% Menu bar with menu buttons
+ Menubar = gs:create(menubar,Win,[]),
+
+ %% File menu
+ File = gs:create(menubutton,Menubar,[{label,{text,"File"}},{side,left}]),
+ FileM = gs:create(menu,File,[]),
+ gs:create(menuitem,FileM,[{label,{text,"Update Toolbar"}}]),
+ gs:create(menuitem,FileM,[{label,{text,"Quit"}}]),
+
+ %% Tools menu
+ Tool = gs:create(menubutton,Menubar,[{label,{text,"Tools"}},{side,left}]),
+ ToolM = gs:create(menu,Tool,[]),
+ gs:create(menuitem,ToolM,[{label,{text,"Create Tool File..."}}]),
+ gs:create(menuitem,ToolM,[{label,{text,"Add GS Contributions"}}]),
+
+ %% Help menu
+ Help = gs:create(menubutton,Menubar,[{label,{text,"Help"}},{side,right}]),
+ HelpM = gs:create(menu,Help,[]),
+ gs:create(menuitem,HelpM,[{label,{text,"About..."}},
+ {data,about_help}]),
+ gs:create(menuitem,HelpM,[{label,{text,"Toolbar"}},
+ {data,{help,toolbar_lib:help_file()}}]),
+ gs:create(menuitem,HelpM,[{label,{text,"OTP"}},
+ {data,{help,toolbar_lib:otp_file()}}]),
+ gs:create(menuitem,HelpM,[{itemtype,separator}]),
+
+ %% Check height of menu bar
+ H = gs:read(Menubar,height),
+
+ %% Now the height of the window can be computed
+ Height = H+Norm+?hlabel+2*?pad,
+ gs:config(Win,{height,Height}),
+
+ %% Canvas, here will the Tool canvasbuttons be inserted
+ Canvas = gs:create(canvas,Win,[{width,?width},{height,Norm},{x,0},{y,H}]),
+
+ %% Label for displaying help messages and the frame containing it
+ LabelF = gs:create(frame,Win,[{bg,green},{bw,1},
+ {width,?width},{height,?hlabel+2*?pad},
+ {x,0},{y,H+Norm}]),
+ Label = gs:create(label,LabelF,[{align,w},{height,?hlabel},
+ {width,?width},{x,?pad},{y,?pad},
+ {label,{text,string:copies(" ",30)}}]),
+
+ gs:config(Win,{map,true}),
+
+ #tbwindow{window=Win,
+ menubar=Menubar,canvas=Canvas,labelframe=LabelF,
+ label=Label,helpmenu=HelpM,
+ no_of_buttons=0,
+ min_height=Height,min_width=?width,cur_height=Height,
+ icons=[]}.
+
+%----------------------------------------
+% redraw_window(Window,{NewWidth,NewHeight}) => NewWindow
+% Window, NewWindow - tbwindow record
+% NewWidth, NewHeight - integer()
+% Redraw main window contents according to a new size
+%----------------------------------------
+redraw_window(Window,{NewWidth,NewHeight}) ->
+
+ MinWidth = Window#tbwindow.min_width,
+ if
+ NewWidth=<MinWidth ->
+ true;
+ true ->
+ gs:config(Window#tbwindow.canvas,{width,NewWidth}),
+ gs:config(Window#tbwindow.labelframe,{width,NewWidth}),
+ gs:config(Window#tbwindow.label,{width,NewWidth-2*?pad})
+ end,
+
+ MinHeight = Window#tbwindow.min_height,
+ if
+ NewHeight=<MinHeight ->
+ Window;
+ true ->
+
+ %% Compute size difference
+ Diff = NewHeight - Window#tbwindow.cur_height,
+
+ %% Resize button frame
+ Canvas = Window#tbwindow.canvas,
+ gs:config(Canvas,{height,gs:read(Canvas,height)+Diff}),
+
+ %% Move label frame accordingly
+ LabelF = Window#tbwindow.labelframe,
+ gs:config(LabelF,{y,gs:read(LabelF,y)+Diff}),
+
+ %% Return updated tbwindow record
+ Window#tbwindow{cur_height=NewHeight}
+ end.
+
+%----------------------------------------
+% already_added(Window,ToolInfo) => true | false
+% Window - tbwindow record
+% ToolInfo - toolinfo record
+% Returns true if ToolInfo contains information about a tool that
+% is already included in Window
+%----------------------------------------
+already_added(Window,ToolInfo) ->
+ already_added2(Window#tbwindow.icons,ToolInfo#toolinfo.tool).
+
+%----------------------------------------
+% already_added2(ToolInfos,Tool) => true | false
+% ToolInfos - [toolinfo record]
+% Tool - atom() Tool name
+%----------------------------------------
+already_added2([#toolinfo{tool=Tool}|_Rest],Tool) ->
+ true;
+already_added2([_|Rest],Tool) ->
+ already_added2(Rest,Tool);
+already_added2([],_ToolInfo) ->
+ false.
+
+%----------------------------------------
+% add_icon(Window,ToolInfo) => NewWindow
+% Window, NewWindow - tbwindow record
+% ToolInfo - toolinfo record
+% Add an icon to the main window
+%----------------------------------------
+add_icon(Window,ToolInfo) ->
+ Norm = ?icon + 2*?pad,
+
+ %% Extend window if necessary
+ N = Window#tbwindow.no_of_buttons,
+ ReqWidth = N*Norm+Norm,
+ CurWidth = gs:read(Window#tbwindow.window,width),
+ if
+ ReqWidth>CurWidth ->
+ gs:config(Window#tbwindow.window,{width,ReqWidth}),
+ gs:config(Window#tbwindow.canvas,{width,ReqWidth}),
+ gs:config(Window#tbwindow.labelframe,{width,ReqWidth}),
+ gs:config(Window#tbwindow.label,{width,ReqWidth-2*?pad});
+ true ->
+ true
+ end,
+
+ %% Insert icon into button frame
+ canvasbutton:create(Window#tbwindow.canvas,
+ [{image,ToolInfo#toolinfo.icon},
+ {x,N*Norm+?pad},{y,?pad},
+ {width,?icon},{height,?icon},
+ {data,{{start,ToolInfo#toolinfo.start},
+ {message,ToolInfo#toolinfo.message}}}]),
+
+ %% Insert tool name into help menu (if there is any help available)
+ case ToolInfo#toolinfo.html of
+ nofile ->
+ true;
+ Html ->
+ gs:create(menuitem,Window#tbwindow.helpmenu,
+ [{label,{text,ToolInfo#toolinfo.tool}},
+ {data,{help,Html}}])
+ end,
+
+ MinWidth = gs:read(Window#tbwindow.window,width),
+ Window#tbwindow{no_of_buttons=N+1,min_width=MinWidth,
+ icons=[ToolInfo|Window#tbwindow.icons]}.
+
+%----------------------------------------
+% get_window(Window) -> gs_obj()
+% Window - tbwindow record
+%----------------------------------------
+get_window(Window) ->
+ Window#tbwindow.window.
+
+%----------------------------------------
+% cursor(Window,Cursor)
+% Window - tbwindow record
+% Cursor - arrow | busy
+%----------------------------------------
+cursor(Window,Cursor) ->
+ gs:config(Window#tbwindow.window,{cursor,Cursor}).
+
+%----------------------------------------
+% listen_configure(Window)
+% Window - tbwindow record
+% Configure Window to listen for configure events
+%----------------------------------------
+listen_configure(Window) ->
+ gs:config(Window#tbwindow.window,{configure,true}).
+
+%----------------------------------------
+% display_show(Window,Text)
+% Window - tbwindow record
+% Text - string()
+% Display text in the help text area
+%----------------------------------------
+display_show(Window,Text) ->
+ gs:config(Window#tbwindow.label,{label,{text,Text}}).
+
+%----------------------------------------
+% display_clear(Window)
+% Window - tbwindow record
+% Clear the help text area
+%----------------------------------------
+display_clear(Window) ->
+ display_show(Window,"").
+
+%%% Internal functions %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%----------------------------------------
+% within(X,Y,[{Left,Top},{Right,Bot}]) => true | false
+% Return true if {X,Y} is within the given rectangle.
+%----------------------------------------
+within(X,Y,[{L,T},{R,B}]) ->
+ if
+ X>=L,
+ X=<R,
+ Y>=T,
+ Y=<B ->
+ true;
+ true ->
+ false
+ end.
diff --git a/lib/toolbar/src/toolbar_lib.erl b/lib/toolbar/src/toolbar_lib.erl
new file mode 100644
index 0000000000..9d3b9fdeb5
--- /dev/null
+++ b/lib/toolbar/src/toolbar_lib.erl
@@ -0,0 +1,223 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-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(toolbar_lib).
+-include_lib("kernel/include/file.hrl").
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Erlang Toolbar
+%
+%%% Description %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Library functions
+%
+%%% Exports %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+-export([gs_contribs_dir/0,help_file/0,otp_file/0]).
+-export([error_string/1]).
+-export([legal_file/1]).
+-export([insert_newlines/1]).
+-export([tool_info_syntax/2]).
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%% Exported functions %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%----------------------------------------
+% gs_contribs_dir() => string()
+% Return the directory of the GS contributions
+%----------------------------------------
+gs_contribs_dir() ->
+ filename:join(code:lib_dir(gs),"contribs/ebin/").
+
+%----------------------------------------
+% help_file() => string()
+% Returns the address to the toolbar help file
+%----------------------------------------
+help_file() ->
+ filename:join([code:lib_dir(toolbar),"doc", "html", "index.html"]).
+
+%----------------------------------------
+% otp_file() => string()
+% Returns the address to the OTP documentation
+%----------------------------------------
+otp_file() ->
+ filename:join([code:root_dir(),"doc", "index.html"]).
+
+%----------------------------------------
+% error_string(Reason) => string()
+% Reason - nofile | format | noname | nostart | illegal | raccess | waccess
+% Given Reason, returns a short "explanation string"
+%----------------------------------------
+error_string(nofile) -> "File does not exist";
+error_string(format) -> "File on wrong format";
+
+error_string(noname) -> "No tool name is specified";
+error_string(nostart) -> "No start function is specified";
+
+error_string(illegal) -> "Illegal file name";
+
+error_string(raccess) -> "File is not readable";
+error_string(waccess) -> "File is not writeable".
+
+%----------------------------------------
+% legal_file(File) => ok | directory | {error,nofile} | {error,raccess}
+% File - string() File name
+% Checks if File is an existing and readable file.
+%----------------------------------------
+legal_file(File) ->
+ case file:read_file_info(File) of
+
+ %% File exists...
+ {ok,#file_info{type=regular,access=Access}} ->
+ if
+
+ %% ...but is read protected
+ Access/=read,
+ Access/=read_write ->
+ {error,raccess};
+
+ %% ...and is possible to read
+ true ->
+ ok
+ end;
+
+ {ok,#file_info{type=directory}} ->
+ directory;
+
+ %% File does not exist
+ _Error ->
+ {error,nofile}
+ end.
+
+%----------------------------------------
+% insert_newlines(Strings) => string()
+% Strings - string() | [string()]
+% If Strings is a list of strings, return a string where all these strings
+% are concatenated with newlines in between, otherwise return Strings.
+%----------------------------------------
+insert_newlines([String|Rest]) when is_list(String), Rest/=[]->
+ String ++ "\n" ++ insert_newlines(Rest);
+insert_newlines([Last]) ->
+ [Last];
+insert_newlines(Other) ->
+ Other.
+
+%----------------------------------------
+% tool_info_syntax(Version,ToolInfo) => {ok,CorrToolInfo} | {error,Reason}
+% Version - string()
+% ToolInfo - tuple()
+% CorrToolInfo - list()
+% Reason - version | format | noname | nostart
+% Return a corrected (blanks removed etc) version of ToolInfo
+% if the syntax of ToolInfo is correct (ie contains all
+% mandatory elements and all values are of the specified type).
+%
+% Currently accepted versions:
+% "0.1" (which should be "1.0")
+% "1.1" (same as "0.1")
+%----------------------------------------
+tool_info_syntax("1.1",ToolInfo) ->
+ tool_info_syntax("0.1",ToolInfo);
+tool_info_syntax("0.1",ToolInfo) when is_tuple(ToolInfo) ->
+ syntax01(tuple_to_list(ToolInfo),false,false,[]);
+tool_info_syntax("0.1",_) ->
+ {error,format};
+tool_info_syntax("1.2",ToolInfo) when is_list(ToolInfo)->
+ syntax01(ToolInfo,false,false,[]);
+tool_info_syntax(_Vsn,_) ->
+ {error,version}.
+
+
+%%% Internal functions %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%----------------------------------------
+% syntax01(List,NameF,StartF,Res) => {ok,Res} | {error,Reason}
+% List - [tuple()]
+% NameF, StartF - boolean()
+% Res - [tuple()]
+% Reason - format | noname | nostart
+% Version 0.1 syntax check of .tool file.
+%----------------------------------------
+syntax01([{tool,Str}|Rest],false,StartF,Res) when is_list(Str) ->
+ case string:strip(Str) of
+ [] ->
+ {error,format};
+ Tool ->
+ syntax01(Rest,true,StartF,[{tool,Tool}|Res])
+ end;
+syntax01([{start,{M,F,A}}|Rest],NameF,false,Res) when is_atom(M),
+ is_atom(F),
+ is_list(A) ->
+ syntax01(Rest,NameF,true,[{start,{M,F,A}}|Res]);
+syntax01([{icon,Str}|Rest],NameF,StartF,Res) when is_list(Str) ->
+ case string:strip(Str) of
+ [] ->
+ syntax01(Rest,NameF,StartF,Res);
+ Icon ->
+ syntax01(Rest,NameF,StartF,[{icon,Icon}|Res])
+ end;
+syntax01([{message,Str}|Rest],NameF,StartF,Res) when is_list(Str) ->
+ case string:strip(Str) of
+ [] ->
+ syntax01(Rest,NameF,StartF,Res);
+ Message ->
+ syntax01(Rest,NameF,StartF,
+ [{message,lists:sublist(Message,1,30)}|Res])
+ end;
+syntax01([{html,Str}|Rest],NameF,StartF,Res) when is_list(Str) ->
+ case string:strip(Str) of
+ [] ->
+ syntax01(Rest,NameF,StartF,Res);
+ Html ->
+ syntax01(Rest,NameF,StartF,[{html,Html}|Res])
+ end;
+%%The fields used by webtool must be removed
+syntax01([_|Rest],NameF,StartF,Res) ->
+ syntax01(Rest,NameF,StartF,Res);
+
+syntax01([],true,true,Res) ->
+ {ok,Res};
+syntax01([],false,_,_) ->
+ {error,noname};
+syntax01([],_,false,_) ->
+ {error,nostart};
+syntax01(_,_,_,_) ->
+ {error,format}.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/lib/toolbar/src/toolbar_toolconfig.erl b/lib/toolbar/src/toolbar_toolconfig.erl
new file mode 100644
index 0000000000..7d8f2b4d21
--- /dev/null
+++ b/lib/toolbar/src/toolbar_toolconfig.erl
@@ -0,0 +1,544 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-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(toolbar_toolconfig).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Erlang Toolbar
+%
+%%% Description %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Tool configuration tool, edit and creates .tool files
+% This tool works separately from the toolbar.
+%
+%%% External data types %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% toolinfo() -- Tool configuration information
+-include("toolbar.hrl").
+%
+%%% Internal data types %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% tfwindow() -- Toolfile configuration window
+-record(tfwindow,
+ {window,
+ fileentry,
+ toolentry,moduleentry,functionentry,
+ iconentry,messageentry,htmlentry,
+ label}).
+%
+%%% Exports %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+-export([start/0]).
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-export([init/0]). % spawn
+
+
+%%% Exported functions %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%----------------------------------------
+% start() => pid()
+%----------------------------------------
+start() ->
+ spawn(toolbar_toolconfig,init,[]).
+
+
+%%% Internal functions %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%=============================================================================
+% Main loop
+%=============================================================================
+
+%----------------------------------------
+% init()
+%----------------------------------------
+init() ->
+
+ %% Start GS (or get the pid if it is already running)
+ S = gs:start(),
+
+ %% Draw the window
+ Window = draw_window(S),
+
+ loop(S,Window).
+
+%----------------------------------------
+% loop(S,Window)
+% S - pid() GS
+% Window - tfwindow()
+%----------------------------------------
+loop(S,Window) ->
+ receive
+
+ %% 'Return' pressed in the 'File' entry
+ {gs,_Obj,keypress,file,['Return'|_]} ->
+
+ %% Check if a file name is specified
+ case string:strip(gs:read(Window#tfwindow.fileentry,text)) of
+
+ %% No file name specified, move focus to next entry
+ "" ->
+ move_focus(Window,file);
+
+ %% A name is specified
+ String ->
+
+ %% Add a .tool suffix to the file name if necessary
+ FileName = tool_file(String),
+
+ %% Write the complete file name to the file entry
+ gs:config(Window#tfwindow.fileentry,{text,FileName}),
+
+ %% Try to open the file
+ case file:consult(FileName) of
+
+ %% File exists and seems ok
+ {ok,[{version,Vsn},T]} ->
+
+ %% Check the syntax of the file contents
+ %% (All mandatory information specified,
+ %% correct types, etc)
+ case toolbar_lib:tool_info_syntax(Vsn,T) of
+
+ %% Ok -- Show the file contents in the window
+ %% and move focus to the next entry
+ {ok,Info} ->
+ display(Window,"File: "++FileName++
+ " opened"),
+ clear_info(Window),
+ show_info(Window,Info),
+ move_focus(Window,file);
+
+ %% Erronous version number -- Notify user
+ {error,version} ->
+ Win = Window#tfwindow.window,
+ tool_utils:notify(Win,[FileName,
+ "File has wrong version number"]);
+
+ %% Other error -- Notify user
+ _Error ->
+ Win = Window#tfwindow.window,
+ tool_utils:notify(Win,[FileName,
+ "File is on erronous format"])
+ end;
+
+ %% The file can not be read, show default values
+ %% according to the file name in the window and
+ %% move focus to the next entry
+ _ ->
+ display(Window,"File: "++FileName ++
+ " could not be read, new file"),
+ Tool = filename:basename(FileName,".tool"),
+ clear_info(Window),
+ show_info(Window,[{tool,Tool},
+ {start,{list_to_atom(Tool),
+ start,[]}},
+ {icon,Tool++".gif"},
+ {html,Tool++".html"}]),
+ move_focus(Window,file)
+ end
+ end,
+ loop(S,Window);
+
+ %% 'Return' pressed in another entry, move focus to next entry
+ {gs,_Obj,keypress,Focus,['Return'|_]} ->
+ move_focus(Window,Focus),
+ loop(S,Window);
+
+ %% Any oher keypress, clear the display
+ {gs,_Obj,keypress,_Data,_Args} ->
+ display_clear(Window),
+ loop(S,Window);
+
+ %% 'Clear' button pressed, clear the window
+ {gs,_Obj,click,_Data,["Clear"|_]} ->
+ clear_info(Window),
+ loop(S,Window);
+
+ %% 'Save' button pressed, save the given information to file
+ {gs,_Obj,click,_Data,["Save"|_]} ->
+
+ %% Check if a file name is specified
+ case string:strip(gs:read(Window#tfwindow.fileentry,text)) of
+
+ %% No file name specified, notify user
+ "" ->
+ Win = Window#tfwindow.window,
+ tool_utils:notify(Win,
+ "A file name must be specified");
+
+ %% A name is specified
+ String ->
+
+ %% Add a .tool suffix to the file name if necessary
+ FileName = tool_file(String),
+
+ %% Write the complete file name to the file entry
+ gs:config(Window#tfwindow.fileentry,{text,FileName}),
+
+ %% Check the other information given
+ case check_info(Window) of
+
+ %% If given info is correct, try to save
+ %% it to the file
+ {ok,ToolInfo} ->
+ Win = Window#tfwindow.window,
+ case save_info(Win,FileName,ToolInfo) of
+
+ %% Ok, display confirmation
+ ok ->
+ display(Window,
+ "Tool information saved to "++
+ FileName);
+
+ %% Cancel, do nothing
+ cancel ->
+ ignore;
+
+ %% Error, display error message
+ {error,Reason} ->
+ display(Window,
+ toolbar_lib:error_string(Reason)++
+ FileName)
+ end;
+
+ %% Given info incorrect, notify user
+ {error,Reason} ->
+ Win = Window#tfwindow.window,
+ Str = toolbar_lib:error_string(Reason),
+ tool_utils:notify(Win,Str)
+ end
+ end,
+ loop(S,Window);
+
+ %% 'Stop' button, close window and exit
+ {gs,_Obj,click,_Data,["Stop"|_]} ->
+ gs:destroy(Window#tfwindow.window),
+ finished;
+
+ %% Window closed, exit
+ {gs,_Obj,destroy,_Data,_Args} ->
+ finished;
+
+ Other ->
+ io:format("toolbar_toolconfig: unexp msg: ~p~n",[Other]),
+ loop(S,Window)
+ end.
+
+
+%=============================================================================
+% Graphics
+%=============================================================================
+
+%----------------------------------------
+% draw_window(S)
+% S - pid() GS
+% Draw the main window.
+%----------------------------------------
+draw_window(S) ->
+
+ %% ----- Open a new window -----
+ Win = gs:create(window,S,[{width,400},{height,390},
+ {title,"Create Tool File"}]),
+
+ %% ----- Top frame containing a 'File name' label and entry -----
+ Top = gs:create(frame,Win,[{x,0},{y,0},{width,400},{height,60},{bw,2},
+ {keypress,true}]),
+
+ %% File name
+ gs:create(label,Top,[{x,10},{y,10},{width,80},{height,30},{align,e},
+ {keypress,true},
+ {label,{text,"File name:"}}]),
+ File = gs:create(entry,Top,[{x,110},{y,10},{width,280},{height,30},
+ {keypress,true},{data,file}]),
+
+ %% ----- Middle frame containing other labels and entries -----
+ Mid = gs:create(frame,Win,[{x,0},{y,60},{width,400},{height,250},{bw,2},
+ {keypress,true}]),
+
+ %% Tool name
+ gs:create(label,Mid,[{x,10},{y,10},{width,80},{height,30},{align,e},
+ {keypress,true},
+ {label,{text,"Tool name:"}}]),
+ Tool = gs:create(entry,Mid,[{x,110},{y,10},{width,280},{height,30},
+ {keypress,true},{data,tool}]),
+
+ %% Start function
+ gs:create(label,Mid,[{x,10},{y,60},{width,80},{height,30},{align,e},
+ {keypress,true},
+ {label,{text,"Start:"}}]),
+ Mod = gs:create(entry,Mid,[{x,110},{y,60},{width,135},{height,30},
+ {keypress,true},{data,module}]),
+ Fun = gs:create(entry,Mid,[{x,245},{y,60},{width,135},{height,30},
+ {keypress,true},{data,function}]),
+
+ %% Icon file
+ gs:create(label,Mid,[{x,10},{y,110},{width,80},{height,30},{align,e},
+ {keypress,true},
+ {label,{text,"Icon file:"}}]),
+ Icon = gs:create(entry,Mid,[{x,110},{y,110},{width,280},{height,30},
+ {keypress,true},{data,icon}]),
+
+ %% Message
+ gs:create(label,Mid,[{x,10},{y,160},{width,80},{height,30},{align,e},
+ {keypress,true},
+ {label,{text,"Message:"}}]),
+ Msg = gs:create(entry,Mid,[{x,110},{y,160},{width,280},{height,30},
+ {keypress,true},{data,message}]),
+
+ %% HTML file
+ gs:create(label,Mid,[{x,10},{y,210},{width,80},{height,30},{align,e},
+ {keypress,true},
+ {label,{text,"HTML:"}}]),
+ Html = gs:create(entry,Mid,[{x,110},{y,210},{width,280},{height,30},
+ {keypress,true},{data,html}]),
+
+ %% ----- Bottom frame containing the buttons -----
+ Bot = gs:create(frame,Win,[{x,0},{y,310},{width,400},{height,50},
+ {bw,2},{keypress,true}]),
+
+ gs:create(button,Bot,[{x,75},{y,10},{width,50},{height,30},
+ {keypress,true},
+ {label,{text,"Clear"}}]),
+ gs:create(button,Bot,[{x,175},{y,10},{width,50},{height,30},
+ {keypress,true},
+ {label,{text,"Save"}}]),
+ gs:create(button,Bot,[{x,275},{y,10},{width,50},{height,30},
+ {keypress,true},
+ {label,{text,"Stop"}}]),
+
+ %% ----- Label for displaying help messages -----
+ Lbl = gs:create(label,Win,[{x,0},{y,360},{width,400},{height,30},{bw,2},
+ {relief,raised},
+ {keypress,true},
+ {align,c},{label,{text,""}}]),
+
+ gs:config(Win,{map,true}),
+ gs:config(File,{setfocus,true}),
+
+ #tfwindow{window=Win,
+ fileentry=File,
+ toolentry=Tool,
+ moduleentry=Mod,
+ functionentry=Fun,
+ iconentry=Icon,
+ messageentry=Msg,
+ htmlentry=Html,
+ label=Lbl}.
+
+%----------------------------------------
+% move_focus(Window,Focus)
+% Window - tfwindow()
+% Focus - file | tool | module | function | icon | message | html | none
+% Move the input focus to the entry following Focus
+%----------------------------------------
+move_focus(Window,file) ->
+ gs:config(Window#tfwindow.toolentry,{setfocus,true});
+move_focus(Window,tool) ->
+ gs:config(Window#tfwindow.moduleentry,{setfocus,true});
+move_focus(Window,module) ->
+ gs:config(Window#tfwindow.functionentry,{setfocus,true});
+move_focus(Window,function) ->
+ gs:config(Window#tfwindow.iconentry,{setfocus,true});
+move_focus(Window,icon) ->
+ gs:config(Window#tfwindow.messageentry,{setfocus,true});
+move_focus(Window,message) ->
+ gs:config(Window#tfwindow.htmlentry,{setfocus,true});
+move_focus(Window,html) ->
+ gs:config(Window#tfwindow.htmlentry,{setfocus,false});
+move_focus(_Window,none) ->
+ true.
+
+%----------------------------------------
+% display(Window,Text)
+% Window - tfwindow()
+% Text - string()
+% Display a help message in the window
+%----------------------------------------
+display(Window,Text) ->
+ gs:config(Window#tfwindow.label,{label,{text,Text}}).
+
+%----------------------------------------
+% display_clear(Window)
+% Window - tfwindow()
+% Clear the help message display
+%----------------------------------------
+display_clear(Window) ->
+ display(Window,"").
+
+%----------------------------------------
+% clear_info(Window)
+% Window - tfwindow()
+% Clear the entries of Window (except the file entry)
+%----------------------------------------
+clear_info(Window) ->
+ gs:config(Window#tfwindow.toolentry,{text,""}),
+ gs:config(Window#tfwindow.moduleentry,{text,""}),
+ gs:config(Window#tfwindow.functionentry,{text,""}),
+ gs:config(Window#tfwindow.iconentry,{text,""}),
+ gs:config(Window#tfwindow.messageentry,{text,""}),
+ gs:config(Window#tfwindow.htmlentry,{text,""}).
+
+%----------------------------------------
+% show_info(Window,List)
+% Window - tfwindow()
+% List - [{Key,Val}]
+% Key - tool, Val - string()
+% Key - start, Val - {atom(),atom(),_}
+% Key - icon, Val - string()
+% Key - message, Val - string()
+% Key - html, Val - string()
+% Display the different Val's in the appropriate entries of Window
+%----------------------------------------
+show_info(_Window,[]) ->
+ ok;
+show_info(Window,[{tool,Tool}|Rest]) ->
+ gs:config(Window#tfwindow.toolentry,{text,Tool}),
+ show_info(Window,Rest);
+show_info(Window,[{start,{M,F,_}}|Rest]) ->
+ gs:config(Window#tfwindow.moduleentry,{text,M}),
+ gs:config(Window#tfwindow.functionentry,{text,F}),
+ show_info(Window,Rest);
+show_info(Window,[{icon,Icon}|Rest]) ->
+ gs:config(Window#tfwindow.iconentry,{text,Icon}),
+ show_info(Window,Rest);
+show_info(Window,[{message,Message}|Rest]) ->
+ gs:config(Window#tfwindow.messageentry,{text,Message}),
+ show_info(Window,Rest);
+show_info(Window,[{html,Html}|Rest]) ->
+ gs:config(Window#tfwindow.htmlentry,{text,Html}),
+ show_info(Window,Rest).
+
+
+%=============================================================================
+% Retrieve user specified information
+%=============================================================================
+
+%----------------------------------------
+% check_info(Window) => {ok,ToolInfo} | {error,Reason}
+% Window - tfwindow()
+% ToolInfo - toolinfo()
+% Reason - noname | nostart
+% Check the information given in the entries and insert it into ToolInfo
+% if all mandatory information is given.
+%----------------------------------------
+check_info(Window) ->
+
+ %% First check mandatory elements: name and start function
+ Tool = gs:read(Window#tfwindow.toolentry,text),
+ M = gs:read(Window#tfwindow.moduleentry,text),
+ F = gs:read(Window#tfwindow.functionentry,text),
+
+ if
+ Tool/="",M/="",F/="" ->
+ ToolInfo =
+ #toolinfo{tool=Tool,
+ start={list_to_atom(M),list_to_atom(F),[]},
+ icon=gs:read(Window#tfwindow.iconentry,text),
+ message=gs:read(Window#tfwindow.messageentry,text),
+ html=gs:read(Window#tfwindow.htmlentry,text)},
+ {ok,ToolInfo};
+
+ Tool=="" ->
+ {error,noname};
+
+ true ->
+ {error,nostart}
+ end.
+
+
+%=============================================================================
+% Save information to file
+%=============================================================================
+
+%----------------------------------------
+% save_info(Win,File,ToolInfo) => ok | cancel | {error,waccess}
+% Win - GS object
+% File - string()
+% ToolInfo - toolinfo()
+% Saves the information in ToolInfo to File on a predefined format.
+%----------------------------------------
+save_info(Win,File,ToolInfo) ->
+
+ %% First check if file already exists
+ case file:read_file_info(File) of
+ {ok,_FileInfo} ->
+
+ %% Request the user to confirm that the file should
+ %% be overwritten
+ case tool_utils:confirm(Win,[File,
+ "exists, will be overwritten"]) of
+ ok ->
+ save_info2(File,ToolInfo);
+ cancel ->
+ cancel
+ end;
+
+ {error,_Reason} -> % _Reason = "No such file or directory"
+ save_info2(File,ToolInfo)
+ end.
+
+%----------------------------------------
+% save_info2(File,ToolInfo) => ok | {error,waccess}
+% File - string() File name
+% ToolInfo - toolinfo record
+% Called by save_info/3
+%----------------------------------------
+save_info2(File,ToolInfo) ->
+ case file:open(File, [write]) of
+ {ok,Fd} ->
+ io:format(Fd,"{version,\"~s\"}.~n",[toolbar:version()]),
+ io:format(Fd,"{{tool,\"~s\"},~n",[ToolInfo#toolinfo.tool]),
+ io:format(Fd," {start,~w}",[ToolInfo#toolinfo.start]),
+ case ToolInfo#toolinfo.icon of
+ "" -> ignore;
+ Icon -> io:format(Fd,",~n {icon,\"~s\"}",[Icon])
+ end,
+ case ToolInfo#toolinfo.message of
+ "" -> ignore;
+ Message -> io:format(Fd,",~n {message,\"~s\"}",[Message])
+ end,
+ case ToolInfo#toolinfo.html of
+ "" -> ignore;
+ Html -> io:format(Fd,",~n {html,\"~s\"}",[Html])
+ end,
+ io:format(Fd,"}.~n",[]),
+ file:close(Fd),
+ ok;
+ _Error ->
+ {error,waccess}
+ end.
+
+
+%=============================================================================
+% Auxiliary functions
+%=============================================================================
+
+%----------------------------------------
+% tool_file(File) => string()
+% File - string()
+% Return a file name consisting of File with the suffix .tool added,
+% if File does not already have this suffix.
+%----------------------------------------
+tool_file(File) ->
+ case filename:extension(File) of
+ ".tool" -> File;
+ _ -> File ++ ".tool"
+ end.