The R13B03 release.OTP_R13B03

1 files changed, 401 insertions, 0 deletions

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.