diff options
author | Björn Gustavsson <[email protected]> | 2016-06-27 11:48:03 +0200 |
---|---|---|
committer | Björn Gustavsson <[email protected]> | 2016-06-27 11:49:57 +0200 |
commit | 6931dce17580d097351dd7be09ce7c9ed3f72827 (patch) | |
tree | 2456845e95ed0112c2f08ed8ab6e867686b91d7a /lib/gs/src/gstk_window.erl | |
parent | dfccd57cb2b69fc3ab01acd0ccbfc894a8403358 (diff) | |
download | otp-6931dce17580d097351dd7be09ce7c9ed3f72827.tar.gz otp-6931dce17580d097351dd7be09ce7c9ed3f72827.tar.bz2 otp-6931dce17580d097351dd7be09ce7c9ed3f72827.zip |
Remove the gs application
The gs application ws deprecated in R15B01.
Diffstat (limited to 'lib/gs/src/gstk_window.erl')
-rw-r--r-- | lib/gs/src/gstk_window.erl | 371 |
1 files changed, 0 insertions, 371 deletions
diff --git a/lib/gs/src/gstk_window.erl b/lib/gs/src/gstk_window.erl deleted file mode 100644 index c14cf2fd81..0000000000 --- a/lib/gs/src/gstk_window.erl +++ /dev/null @@ -1,371 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - -%% -%% ------------------------------------------------------------ -%% Basic Window Type. -%% ------------------------------------------------------------ - --module(gstk_window). --compile([{nowarn_deprecated_function,{gs,destroy,1}}]). - -%%------------------------------------------------------------------------------ -%% WINDOW OPTIONS -%% -%% Attributes: -%% x Int -%% y Int -%% width Int -%% height Int -%% bg Color -%% bw Int -%% relief Relief [flat|raised|sunken|ridge|groove] -%% highlightbw Int -%% highlightbg Color -%% highlightfg Color -%% map Bool -%% iconify Bool -%% title String -%% iconname String -%% iconbitmap Bitmap -%% iconmask Bitmap -%% data Data -%% cursor arrow|busy|cross|hand|help|resize|text -%% -%% Commands: -%% raise -%% lower -%% setfocus Bool -%% -%% Events: -%% configure [Bool | {Bool, Data}] -%% enter [Bool | {Bool, Data}] -%% leave [Bool | {Bool, Data}] -%% motion [Bool | {Bool, Data}] -%% keypress [Bool | {Bool, Data}] -%% keyrelease [Bool | {Bool, Data}] -%% buttonpress [Bool | {Bool, Data}] -%% buttonrelease [Bool | {Bool, Data}] -%% focus [Bool | {Bool, Data}] -%% destroy [Bool | {Bool, Data}] -%% -%% Read options: -%% children -%% id -%% parent -%% type -%% -%% Not Implemented: -%% screen ????????? -%% map -%% unmap -%% iconify -%% deiconify -%% focusmodel [active|passive] (wm focusmodel) -%% - --export([create/3, config/3, read/3, delete/2, event/5,destroy_win/1]). --export([option/5,read_option/5,mk_create_opts_for_child/4]). - --include("gstk.hrl"). -% bind . <1> {puts "x: [expr %X - [winfo rootx .]] y: [expr %Y - [wi rooty .]]"} - -%%----------------------------------------------------------------------------- -%% MANDATORY INTERFACE FUNCTIONS -%%----------------------------------------------------------------------------- -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : create/3 -%% Purpose : Create a widget of the type defined in this module. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -create(DB, Gstkid, Opts) -> - TkW = gstk_generic:mk_tkw_child(DB,Gstkid), - NGstkid=Gstkid#gstkid{widget=TkW}, - case gstk_generic:make_command(transform_geometry_opts(Opts), - NGstkid, TkW, "", ";", DB) of - {error,Reason} -> {error,Reason}; - Cmd when is_list(Cmd) -> - BindCmd = gstk_generic:bind(DB, Gstkid, TkW, configure, true), -% io:format("\nWINDOW1: ~p\n",[TkW]), -% io:format("\nWINDOW1: ~p\n",[Cmd]), -% io:format("\nWINDOW1: ~p\n",[BindCmd]), - gstk:exec(["toplevel ", TkW,Cmd,$;,BindCmd]), - NGstkid - end. - -mk_create_opts_for_child(DB,Cgstkid, Pgstkid, Opts) -> - gstk_generic:mk_create_opts_for_child(DB,Cgstkid,Pgstkid,Opts). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : config/3 -%% Purpose : Configure a widget of the type defined in this module. -%% Args : DB - The Database -%% Gstkid - The gstkid of the widget -%% Opts - A list of options for configuring the widget -%% -%% Return : [true | {bad_result, Reason}] -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -config(DB, Gstkid, Opts) -> - TkW = Gstkid#gstkid.widget, - SimplePreCmd = [TkW, " conf"], - gstk_generic:mk_cmd_and_exec(transform_geometry_opts(Opts), - Gstkid,TkW,SimplePreCmd,"",DB). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : read/3 -%% Purpose : Read one option from a widget -%% Args : DB - The Database -%% Gstkid - The gstkid of the widget -%% Opt - An option to read -%% -%% Return : [OptionValue | {bad_result, Reason}] -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -read(DB, Gstkid, Opt) -> - gstk_generic:read_option(DB, Gstkid, Opt). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : delete/2 -%% Purpose : Delete widget from databas and return tkwidget to destroy -%% Args : DB - The Database -%% Gstkid - The gstkid of the widget -%% -%% Return : TkWidget to destroy -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -delete(DB, Gstkid) -> - gstk_db:delete_widget(DB, Gstkid), - Gstkid#gstkid.widget. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : event/5 -%% Purpose : Construct the event and send it to the owner of the widget -%% Args : DB - The Database -%% Gstkid - The gstkid of the widget -%% Etype - The event type -%% Edata - The event data -%% Args - The data from tcl/tk -%% -%% Return : [true | {bad_result, Reason}] -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -event(DB, Gstkid, configure, Edata, Args) -> - [W,H|_] = Args, - gstk_db:insert_opt(DB,Gstkid,{width,W}), - gstk_db:insert_opt(DB,Gstkid,{height,H}), - case gstk_db:opt(DB,Gstkid,configure) of - true -> - apply(gstk_generic,event,[DB,Gstkid,configure,Edata,Args]); - false -> - ok - end; -event(DB, Gstkid, destroy, Edata, Args) -> - spawn(gstk_window,destroy_win,[gstk:make_extern_id(Gstkid#gstkid.id,DB)]), - gstk_generic:event(DB, Gstkid, destroy, Edata, Args); -event(DB, Gstkid, Etype, Edata, Args) -> - gstk_generic:event(DB, Gstkid, Etype, Edata, Args). - -destroy_win(ID) -> - gs:destroy(ID). -%%------------------------------------------------------------------------------ -%% MANDATORY FUNCTIONS -%%------------------------------------------------------------------------------ -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : option/4 -%% Purpose : Take care of options -%% Args : Option - An option tuple -%% Gstkid - The gstkid of the widget -%% TkW - The tk-widget -%% DB - The Database -%% -%% Return : A tuple {OptionType, OptionCmd} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%-define(REGEXP,"regexp {(\\d+)x(\\d+)\\+?(-?\\d+)\\+?(-?\\d+)} "). -% FIXME: Is this ok? Always positive? --define(REGEXP,"regexp {(\\d+)x(\\d+)\\+(\\d+)\\+(\\d+)} "). - -option(Option, Gstkid, TkW, DB,_) -> - case Option of -%% Bug in tcl/tk complicates setting of a single x,y,width,height. - {x, X} -> - {c, - [?REGEXP,"[wm ge ",TkW, "] g w h x y;wm ge ", TkW, - " ${w}x$h",signed(X),"+$y;update idletasks"]}; - {y, Y} -> - {c,[?REGEXP,"[wm ge ",TkW, "] g w h x y;wm ge ", TkW, - " ${w}x$h+$x",signed(Y),"; update idletasks"]}; - {width, Width} when Width >= 0 -> % FIXME: Needed test? - case gstk_db:opt_or_not(DB,Gstkid,width) of - {value,Width} -> none; - _Q -> - gstk_db:insert_opt(DB,Gstkid,{width,Width}), - {c,[?REGEXP,"[wm ge ",TkW, "] g w h x y;wm ge ", TkW," ", - gstk:to_ascii(Width),"x$h+$x+$y;update idletasks"]} - end; - {height, Height} when Height >= 0 -> % FIXME: Needed test? - case gstk_db:opt_or_not(DB,Gstkid,height) of - {value,Height} -> none; - _Q -> % FIXME: Why different? - gstk_db:insert_opt(DB,Gstkid,{height,Height}), - {c, - ["wm ge ",TkW, - " [winfo w ", TkW, "]x",gstk:to_ascii(Height), - ";update idletasks"]} - end; - {width_height, {W,H}} when W >= 0, H >= 0 -> - case {gstk_db:opt_or_not(DB,Gstkid,width), - gstk_db:opt_or_not(DB,Gstkid,height)} of - {{value,W},{value,H}} -> - none; - _OtherSize -> - gstk_db:insert_opt(DB,Gstkid,{height,H}), - gstk_db:insert_opt(DB,Gstkid,{width,W}), - {c, ["update idletasks;wm ge ", TkW, " ", - gstk:to_ascii(W),"x",gstk:to_ascii(H), - ";update idletasks"]} - end; - {xy, {X,Y}} -> - {c, [?REGEXP,"[wm ge ",TkW, "] g w h x y;wm ge ", TkW, - " ${w}x$h", signed(X),signed(Y), - ";update idletasks"]}; - {bg, Color} -> {s, [" -bg ", gstk:to_color(Color)]}; - {map, true} -> {c, ["wm deiconify ", TkW]}; - {map, false} -> {c, ["wm withdraw ", TkW]}; - {configure, On} -> - gstk_db:insert_opt(DB,Gstkid,{configure,On}), - none; - {iconify, true} -> {c, ["wm iconify ", TkW]}; - {iconify, false} -> {c, ["wm deiconify ", TkW]}; - {title, Title} -> {c, ["wm title ", TkW, " " , - gstk:to_ascii(Title)]}; - {iconname, Name} -> {c, ["wm iconn ",TkW, " ", - gstk:to_ascii(Name)]}; - {iconbitmap, Bitmap} -> {c, ["wm iconb ",TkW, " ", - gstk:to_ascii(Bitmap)]}; - {iconmask, Bitmap} -> {c, ["wm iconm ",TkW, " ", - gstk:to_ascii(Bitmap)]}; - raise -> {c, ["raise ", TkW]}; - lower -> {c, ["lower ", TkW]}; - {setfocus, true} -> {c, ["focus ", TkW]}; - {setfocus, false} -> {c, ["focus {}"]}; - {buttonpress, On} -> - Eref = mk_eref(On, DB, Gstkid, buttonpress), - {c,["bind ",TkW," <ButtonPress> ", - event_onoff(["{erlsend ",Eref," %b ",xy_abs_str(TkW),"};"],On)]}; - {buttonrelease, On} -> - Eref = mk_eref(On, DB, Gstkid, buttonrelease), - {c,["bind ",TkW," <ButtonRelease> ", - event_onoff(["{erlsend ",Eref," %b ",xy_abs_str(TkW),"};"],On)]}; - {motion, On} -> - Eref = mk_eref(On, DB, Gstkid, motion), - {c,["bind ",TkW," <Motion> ", - event_onoff(["{erlsend ",Eref," ",xy_abs_str(TkW),"};"],On)]}; - _ -> invalid_option - end. - -xy_abs_str(TkW) -> - ["[expr %X-[winfo rootx ",TkW,"]] [expr %Y-[winfo rooty ",TkW,"]]"]. - -event_onoff(Str, true) -> Str; -event_onoff(_,false) -> "{}". - -mk_eref(false, DB, Gstkid, Etype) -> - gstk_db:delete_event(DB, Gstkid, Etype), - dummy; -mk_eref(true,DB,Gstkid,Etype) -> - gstk_db:insert_event(DB, Gstkid, Etype, []). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : read_option/3 -%% Purpose : Take care of a read option -%% Args : DB - The Database -%% Gstkid - The gstkid of the widget -%% Option - An option -%% -%% Return : The value of the option or invalid_option -%% [OptionValue | {bad_result, Reason}] -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -read_option(Option, Gstkid, TkW, DB,_) -> - case Option of - x -> tcl2erl:ret_x(geo_str(TkW)); - y -> tcl2erl:ret_y(geo_str(TkW)); - width -> tcl2erl:ret_width(geo_str(TkW)); - height -> tcl2erl:ret_height(geo_str(TkW)); - configure -> gstk_db:opt(DB,Gstkid,configure); - bg -> tcl2erl:ret_color([TkW," cg -bg"]); - map -> tcl2erl:ret_mapped(["winfo is ", TkW]); - iconify -> tcl2erl:ret_iconified(["wm st ", TkW]); - title -> tcl2erl:ret_str(["wm ti ", TkW]); - iconname -> tcl2erl:ret_str(["wm iconn ", TkW]); - iconbitmap -> tcl2erl:ret_str(["wm iconb ", TkW]); - iconmask -> tcl2erl:ret_str(["wm iconm ", TkW]); - setfocus -> tcl2erl:ret_focus(TkW, "focus"); - _ -> {bad_result, {Gstkid#gstkid.objtype, invalid_option, Option}} - end. - -geo_str(TkW) -> - ["update idletasks;",?REGEXP,"[wm geometry ", TkW, - "] g w h x y;set tmp \"$w $h $x $y\""]. - - - -%%---------------------------------------------------------------------- -%% PRIMITIVES -%%---------------------------------------------------------------------- - -%% Return {+,-}Int to be used in a geometry option -signed(X) when X>=0 -> - [$+,integer_to_list(X)]; -signed(X) when X<0 -> - integer_to_list(X). - -%%---------------------------------------------------------------------- -%% Purpose: tcl/tk: wm .window geo sets WxH+x+y at one time. -%% flushing every time is expensive. Do (almost) as much as -%% possible in one operation. -%%---------------------------------------------------------------------- -transform_geometry_opts(Opts) -> - {Geo,RestOpts} = collect_geo_opts(Opts,[],[]), - Geo2 = make_atomic(lists:sort(Geo)), - lists:append(Geo2,RestOpts). - -make_atomic([{height,H},{width,W},{x,X},{y,Y}]) -> - [{width_height,{W,H}},{xy,{X,Y}}]; -make_atomic([{height,H},{width,W}|XY]) -> - [{width_height,{W,H}}|XY]; -make_atomic([WH,{x,X},{y,Y}]) -> - [WH,{xy,{X,Y}}]; -make_atomic(L) -> L. - -%%---------------------------------------------------------------------- -%% Returns: {(list of x,y,width,height options),list of other opts} -%%---------------------------------------------------------------------- -collect_geo_opts([{x,X}|Opts],Geo,Rest) -> - collect_geo_opts(Opts,[{x,X}|Geo],Rest); -collect_geo_opts([{y,Y}|Opts],Geo,Rest) -> - collect_geo_opts(Opts,[{y,Y}|Geo],Rest); -collect_geo_opts([{height,H}|Opts],Geo,Rest) -> - collect_geo_opts(Opts,[{height,H}|Geo],Rest); -collect_geo_opts([{width,W}|Opts],Geo,Rest) -> - collect_geo_opts(Opts,[{width,W}|Geo],Rest); -collect_geo_opts([Opt|Opts],Geo,Rest) -> - collect_geo_opts(Opts,Geo,[Opt|Rest]); -collect_geo_opts([],Geo,Rest) -> {Geo,Rest}. - -%%% ----- Done ----- |