diff options
Diffstat (limited to 'lib/toolbar/src')
| -rw-r--r-- | lib/toolbar/src/Makefile | 93 | ||||
| -rw-r--r-- | lib/toolbar/src/canvasbutton.erl | 236 | ||||
| -rw-r--r-- | lib/toolbar/src/toolbar.app.src | 30 | ||||
| -rw-r--r-- | lib/toolbar/src/toolbar.appup.src | 19 | ||||
| -rw-r--r-- | lib/toolbar/src/toolbar.erl | 578 | ||||
| -rw-r--r-- | lib/toolbar/src/toolbar.hrl | 34 | ||||
| -rw-r--r-- | lib/toolbar/src/toolbar_graphics.erl | 401 | ||||
| -rw-r--r-- | lib/toolbar/src/toolbar_lib.erl | 223 | ||||
| -rw-r--r-- | lib/toolbar/src/toolbar_toolconfig.erl | 544 |
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. |