From 6931dce17580d097351dd7be09ce7c9ed3f72827 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 27 Jun 2016 11:48:03 +0200 Subject: Remove the gs application The gs application ws deprecated in R15B01. --- lib/gs/src/Makefile | 121 ----- lib/gs/src/gs.app.src | 14 - lib/gs/src/gs.appup.src | 22 - lib/gs/src/gs.erl | 410 -------------- lib/gs/src/gs_frontend.erl | 371 ------------- lib/gs/src/gs_make.erl | 266 ---------- lib/gs/src/gs_packer.erl | 276 ---------- lib/gs/src/gs_widgets.erl | 99 ---- lib/gs/src/gse.erl | 788 --------------------------- lib/gs/src/gstk.erl | 389 -------------- lib/gs/src/gstk.hrl | 29 - lib/gs/src/gstk_arc.erl | 192 ------- lib/gs/src/gstk_button.erl | 221 -------- lib/gs/src/gstk_canvas.erl | 516 ------------------ lib/gs/src/gstk_checkbutton.erl | 320 ----------- lib/gs/src/gstk_db.erl | 413 --------------- lib/gs/src/gstk_editor.erl | 400 -------------- lib/gs/src/gstk_entry.erl | 234 -------- lib/gs/src/gstk_font.erl | 255 --------- lib/gs/src/gstk_frame.erl | 282 ---------- lib/gs/src/gstk_generic.erl | 1089 -------------------------------------- lib/gs/src/gstk_grid.erl | 284 ---------- lib/gs/src/gstk_gridline.erl | 301 ----------- lib/gs/src/gstk_gs.erl | 54 -- lib/gs/src/gstk_image.erl | 321 ----------- lib/gs/src/gstk_label.erl | 183 ------- lib/gs/src/gstk_line.erl | 203 ------- lib/gs/src/gstk_listbox.erl | 324 ------------ lib/gs/src/gstk_menu.erl | 268 ---------- lib/gs/src/gstk_menubar.erl | 176 ------ lib/gs/src/gstk_menubutton.erl | 238 --------- lib/gs/src/gstk_menuitem.erl | 584 -------------------- lib/gs/src/gstk_oval.erl | 189 ------- lib/gs/src/gstk_polygon.erl | 196 ------- lib/gs/src/gstk_port_handler.erl | 467 ---------------- lib/gs/src/gstk_radiobutton.erl | 343 ------------ lib/gs/src/gstk_rectangle.erl | 186 ------- lib/gs/src/gstk_scale.erl | 215 -------- lib/gs/src/gstk_text.erl | 190 ------- lib/gs/src/gstk_widgets.erl | 94 ---- lib/gs/src/gstk_window.erl | 371 ------------- lib/gs/src/tcl2erl.erl | 459 ---------------- lib/gs/src/tool_file_dialog.erl | 456 ---------------- lib/gs/src/tool_utils.erl | 438 --------------- 44 files changed, 13247 deletions(-) delete mode 100644 lib/gs/src/Makefile delete mode 100644 lib/gs/src/gs.app.src delete mode 100644 lib/gs/src/gs.appup.src delete mode 100644 lib/gs/src/gs.erl delete mode 100644 lib/gs/src/gs_frontend.erl delete mode 100644 lib/gs/src/gs_make.erl delete mode 100644 lib/gs/src/gs_packer.erl delete mode 100644 lib/gs/src/gs_widgets.erl delete mode 100644 lib/gs/src/gse.erl delete mode 100644 lib/gs/src/gstk.erl delete mode 100644 lib/gs/src/gstk.hrl delete mode 100644 lib/gs/src/gstk_arc.erl delete mode 100644 lib/gs/src/gstk_button.erl delete mode 100644 lib/gs/src/gstk_canvas.erl delete mode 100644 lib/gs/src/gstk_checkbutton.erl delete mode 100644 lib/gs/src/gstk_db.erl delete mode 100644 lib/gs/src/gstk_editor.erl delete mode 100644 lib/gs/src/gstk_entry.erl delete mode 100644 lib/gs/src/gstk_font.erl delete mode 100644 lib/gs/src/gstk_frame.erl delete mode 100644 lib/gs/src/gstk_generic.erl delete mode 100644 lib/gs/src/gstk_grid.erl delete mode 100644 lib/gs/src/gstk_gridline.erl delete mode 100644 lib/gs/src/gstk_gs.erl delete mode 100644 lib/gs/src/gstk_image.erl delete mode 100644 lib/gs/src/gstk_label.erl delete mode 100644 lib/gs/src/gstk_line.erl delete mode 100644 lib/gs/src/gstk_listbox.erl delete mode 100644 lib/gs/src/gstk_menu.erl delete mode 100644 lib/gs/src/gstk_menubar.erl delete mode 100644 lib/gs/src/gstk_menubutton.erl delete mode 100644 lib/gs/src/gstk_menuitem.erl delete mode 100644 lib/gs/src/gstk_oval.erl delete mode 100644 lib/gs/src/gstk_polygon.erl delete mode 100644 lib/gs/src/gstk_port_handler.erl delete mode 100644 lib/gs/src/gstk_radiobutton.erl delete mode 100644 lib/gs/src/gstk_rectangle.erl delete mode 100644 lib/gs/src/gstk_scale.erl delete mode 100644 lib/gs/src/gstk_text.erl delete mode 100644 lib/gs/src/gstk_widgets.erl delete mode 100644 lib/gs/src/gstk_window.erl delete mode 100644 lib/gs/src/tcl2erl.erl delete mode 100644 lib/gs/src/tool_file_dialog.erl delete mode 100644 lib/gs/src/tool_utils.erl (limited to 'lib/gs/src') diff --git a/lib/gs/src/Makefile b/lib/gs/src/Makefile deleted file mode 100644 index e19ce822b9..0000000000 --- a/lib/gs/src/Makefile +++ /dev/null @@ -1,121 +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% -# - -# -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../vsn.mk -VSN=$(GS_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/gs-$(VSN) - -ERL = erl - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- -MODULES= gs gs_frontend gs_make gs_widgets gstk gstk_arc gstk_button\ - gstk_canvas gstk_checkbutton gstk_db gstk_editor gstk_entry \ - gstk_font gstk_frame gstk_grid gstk_gridline gs_packer \ - gstk_gs gstk_image gstk_label gstk_line gstk_listbox gstk_menu\ - gstk_menubar gstk_menubutton gstk_menuitem gstk_oval gstk_polygon \ - gstk_port_handler gstk_radiobutton gstk_rectangle gstk_scale \ - gstk_text gstk_widgets gstk_window tcl2erl tool_utils \ - tool_file_dialog gse - -GSTK_GENERIC = gstk_generic.erl - -HRL_FILES = gstk.hrl -GEN_HRL_FILES = gstk_generic.hrl -GSTK_GENERIC_TARGET = $(EBIN)/gstk_generic.$(EMULATOR) - -ERL_FILES= $(MODULES:%=%.erl) - -TARGET_FILES= $(MODULES:%=../ebin/%.$(EMULATOR)) $(GEN_HRL_FILES) \ - $(GSTK_GENERIC_TARGET) $(APP_TARGET) $(APPUP_TARGET) - -APP_FILE= gs.app -APPUP_FILE= gs.appup - -APP_SRC= $(APP_FILE).src -APPUP_SRC= $(APPUP_FILE).src - -APP_TARGET= ../ebin/$(APP_FILE) -APPUP_TARGET= ../ebin/$(APPUP_FILE) - -IMAGES=../priv/bitmap/fup.bm - - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -ERL_COMPILE_FLAGS += +warn_obsolete_guard -Werror - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -debug opt: $(TARGET_FILES) - -docs: - -clean: - rm -f $(TARGET_FILES) - rm -f core *~ - -# ---------------------------------------------------- -# Special Build Targets -# ---------------------------------------------------- - -gstk_generic.hrl: gs_make.erl ../ebin/gs_make.$(EMULATOR) ../ebin/gs.$(EMULATOR) - $(gen_verbose)$(ERL) -pa $(EBIN) -s gs_make -s erlang halt -noshell - -$(APP_TARGET): $(APP_SRC) ../vsn.mk - $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@ - -$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk - $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@ - -$(GSTK_GENERIC_TARGET): gstk_generic.hrl - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_spec: opt - $(INSTALL_DIR) "$(RELSYSDIR)/src" - $(INSTALL_DATA) $(APP_SRC) $(ERL_FILES) $(HRL_FILES) $(GEN_HRL_FILES) \ - $(GSTK_GENERIC) "$(RELSYSDIR)/src" - $(INSTALL_DIR) "$(RELSYSDIR)/ebin" - $(INSTALL_DATA) $(TARGET_FILES) "$(RELSYSDIR)/ebin" - $(INSTALL_DIR) "$(RELSYSDIR)/priv/bitmap" - $(INSTALL_DATA) $(IMAGES) "$(RELSYSDIR)/priv/bitmap" - - -release_docs_spec: - diff --git a/lib/gs/src/gs.app.src b/lib/gs/src/gs.app.src deleted file mode 100644 index c6f88e5144..0000000000 --- a/lib/gs/src/gs.app.src +++ /dev/null @@ -1,14 +0,0 @@ -{application, gs, - [{description, "GS The Graphics System"}, - {vsn, "%VSN%"}, - {modules, [gs,gs_frontend,gs_make,gs_widgets,gstk,gstk_arc,gstk_button, - gstk_canvas,gstk_checkbutton,gstk_db,gstk_editor,gstk_entry, - gstk_font,gstk_frame,gstk_generic,gstk_grid,gstk_gridline,gstk_gs, - gstk_image,gstk_label,gstk_line,gstk_listbox,gstk_menu,gstk_menubar, - gstk_menubutton,gstk_menuitem,gstk_oval,gstk_polygon,gstk_port_handler, - gstk_radiobutton,gstk_rectangle,gstk_scale,gstk_text,gstk_widgets, - gstk_window,tcl2erl,tool_file_dialog,tool_utils, - gs_packer,gse]}, - {registered, [gs_frontend]}, - {applications, [kernel, stdlib]}, - {runtime_dependencies, ["stdlib-2.0","kernel-3.0","erts-6.0"]}]}. diff --git a/lib/gs/src/gs.appup.src b/lib/gs/src/gs.appup.src deleted file mode 100644 index 6cc21676e8..0000000000 --- a/lib/gs/src/gs.appup.src +++ /dev/null @@ -1,22 +0,0 @@ -%% -*- erlang -*- -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2014-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% -{"%VSN%", - [{<<".*">>,[{restart_application, gs}]}], - [{<<".*">>,[{restart_application, gs}]}] -}. diff --git a/lib/gs/src/gs.erl b/lib/gs/src/gs.erl deleted file mode 100644 index 23012da75d..0000000000 --- a/lib/gs/src/gs.erl +++ /dev/null @@ -1,410 +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% -%% - -%% -%% ------------------------------------------------------------ -%% Erlang Graphics Interface and front end server -%% ------------------------------------------------------------ -%% - --module(gs). --deprecated(module). --compile([{nowarn_deprecated_function,{gs,create,3}}, - {nowarn_deprecated_function,{gs,create,4}}, - {nowarn_deprecated_function,{gs,create_tree,2}}, - {nowarn_deprecated_function,{gs,foreach,3}}, - {nowarn_deprecated_function,{gs,read,2}}, - {nowarn_deprecated_function,{gs,start,1}}]). - -%% ----- Exports ----- --export([start/0, stop/0, start/1]). --export([create/3, create/4, is_id/1]). --export([info/1,create_tree/2]). --export([config/2, read/2, destroy/1]). --export([get_id/1]). - -%% ----- Not standard but convenient ----- --export([error/2,creation_error/2,assq/2,pair/2,val/2,val/3,foreach/3]). --export([create/2]). --export([window/1,window/2,window/3,button/1,button/2,button/3]). --export([radiobutton/1,radiobutton/2,radiobutton/3]). --export([checkbutton/1,checkbutton/2,checkbutton/3]). --export([frame/1,frame/2,frame/3,label/1,label/2,label/3]). --export([message/1,message/2,message/3]). --export([listbox/1,listbox/2,listbox/3,entry/1,entry/2,entry/3]). --export([scrollbar/1,scrollbar/2,scrollbar/3]). --export([scale/1,scale/2,scale/3]). --export([canvas/1,canvas/2,canvas/3,editor/1,editor/2,editor/3]). --export([prompter/1,prompter/2,prompter/3]). --export([line/1,line/2,line/3,oval/1,oval/2,oval/3]). --export([rectangle/1,rectangle/2,rectangle/3]). --export([polygon/1,polygon/2,polygon/3]). --export([text/1,text/2,text/3,image/1,image/2,image/3,arc/1,arc/2,arc/3]). --export([menu/1,menu/2,menu/3,menubutton/1,menubutton/2,menubutton/3]). --export([menubar/1,menubar/2,menubar/3]). --export([grid/1,grid/2,grid/3]). --export([gridline/1,gridline/2,gridline/3]). --export([menuitem/1,menuitem/2,menuitem/3]). - --include("gstk.hrl"). - -%% ----- Start/Stop ----- - -start() -> - start([]). - -start(Opts) -> - Opts2 = gstk_generic:merge_default_options(gs_widgets:default_options(gs), - lists:sort(Opts)), - gs_frontend:start(Opts2). - -stop() -> - gs_frontend:stop(). - -%% ----- Widget Commands ----- - -create(Objtype, Parent) -> - GsPid = frontend(Parent), - tag_if_ok(gs_frontend:create(GsPid,{Objtype, undefined, obj_id(Parent),[]}) - ,GsPid). - -create(Objtype, Parent, Opts) when is_list(Opts) -> - GsPid = frontend(Parent), - tag_if_ok(gs_frontend:create(GsPid,{Objtype,undefined,obj_id(Parent),Opts}), - GsPid); -create(Objtype, Parent, Opt) -> - GsPid = frontend(Parent), - tag_if_ok(gs_frontend:create(GsPid, - {Objtype,undefined,obj_id(Parent),[Opt]}), - GsPid). - -create(Objtype, Name, Parent, Opts) when is_list(Opts) -> - GsPid = frontend(Parent), - tag_if_ok(gs_frontend:create(GsPid,{Objtype, Name, obj_id(Parent),Opts}), - GsPid); -create(Objtype, Name, Parent, Opt) -> - GsPid = frontend(Parent), - tag_if_ok(gs_frontend:create(GsPid,{Objtype,Name,obj_id(Parent),[Opt]}), - GsPid). - -tag_if_ok(Int,Pid) when is_integer(Int) -> - {Int,Pid}; -tag_if_ok(Err,_) -> - Err. - -config(IdOrName, Options) when is_list(Options) -> - gs_frontend:config(frontend(IdOrName),{obj_id(IdOrName),Options}); -config(IdOrName, Option) -> - gs_frontend:config(frontend(IdOrName),{obj_id(IdOrName),[Option]}). - -read(IdOrName, Option) -> - gs_frontend:read(frontend(IdOrName),{obj_id(IdOrName),Option}). - -destroy(IdOrName) -> - gs_frontend:destroy(frontend(IdOrName),obj_id(IdOrName)). - -get_id(Name) -> - read(Name,id). - -info(version) -> "1.3.2"; -info(Option) -> - gs_frontend:info(Option). - -is_id({Int,Pid}) when is_integer(Int), is_pid(Pid) -> true; -is_id(_) -> false. - -frontend({_,Pid}) when is_pid(Pid) -> Pid; -frontend({AtomName,Node}) when is_atom(AtomName),is_atom(Node) -> - rpc:call(Node,erlang,whereis,[gs_frontend]); -frontend(Atom) when is_atom(Atom) -> whereis(gs_frontend). - -obj_id({Id,_}) -> Id; -obj_id(Atom) when is_atom(Atom) -> Atom. - -error(Format, Data) -> - io:format("gs error: "), - ok = io:format(Format, Data), % don't be quiet when Format is malformed - io:format("~n"). - -creation_error(#gstkid{objtype=Ot}, {bad_result, BadResult}) -> - {error, {creation_error,Ot,BadResult}}; -creation_error(#gstkid{objtype=Ot}, BadResult) -> - {error, {creation_error,Ot,BadResult}}. - - -create_tree(ParentId,[{Type,Name,Options,Children}|R]) -> - case create(Type,Name,ParentId,Options) of - {error,_Reason} -> {error,{create_tree,aborted_at,Type,Name}}; - Id -> - case create_tree(Id,Children) of - ok -> create_tree(ParentId,R); - Err -> Err - end - end; -create_tree(ParentId,[{Type,Name,Options}|R]) when is_atom(Name) -> - create_tree(ParentId,[{Type,Name,Options,[]}|R]); -create_tree(ParentId,[{Type,Options,Children}|R]) -> - case create(Type,ParentId,Options) of - {error,_Reason} -> {error,{create_tree,aborted_at,Type,Options}}; - Id -> - case create_tree(Id,Children) of - ok -> create_tree(ParentId,R); - Err -> Err - end - end; -create_tree(ParentId,[{Type,Options}|R]) -> - create_tree(ParentId,[{Type,Options,[]}|R]); -create_tree(ParentId,Tuple) when is_tuple(Tuple) -> - create_tree(ParentId,[Tuple]); -create_tree(_,[]) -> - ok. - - -window(ParentId) -> - create(window,ParentId,[]). -window(ParentId,Options) -> - create(window,ParentId,Options). -window(Name,ParentId,Options) -> - create(window,Name,ParentId,Options). - -button(ParentId) -> - create(button,ParentId,[]). -button(ParentId,Options) -> - create(button,ParentId,Options). -button(Name,ParentId,Options) -> - create(button,Name,ParentId,Options). - -checkbutton(ParentId) -> - create(checkbutton,ParentId,[]). -checkbutton(ParentId,Options) -> - create(checkbutton,ParentId,Options). - -checkbutton(Name,ParentId,Options) -> - create(checkbutton,Name,ParentId,Options). - -radiobutton(ParentId) -> - create(radiobutton,ParentId,[]). -radiobutton(ParentId,Options) -> - create(radiobutton,ParentId,Options). -radiobutton(Name,ParentId,Options) -> - create(radiobutton,Name,ParentId,Options). - -frame(ParentId) -> - create(frame,ParentId,[]). -frame(ParentId,Options) -> - create(frame,ParentId,Options). -frame(Name,ParentId,Options) -> - create(frame,Name,ParentId,Options). - -canvas(ParentId) -> - create(canvas,ParentId,[]). -canvas(ParentId,Options) -> - create(canvas,ParentId,Options). -canvas(Name,ParentId,Options) -> - create(canvas,Name,ParentId,Options). - -label(ParentId) -> - create(label,ParentId,[]). -label(ParentId,Options) -> - create(label,ParentId,Options). -label(Name,ParentId,Options) -> - create(label,Name,ParentId,Options). - -message(ParentId) -> - create(message,ParentId,[]). -message(ParentId,Options) -> - create(message,ParentId,Options). -message(Name,ParentId,Options) -> - create(message,Name,ParentId,Options). - -listbox(ParentId) -> - create(listbox,ParentId,[]). -listbox(ParentId,Options) -> - create(listbox,ParentId,Options). -listbox(Name,ParentId,Options) -> - create(listbox,Name,ParentId,Options). - -entry(ParentId) -> - create(entry,ParentId,[]). -entry(ParentId,Options) -> - create(entry,ParentId,Options). -entry(Name,ParentId,Options) -> - create(entry,Name,ParentId,Options). - -scrollbar(ParentId) -> - create(scrollbar,ParentId,[]). -scrollbar(ParentId,Options) -> - create(scrollbar,ParentId,Options). -scrollbar(Name,ParentId,Options) -> - create(scrollbar,Name,ParentId,Options). - -scale(ParentId) -> - create(scale,ParentId,[]). -scale(ParentId,Options) -> - create(scale,ParentId,Options). -scale(Name,ParentId,Options) -> - create(scale,Name,ParentId,Options). - -editor(ParentId) -> - create(editor,ParentId,[]). -editor(ParentId,Options) -> - create(editor,ParentId,Options). -editor(Name,ParentId,Options) -> - create(editor,Name,ParentId,Options). - -prompter(ParentId) -> - create(prompter,ParentId,[]). -prompter(ParentId,Options) -> - create(prompter,ParentId,Options). -prompter(Name,ParentId,Options) -> - create(prompter,Name,ParentId,Options). - -line(ParentId) -> - create(line,ParentId,[]). -line(ParentId,Options) -> - create(line,ParentId,Options). -line(Name,ParentId,Options) -> - create(line,Name,ParentId,Options). - -oval(ParentId) -> - create(oval,ParentId,[]). -oval(ParentId,Options) -> - create(oval,ParentId,Options). -oval(Name,ParentId,Options) -> - create(oval,Name,ParentId,Options). - -rectangle(ParentId) -> - create(rectangle,ParentId,[]). -rectangle(ParentId,Options) -> - create(rectangle,ParentId,Options). -rectangle(Name,ParentId,Options) -> - create(rectangle,Name,ParentId,Options). - -polygon(ParentId) -> - create(polygon,ParentId,[]). -polygon(ParentId,Options) -> - create(polygon,ParentId,Options). -polygon(Name,ParentId,Options) -> - create(polygon,Name,ParentId,Options). - -text(ParentId) -> - create(text,ParentId,[]). -text(ParentId,Options) -> - create(text,ParentId,Options). -text(Name,ParentId,Options) -> - create(text,Name,ParentId,Options). - -image(ParentId) -> - create(image,ParentId,[]). -image(ParentId,Options) -> - create(image,ParentId,Options). -image(Name,ParentId,Options) -> - create(image,Name,ParentId,Options). - -arc(ParentId) -> - create(arc,ParentId,[]). -arc(ParentId,Options) -> - create(arc,ParentId,Options). -arc(Name,ParentId,Options) -> - create(arc,Name,ParentId,Options). - -menu(ParentId) -> - create(menu,ParentId,[]). -menu(ParentId, Options) -> - create(menu,ParentId,Options). -menu(Name,ParentId,Options) -> - create(menu,Name,ParentId,Options). - -menubutton(ParentId) -> - create(menubutton,ParentId,[]). -menubutton(ParentId,Options) -> - create(menubutton,ParentId,Options). -menubutton(Name,ParentId,Options) -> - create(menubutton,Name,ParentId,Options). - -menubar(ParentId) -> - create(menubar,ParentId,[]). -menubar(ParentId,Options) -> - create(menubar,ParentId,Options). -menubar(Name,ParentId,Options) -> - create(menubar,Name,ParentId,Options). - -menuitem(ParentId) -> - create(menuitem,ParentId,[]). -menuitem(ParentId,Options) -> - create(menuitem,ParentId,Options). -menuitem(Name,ParentId,Options) -> - create(menuitem,Name,ParentId,Options). - -grid(ParentId) -> - create(grid,ParentId,[]). -grid(ParentId,Options) -> - create(grid,ParentId,Options). -grid(Name,ParentId,Options) -> - create(grid,Name,ParentId,Options). - -gridline(ParentId) -> - create(gridline,ParentId,[]). -gridline(ParentId,Options) -> - create(gridline,ParentId,Options). -gridline(Name,ParentId,Options) -> - create(gridline,Name,ParentId,Options). - -%%---------------------------------------------------------------------- -%% Waiting for erl44 -%%---------------------------------------------------------------------- -foreach(F, ExtraArgs, [H | T]) -> - apply(F, [H | ExtraArgs]), - foreach(F, ExtraArgs, T); -foreach(_F, _ExtraArgs, []) -> ok. - -%%---------------------------------------------------------------------- -%% ASSociation with eQual key (scheme standard) -%%---------------------------------------------------------------------- -assq(Key, List) -> - case lists:keysearch(Key, 1, List) of - {value, {_, Val}} -> {value, Val}; - _ -> false - end. - -%%---------------------------------------------------------------------- -%% When we need the whole pair. -%%---------------------------------------------------------------------- -pair(Key, List) -> - case lists:keysearch(Key, 1, List) of - {value, Pair} -> Pair; - _ -> false - end. - -%%---------------------------------------------------------------------- -%% When we know there is a value -%%---------------------------------------------------------------------- -val(Key, List) when is_list(List) -> - {value, {_,Val}} = lists:keysearch(Key, 1, List), - Val. - -val(Key,List,ElseVal) when is_list(List) -> - case lists:keysearch(Key, 1, List) of - {value, {_, Val}} -> Val; - _ -> ElseVal - end. - -%% ---------------------------------------- -%% done diff --git a/lib/gs/src/gs_frontend.erl b/lib/gs/src/gs_frontend.erl deleted file mode 100644 index f46fdb36bb..0000000000 --- a/lib/gs/src/gs_frontend.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% -%% - -%% -%% ------------------------------------------------------------ -%% Erlang Graphics Interface front-end server -%% ------------------------------------------------------------ -%% - --module(gs_frontend). --compile([{nowarn_deprecated_function,{gs,assq,2}}, - {nowarn_deprecated_function,{gs,error,2}}]). - --export([create/2, - config/2, - read/2, - destroy/2, - info/1, - start/1, - stop/0, - init/1, - event/3]). - - --include("gstk.hrl"). - - -%%---------------------------------------------------------------------- -%% The ets contains: {Obj,lives}|{Obj,{Name,Pid}} -%% new obj is {Int,Node} -%% {{Name,Pid},Obj} -%%---------------------------------------------------------------------- --record(state, {db,user,user_count,kernel,kernel_count,self}). - -%%---------------------------------------------------------------------- -%% The interface. -%%---------------------------------------------------------------------- -create(GsPid,Args) -> - request(GsPid,{create,Args}). - -config(GsPid,Args) -> - request(GsPid,{config, Args}). - -read(GsPid,Args) -> - request(GsPid,{read, Args}). - -destroy(GsPid,IdOrName) -> - request(GsPid,{destroy, IdOrName}). - -info(Option) -> - request(gs_frontend,{info,Option}). - - -%%---------------------------------------------------------------------- -%% Comment: Frontend is only locally registered. These functions are called -%% by any backend. -%%---------------------------------------------------------------------- -event(FrontEnd,ToOwner,EventMsg) -> - FrontEnd ! {event, ToOwner,EventMsg}. - - -request(GsPid,Msg) -> - GsPid ! {self(),Msg}, - receive - {gs_reply,R} -> R - end. - -%%---------------------------------------------------------------------- -%% The server -%%---------------------------------------------------------------------- - -start(Opts) -> - case whereis(gs_frontend) of - undefined -> - P = spawn_link(gs_frontend,init,[Opts]), - case catch register(gs_frontend, P) of - true -> - request(gs_frontend,{instance, backend_name(Opts), Opts}); - {'EXIT', _} -> - exit(P,kill), % a raise... and I lost this time - start(Opts) - end; - P -> - request(P,{instance,backend_name(Opts),Opts}) - end. - -backend_name(Opts) -> - case gs:assq(kernel,Opts) of - {value,true} -> kernel; - _ -> user - end. - - -stop() -> - request(gs_frontend,stop). - -%% ------------------------------------------------------------ -%% THE FRONT END SERVER -%% ------------------------------------------------------------ -%% Initialize -%% -init(_Opts) -> - process_flag(trap_exit, true), - DB=ets:new(gs_names,[set,public]), - loop(#state{db=DB,self=self()}). - -loop(State) -> - receive - X -> - % io:format("frontend received: ~p~n",[X]), - case catch (doit(X,State)) of - done -> loop(State); - NewState when is_record(NewState,state) -> - loop(NewState); - stop -> stop; - Reason -> - io:format("GS frontend. Last mgs in was:~p~n",[X]), - io:format("exit:~p~n",[X]), - io:format("Reason: ~p~n", [Reason]), - terminate(Reason,State), - exit(Reason) - end - end. - -reply(To,Msg) -> - To ! {gs_reply,Msg}, - done. - -doit({FromOwner,{config, Args}},State) -> - {IdOrName, Opts} = Args, - #state{db=DB} = State, - case idOrName_to_id(DB,IdOrName,FromOwner) of - undefined -> - reply(FromOwner,{error,{no_such_object,IdOrName}}); - Obj -> - reply(FromOwner,gstk:config(backend(State,Obj),{Obj,Opts})) - end; - -doit({event,ToOwner,{gs,Obj,Etype,Data,Args}}, #state{db=DB,self=Self}) -> - case ets:lookup(DB,Obj) of - [{_,{Name,ToOwner}}] -> ToOwner ! {gs,Name,Etype,Data,Args}; - _ -> ToOwner ! {gs,{Obj,Self},Etype,Data,Args} - end, - done; - -doit({FromOwner,{create,Args}}, State) -> - {Objtype, Name, Parent, Opts} = Args, - #state{db=DB} = State, - NameOccupied = case {Name, ets:lookup(DB,{Name,FromOwner})} of - {undefined,_} -> false; - {_, []} -> false; - _ -> true - end, - if NameOccupied == true -> - reply(FromOwner, {error,{name_occupied,Name}}); - true -> - case idOrName_to_id(DB,Parent,FromOwner) of - undefined -> - reply(FromOwner, {error,{no_such_parent,Parent}}); - ParentObj -> - {Id,NewState} = inc(ParentObj,State), - case gstk:create(backend(State,ParentObj), - {FromOwner,{Objtype,Id,ParentObj,Opts}}) of - ok -> - link(FromOwner), - if Name == undefined -> - ets:insert(DB,{Id,lives}), - reply(FromOwner, Id), - NewState; - true -> % it's a real name, register it - NamePid = {Name,FromOwner}, - ets:insert(DB,{NamePid,Id}), - ets:insert(DB,{Id,NamePid}), - reply(FromOwner,Id), - NewState - end; - Err -> reply(FromOwner,Err) - end - end - end; - -doit({FromOwner,{read, Args}}, State) -> - #state{db=DB} = State, - {IdOrName, Opt} = Args, - case idOrName_to_id(DB,IdOrName,FromOwner) of - undefined -> - reply(FromOwner,{error,{no_such_object,IdOrName}}); - Obj -> - reply(FromOwner,gstk:read(backend(State,Obj),{Obj,Opt})) - end; - -doit({'EXIT', UserBackend, Reason}, State) - when State#state.user == UserBackend -> - gs:error("user backend died reason ~w~n", [Reason]), - remove_user_objects(State#state.db), - State#state{user=undefined}; - -doit({'EXIT', KernelBackend, Reason}, State) - when State#state.kernel == KernelBackend -> - gs:error("kernel backend died reason ~w~n", [Reason]), - exit({gs_kernel_died,Reason}); - -doit({'EXIT', Pid, _Reason}, #state{kernel=K,user=U,db=DB}) -> - %% io:format("Pid ~w died reason ~w~n", [Pid, _Reason]), - if is_pid(U) -> - DeadObjU = gstk:pid_died(U,Pid), - remove_objs(DB,DeadObjU); - true -> ok - end, - if is_pid(K) -> - DeadObjK = gstk:pid_died(K,Pid), - remove_objs(DB,DeadObjK); - true -> true end, - done; - -doit({FromOwner,{destroy, IdOrName}}, State) -> - #state{db=DB} = State, - case idOrName_to_id(DB,IdOrName,FromOwner) of - undefined -> - reply(FromOwner, {error,{no_such_object,IdOrName}}); - Obj -> - DeadObj = gstk:destroy(backend(State,Obj),Obj), - remove_objs(DB,DeadObj), - reply(FromOwner,done) - end; - -doit({From,{instance,user,Opts}},State) -> - #state{db=DB, self=Self, user_count=UC} = State, - case ets:lookup(DB,1) of - [_] -> reply(From, {1,Self}); - [] -> - ets:insert(DB,{1,lives}), % parent of all user gs objs - case gstk:start_link(1, Self, Self, Opts) of - {ok, UserBackend} -> - reply(From, {1, Self}), - case UC of - undefined -> - State#state{user_count=1, user=UserBackend}; - _N -> - State#state{user_count=UC+2, user=UserBackend} - end; - {error, Reason} -> - reply(From, {error, Reason}), - stop - end - end; - -doit({From,{instance,kernel,Opts}},State) -> - #state{db=DB,self=Self} = State, - case ets:lookup(DB,0) of - [_] -> reply(From, {0,Self}); - [] -> - ets:insert(DB,{0,lives}), % parent of all user gs objs - case gstk:start_link(0,Self,Self,Opts) of - {ok, KernelBackend} -> - reply(From, {0,Self}), - State#state{kernel_count=0,kernel=KernelBackend}; - {error, Reason} -> - reply(From, {error,Reason}), - stop - end - end; - - -doit({From,stop}, State) -> - #state{kernel=K,user=U} = State, - if is_pid(U) -> gstk:stop(U); - true -> true end, - if is_pid(K) -> gstk:stop(K); - true -> true end, - reply(From,stopped), - stop; - -doit({From,{gstk,user,Msg}},State) -> - reply(From,gstk:request(State#state.user,Msg)); -doit({From,{gstk,kernel,Msg}},State) -> - reply(From,gstk:request(State#state.kernel,Msg)); - -doit({From,{info,gs_db}},State) -> - io:format("gs_db:~p~n",[ets:tab2list(State#state.db)]), - reply(From,State); -doit({From,{info,kernel_db}},State) -> - reply(From,gstk:request(State#state.kernel,dump_db)); -doit({From,{info,user_db}},State) -> - reply(From,gstk:request(State#state.user,dump_db)); -doit({From,{info,Unknown}},_State) -> - io:format("gs: unknown info option '~w', use one of 'gs_db', 'kernel_db' or 'user_db'~n",[Unknown]), - reply(From,ok). - -terminate(_Reason,#state{db=DB}) -> - if DB==undefined -> ok; - true -> - % io:format("frontend db:~p~n",[ets:tab2list(DB)]) - ok - end. - - -backend(#state{user=Upid,kernel=Kpid},Obj) -> - if Obj rem 2 == 0 -> Kpid; - true -> Upid - end. - -%%---------------------------------------------------------------------- -%% Returns: {NewId,NewState} -%%---------------------------------------------------------------------- -inc(ParInt,State) when ParInt rem 2 == 1 -> - X=State#state.user_count+2, - {X,State#state{user_count=X}}; -inc(ParInt,State) when ParInt rem 2 == 0 -> - X=State#state.kernel_count+2, - {X,State#state{kernel_count=X}}. - -remove_user_objects(DB) -> - DeadObj = find_user_obj(ets:first(DB),DB), - remove_objs(DB,DeadObj). - -find_user_obj(Int,DB) when is_integer(Int) -> - if Int rem 2 == 0 -> %% a kernel obj - find_user_obj(ets:next(DB,Int),DB); - true -> %% a user obj - [Int|find_user_obj(ets:next(DB,Int),DB)] - end; -find_user_obj('$end_of_table',_DB) -> - []; -find_user_obj(OtherKey,DB) -> - find_user_obj(ets:next(DB,OtherKey),DB). - -remove_objs(DB,[Obj|Objs]) -> - case ets:lookup(DB, Obj) of - [{_,NamePid}] -> - ets:delete(DB,Obj), - ets:delete(DB,NamePid); - [] -> backend_only - end, - remove_objs(DB,Objs); -remove_objs(_DB,[]) -> done. - -idOrName_to_id(DB,IdOrName,Pid) when is_atom(IdOrName) -> - case ets:lookup(DB,{IdOrName,Pid}) of - [{_,Obj}] -> Obj; - _ -> undefined - end; -idOrName_to_id(DB,Obj,_Pid) -> - case ets:lookup(DB,Obj) of - [_] -> Obj; - _ -> undefined - end. - - - - -%% ---------------------------------------- -%% done - diff --git a/lib/gs/src/gs_make.erl b/lib/gs/src/gs_make.erl deleted file mode 100644 index 061b1944d1..0000000000 --- a/lib/gs/src/gs_make.erl +++ /dev/null @@ -1,266 +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% -%% - -%% --module(gs_make). --compile([{nowarn_deprecated_function,{gs,assq,2}}]). - --export([start/0]). - -start() -> - Terms = the_config(), - DB=fill_ets(Terms), - {ok,OutFd} = file:open("gstk_generic.hrl", [write]), - put(stdout,OutFd), -% io:format("terms: ~p ~n ets:~p~n",[Terms,ets:tab2list(DB)]), - p("% Don't edit this file. It was generated by gs_make:start/0 "), - p("at ~p-~p-~p, ~p:~p:~p.\n\n", - lists:append(tuple_to_list(date()),tuple_to_list(time()))), - gen_out_opts(DB), - gen_read(DB), - file:close(OutFd), - {ok,"gstk_generic.hrl",DB}. - -fill_ets(Terms) -> - DB = ets:new(gs_mapping,[bag,public]), - fill_ets(DB,Terms). - -fill_ets(DB,[]) -> DB; -fill_ets(DB,[{Objs,Opt,Fun,Access}|Terms]) -> - fill_ets(DB,lists:flatten(Objs),Opt,Fun,Access), - fill_ets(DB,Terms). - -fill_ets(_DB,[],_,_,_) -> done; -fill_ets(DB,[Obj|Objs],Opt,Fun,rw) -> - ets:insert(DB,{Obj,Opt,Fun,read}), - ets:insert(DB,{Obj,Opt,Fun,write}), - fill_ets(DB,Objs,Opt,Fun,rw); -fill_ets(DB,[Obj|Objs],Opt,Fun,r) -> - ets:insert(DB,{Obj,Opt,Fun,read}), - fill_ets(DB,Objs,Opt,Fun,r); -fill_ets(DB,[Obj|Objs],Opt,Fun,w) -> - ets:insert(DB,{Obj,Opt,Fun,write}), - fill_ets(DB,Objs,Opt,Fun,w). - - - -gen_out_opts(DB) -> - ObjTypes = lists:flatten(ordsets:from_list(ets:match(DB,{'$1','_','_',write}))), - p("out_opts([Option|Options],Gstkid,TkW,DB,ExtraArg,S,P,C) ->\n"), - p(" {Opt,Val} =\n"), - p(" case Option of \n"), - p(" {{default,Cat,Key},V} -> {default,{Cat,{Key,V}}};\n"), - p(" {_Key,_V} -> Option;\n"), - p(" {default,Cat,Opti} -> {default,{Cat,Opti}};\n"), - p(" Atom when is_atom(Atom) -> {Atom,undefined};\n"), - p(" _ -> {error, {invalid_option,Option}}\n"), - p(" end,\n"), - p(" case Gstkid#gstkid.objtype of\n"), - gen_out_type_case_clauses(merge_types(ObjTypes),DB), - p(" Q -> exit({internal_error,unknown_objtype,Q})\n"), - p(" end;\n"), - p("out_opts([],_Gstkid,_TkW,_DB,_ExtraArg,S,P,C) -> \n"), - p(" {S,P,C}.\n"). - - -gen_out_type_case_clauses([],_DB) -> done; -gen_out_type_case_clauses([Objtype|Objtypes],DB) -> - OptsFuns = lists:map(fun(L) -> list_to_tuple(L) end, - ets:match(DB,{Objtype,'$1','$2',write})), - p(" ~p -> \ncase Opt of\n",[Objtype]), - gen_opt_case_clauses(merge_opts(opt_prio(),OptsFuns)), - p(" _ -> \n"), - p(" handle_external_opt_call([Option|Options],Gstkid,TkW,DB,ExtraArg," - " gstk_~p:option(Option,Gstkid,TkW,DB,ExtraArg),S,P,C)\n", - [Objtype]), - p(" end;\n"), - gen_out_type_case_clauses(Objtypes,DB). - -gen_opt_case_clauses([]) -> - done; -gen_opt_case_clauses([{Opt,Fun}|OptFuncs]) -> - p(" ~p ->\n",[Opt]), - p(" ~p(Val,Options,Gstkid,TkW,DB,ExtraArg,S,P,C);\n",[Fun]), - gen_opt_case_clauses(OptFuncs). - -gen_read(DB) -> - ObjTypes = lists:flatten(ordsets:from_list(ets:match(DB,{'$1','_','_',read}))), - p("read_option(DB,Gstkid,TkW,Option,ExtraArg) ->\n"), - p(" Key = case Option of\n"), - p(" Atom when is_atom(Atom) -> Atom;\n"), - p(" Opt when is_tuple(Opt) -> element(1,Opt)\n"), - p(" end,\n"), - p(" case Gstkid#gstkid.objtype of\n"), - gen_read_type_clauses(merge_types(ObjTypes),DB), - p(" Q -> exit({internal_error,unknown_objtype,Q})\n"), - p(" end.\n"). - - -gen_read_type_clauses([],_) -> done; -gen_read_type_clauses([Objtype|Objtypes],DB) -> - OptsFuns = lists:map(fun(L) -> list_to_tuple(L) end, - ets:match(DB,{Objtype,'$1','$2',read})), - p(" ~p -> \ncase Key of\n",[Objtype]), - gen_readopt_case_clauses(merge_opts(opt_prio(),OptsFuns)), - p(" _ -> \nhandle_external_read(gstk_~p:read_option(Option,Gstkid,TkW,DB,ExtraArg))\n",[Objtype]), - p(" end;\n"), - gen_read_type_clauses(Objtypes,DB). - -gen_readopt_case_clauses([]) -> - done; -gen_readopt_case_clauses([{Opt,Fun}|OptFuncs]) -> - p(" ~p -> \n~p(Option,Gstkid,TkW,DB,ExtraArg);\n",[Opt,Fun]), - gen_readopt_case_clauses(OptFuncs). - - -p(Str) -> - ok = io:format(get(stdout),Str,[]). - -p(Format,Data) -> - ok = io:format(get(stdout),Format,Data). - -%%---------------------------------------------------------------------- -%% There items should be placed early in a case statement. -%%---------------------------------------------------------------------- -obj_prio() -> [rectangle,line,gridline,image,button,canvas,checkbutton,radiobutton]. -opt_prio() -> [x,y,width,height,move,coords,data]. - -merge_types(Types) -> - T2 = ordsets:from_list(Types), - P2 = ordsets:from_list(obj_prio()), - obj_prio() ++ ordsets:subtract(T2, P2). - -merge_opts([],L) -> L; -merge_opts([Opt|Opts],Dict) -> - case gs:assq(Opt,Dict) of - {value,V} -> [{Opt,V}|merge_opts(Opts,lists:keydelete(Opt,1,Dict))]; - false -> merge_opts(Opts,Dict) - end. - -the_config() -> - Buttons=[button,checkbutton,radiobutton], - AllPureTk = [Buttons,canvas,editor,entry,frame,label,listbox, - menubar,menubutton,scale,window], - CanvasObj = [arc,image,line,oval,polygon,rectangle,text], - All = [AllPureTk,CanvasObj,grid,gridline,menu,menuitem,gs], - Containers = [canvas,frame,grid,menu,menubar,menubutton,menuitem,window], - Ob1 = [Buttons,canvas,grid,frame,label,entry,editor,listbox,scale], - Ob2 = [button,checkbutton,radiobutton,label,menubutton], - Ob3 = [Buttons,frame,label,entry,editor,listbox,scale,menubutton, - menubar,menu], - Ob4 = [canvas,editor,listbox], - [{[Buttons,entry,scale,menubutton],enable,gen_enable,rw}, - {[Buttons,label,entry,scale,menubutton,menu],fg,gen_fg,rw}, - {[Buttons,label,entry,scale,menubutton,menu],bg,gen_bg,rw}, - {Ob1,anchor,gen_anchor,rw}, - {Ob1,height,gen_height,r}, - {Ob1--[frame],height,gen_height,w}, - {Ob1,width,gen_width,r}, - {Ob1--[frame],width,gen_width,w}, - {Ob1,pack_x,gen_pack_x,rw}, - {Ob1,pack_y,gen_pack_y,rw}, - {Ob1,pack_xy,gen_pack_xy,w}, - {Ob1,x,gen_x,rw}, - {Ob1,y,gen_y,rw}, - {Ob1,raise,gen_raise,w}, - {Ob1,lower,gen_lower,w}, - {Ob2,align,gen_align,rw}, - {Ob2,font,gen_font,rw}, - {Ob2,justify,gen_justify,rw}, - {Ob2,padx,gen_padx,rw}, - {Ob2,pady,gen_pady,rw}, - {Containers,default,gen_default,w}, - {[AllPureTk,menu],relief,gen_relief,rw}, - {[AllPureTk,menu],bw,gen_bw,rw}, - {[Buttons,canvas,frame,label,entry,scale,menubutton,menu,menubar], - setfocus,gen_setfocus,rw}, - {Ob3,buttonpress,gen_buttonpress,rw}, - {Ob3,buttonrelease,gen_buttonrelease,rw}, - {Ob3,configure,gen_configure,rw}, - {[Ob3,window],destroy,gen_destroy,rw}, - {[Ob3,window],enter,gen_enter,rw}, - {[Ob3,window],leave,gen_leave,rw}, - {[Ob3,window],focus,gen_focus_ev,rw}, - {[Ob3,window],keypress,gen_keypress,rw}, - {[Ob3,window],keyrelease,gen_keyrelease,rw}, - {Ob3,motion,gen_motion,rw}, - %% events containing x,y are special - {[window],buttonpress,gen_buttonpress,r}, - {[window],buttonrelease,gen_buttonrelease,r}, - {[window],motion,gen_motion,r}, - {All,font_wh,gen_font_wh,r}, - {All,choose_font,gen_choose_font,r}, - {All,data,gen_data,rw}, - {All,children,gen_children,r}, - {All,id,gen_id,r}, - {All,parent,gen_parent,r}, - {All,type,gen_type,r}, - {All,beep,gen_beep,w}, - {All,keep_opt,gen_keep_opt,w}, - {All,flush,gen_flush,rw}, - {AllPureTk,highlightbw,gen_highlightbw,rw}, - {AllPureTk,highlightbg,gen_highlightbg,rw}, - {AllPureTk,highlightfg,gen_highlightfg,rw}, - {AllPureTk,cursor,gen_cursor,rw}, % bug - {[Buttons,label,menubutton],label,gen_label,rw}, - {[Buttons,menubutton,menu],activebg,gen_activebg,rw}, - {[Buttons,menubutton,menu],activefg,gen_activefg,rw}, - {[entry],selectbg,gen_selectbg,rw}, - {[entry],selectbw,gen_selectbw,rw}, - {[entry],selectfg,gen_selectfg,rw}, - {Ob4,activebg,gen_so_activebg,rw}, - {Ob4,bc,gen_so_bc,rw}, - {Ob4,bg,gen_so_bg,rw}, - {Ob4,hscroll,gen_so_hscroll,r}, - {Ob4,scrollbg,gen_so_scrollbg,rw}, - {Ob4,scrollfg,gen_so_scrollfg,rw}, - {Ob4,scrolls,gen_so_scrolls,w}, - {Ob4,selectbg,gen_so_selectbg,rw}, - {Ob4,selectbg,gen_so_selectbg,rw}, - {Ob4,selectbw,gen_so_selectbw,rw}, - {Ob4,selectbw,gen_so_selectbw,rw}, - {Ob4,selectfg,gen_so_selectfg,rw}, - {Ob4,selectfg,gen_so_selectfg,rw}, - {Ob4,vscroll,gen_so_vscroll,r}, - {CanvasObj,coords,gen_citem_coords,rw}, - {CanvasObj,lower,gen_citem_lower,w}, - {CanvasObj,raise,gen_citem_raise,w}, - {CanvasObj,move,gen_citem_move,w}, - {CanvasObj,setfocus,gen_citem_setfocus,rw}, - {CanvasObj,buttonpress,gen_citem_buttonpress,w}, % should be rw - {CanvasObj,buttonrelease,gen_citem_buttonrelease,w}, - {CanvasObj,enter,gen_citem_enter,w}, - {CanvasObj,focus,gen_citem_setfocus,w}, - {CanvasObj,keypress,gen_citem_keypress,w}, - {CanvasObj,keyrelease,gen_citem_keyrelease,w}, - {CanvasObj,leave,gen_citem_leave,w}, - {CanvasObj,motion,gen_citem_motion,w}, - {CanvasObj,buttonpress,gen_buttonpress,r}, - {CanvasObj,buttonrelease,gen_buttonrelease,r}, - {CanvasObj,configure,gen_configure,r}, - {CanvasObj,destroy,gen_destroy,r}, - {CanvasObj,enter,gen_enter,r}, - {CanvasObj,leave,gen_leave,r}, - {CanvasObj,focus,gen_focus_ev,r}, - {CanvasObj,keypress,gen_keypress,r}, - {CanvasObj,keyrelease,gen_keyrelease,r}, - {CanvasObj,motion,gen_motion,r}, - {[arc,oval,polygon,rectangle],fill,gen_citem_fill,rw}]. - diff --git a/lib/gs/src/gs_packer.erl b/lib/gs/src/gs_packer.erl deleted file mode 100644 index d16849e4e9..0000000000 --- a/lib/gs/src/gs_packer.erl +++ /dev/null @@ -1,276 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-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% -%% - -%% -%% ------------------------------------------------------------ -%% Erlang Graphics Interface geometry manager caclulator -%% ------------------------------------------------------------ - - --module(gs_packer). - --export([pack/2]). -%-compile(export_all). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% -%%%% This is a simple packer that take a specification in the format -%%%% -%%%% Spec -> [WidthSpec, WidthSpec....] -%%%% WidthSpec -> {fixed,Size} | {stretch,Weight} | -%%%% {stretch,Weight,Min} | {stretch,Weight,Min,Max} -%%%% -%%%% and a given total size it produces a list of sizes of the -%%%% individual elements. Simple heuristics are used to make the code -%%%% fast and simple. -%%%% -%%%% The Weight is simply a number that is the relative size to the -%%%% other elements that has weights. If for example the weights -%%%% for a frame that has three columns are 40 20 100 it means that -%%%% column 1 has 40/160'th of the space, column 2 20/160'th of -%%%% the space and column 3 100/160'th of the space. -%%%% -%%%% The program try to solve the equation with the constraints given. -%%%% We have tree cases -%%%% -%%%% o We can fullfil the request in the space given -%%%% o We have less space than needed -%%%% o We have more space than allowed -%%%% -%%%% The algorithm is as follows: -%%%% -%%%% 1. Subtract the fixed size, nothing to do about that. -%%%% -%%%% 2. Calculate the Unit (or whatever it should be called), the -%%%% given space minus the fixed sise divided by the Weights. -%%%% -%%%% 3. If we in total can fullfill the request we try to -%%%% fullfill the individual constraints. See remove_failure/2. -%%%% -%%%% 4. If we have too little or too much pixels we take our -%%%% specification and create a new more relaxed one. See -%%%% cnvt_to_min/1 and cnvt_to_max/1. -%%%% -%%%% In general we adjust the specification and redo the whole process -%%%% until we have a specification that meet the total constraints -%%%% and individual constraints. When we know that the constraints -%%%% are satisfied we finally call distribute_space/2 to set the -%%%% resulting size values for the individual elements. -%%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - -pack(Size, SpecSizes) when Size < 0 -> - pack(0, SpecSizes); -pack(Size, SpecSizes) -> - {Weights,_Stretched,Fixed,Min,Max} = get_size_info(SpecSizes), - Left = Size - Fixed, - Unit = if Weights == 0 -> 0; true -> Left / Weights end, - if - Left < Min -> - NewSpecs = cnvt_to_min(SpecSizes), - pack(Size,NewSpecs); - is_integer(Max), Max =/= 0, Left > Max -> - NewSpecs = cnvt_to_max(SpecSizes), - pack(Size,NewSpecs); - true -> - case remove_failure(SpecSizes, Unit) of - {no,NewSpecs} -> - distribute_space(NewSpecs,Unit); - {yes,NewSpecs} -> - pack(Size, NewSpecs) - end - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% -%%%% remove_failure(Specs, Unit) -%%%% -%%%% We know that we in total have enough space to fit within the total -%%%% maximum and minimum requirements. But we have to take care of -%%%% individual minimum and maximum requirements. -%%%% -%%%% This is done with a simple heuristic. We pick the element that -%%%% has the largest diff from the required min or max, change this -%%%% {stretch,W,Mi,Ma} to a {fixed,Mi} or {fixed,Ma} and redo the -%%%% whole process again. -%%%% -%%%% **** BUGS **** -%%%% No known. But try to understand this function and you get a medal ;-) -%%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - -remove_failure(Specs, Unit) -> - case remove_failure(Specs, Unit, 0) of - {done,NewSpecs} -> - {yes,NewSpecs}; - {_,_NewSpecs} -> - {no,Specs} % NewSpecs == Specs but - end. % we choose the old one - -remove_failure([], _Unit, MaxFailure) -> - {MaxFailure,[]}; -remove_failure([{stretch,W,Mi} | Specs], Unit, MaxFailure) -> - {MinMax,NewMaxFailure} = max_failure(MaxFailure, Mi-W*Unit, 0), - case {MinMax,remove_failure(Specs, Unit, NewMaxFailure)} of - {min,{NewMaxFailure,Rest}} -> - {done,[{fixed,Mi} | Rest]}; - {_,{OtherMaxFailure, Rest}} -> - {OtherMaxFailure,[{stretch,W,Mi} | Rest]} - end; -remove_failure([{stretch,W,Mi,Ma} | Specs], Unit, MaxFailure) -> - {MinMax,NewMaxFailure} = max_failure(MaxFailure, Mi-W*Unit, W*Unit-Ma), - case {MinMax,remove_failure(Specs, Unit, NewMaxFailure)} of - {min,{NewMaxFailure,Rest}} -> - {done,[{fixed,Mi} | Rest]}; - {max,{NewMaxFailure,Rest}} -> - {done,[{fixed,Ma} | Rest]}; - {_,{OtherMaxFailure, Rest}} -> - {OtherMaxFailure,[{stretch,W,Mi,Ma} | Rest]} - end; -remove_failure([Spec | Specs], Unit, MaxFailure) -> - {NewMaxFailure,NewSpecs} = remove_failure(Specs, Unit, MaxFailure), - {NewMaxFailure, [Spec | NewSpecs]}. - -max_failure(LastDiff, DMi, DMa) - when DMi > LastDiff, DMi > DMa -> - {min,DMi}; -max_failure(LastDiff, _DMi, DMa) - when DMa > LastDiff -> - {max,DMa}; -max_failure(MaxFailure, _DMi, _DMa) -> - {other,MaxFailure}. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% -%%%% distribute_space(Spec,Unit) -%%%% -%%%% We now know that we can distribute the space to the elements in -%%%% the list. -%%%% -%%%% **** BUGS **** -%%%% No known bugs. It try hard to distribute the pixels so that -%%%% there should eb no pixels left when done but there is no proof -%%%% that this is the case. The distribution of pixels may also -%%%% not be optimal. The rounding error from giving one element some -%%%% pixels is added to the next even if it would be better to add -%%%% it to an element later in the list (for example the weights -%%%% 1000, 2, 1000). But this should be good enough. -%%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - -distribute_space(Specs, Unit) -> - distribute_space(Specs, Unit, 0.0). - -distribute_space([], _Unit, _Err) -> - []; -distribute_space([Spec | Specs], Unit, Err) -> - distribute_space(Spec, Specs, Unit, Err). - -distribute_space({fixed,P}, Specs, Unit, Err) -> - [P | distribute_space(Specs, Unit, Err)]; -distribute_space({stretch,Weight}, Specs, Unit, Err) -> - Size = Weight * Unit + Err, - Pixels = round(Size), - NewErr = Size - Pixels, - [Pixels | distribute_space(Specs, Unit, NewErr)]; -distribute_space({stretch,W,_Mi}, Specs, Unit, Err) -> - distribute_space({stretch,W}, Specs, Unit, Err); -distribute_space({stretch,W,_Mi,_Ma}, Specs, Unit, Err) -> - distribute_space({stretch,W}, Specs, Unit, Err). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% -%%%% cnvt_to_min(Spec) -%%%% cnvt_to_max(Spec) -%%%% -%%%% If the space we got isn't enough for the total minimal or maximal -%%%% requirements then we convert the specification to a more relaxed -%%%% one that we always can satisfy. -%%%% -%%%% This is fun! We do a simple transformation from one specification -%%%% to a new one. The min, max and fixed size are our new weights! -%%%% This way the step from a specification we can satisfy and one -%%%% close that we can't is only a few pixels away, i.e. the transition -%%%% from within the constraints and outside will be smooth. -%%%% -%%%% **** BUGS **** -%%%% No known bugs. -%%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - -cnvt_to_min([]) -> - []; -cnvt_to_min([Spec | Specs]) -> - cnvt_to_min(Spec, Specs). - -cnvt_to_max([]) -> - []; -cnvt_to_max([Spec | Specs]) -> - cnvt_to_max(Spec, Specs). - -cnvt_to_min({fixed,P}, Specs) -> - [{stretch,P} | cnvt_to_min(Specs)]; -cnvt_to_min({stretch,_W}, Specs) -> - [{fixed,0} | cnvt_to_min(Specs)]; -cnvt_to_min({stretch,_W,Mi}, Specs) -> - [{stretch,Mi} | cnvt_to_min(Specs)]; -cnvt_to_min({stretch,_W,Mi,_Ma}, Specs) -> - [{stretch,Mi} | cnvt_to_min(Specs)]. - -%% We know that there can only be {fixed,P} and {stretch,W,Mi,Ma} -%% in this list. - -cnvt_to_max({fixed,P}, Specs) -> - [{stretch,P} | cnvt_to_max(Specs)]; -cnvt_to_max({stretch,_W,_Mi,Ma}, Specs) -> - [{stretch,Ma} | cnvt_to_max(Specs)]. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% -%%%% Sum the Weights, Min and Max etc -%%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -get_size_info(Specs) -> - get_size_info(Specs, 0, 0, 0, 0, 0). - -get_size_info([], TotW, NumW, TotFixed, TotMin, TotMax) -> - {TotW, NumW, TotFixed, TotMin, TotMax}; -get_size_info([Spec | Specs], TotW, NumW, TotFixed, TotMin, TotMax) -> - get_size_info(Spec, TotW, NumW, TotFixed, TotMin, TotMax, Specs). - -get_size_info({fixed,P}, TotW, NumW, TotFixed, TotMin, TotMax, Specs) -> - get_size_info(Specs, TotW, NumW, TotFixed+P, TotMin, TotMax); -get_size_info({stretch,W}, TotW, NumW, TotFixed, TotMin, _TotMax, Specs) -> - get_size_info(Specs, TotW+W, NumW+1, TotFixed, TotMin, infinity); -get_size_info({stretch,W,Mi}, TotW, NumW, TotFixed, TotMin, _TotMax, Specs) -> - get_size_info(Specs, TotW+W, NumW+1, TotFixed, TotMin+Mi, infinity); -get_size_info({stretch,W,Mi,_Ma}, TotW, NumW, TotFixed, TotMin, infinity, Specs) -> - get_size_info(Specs, TotW+W, NumW+1, TotFixed, TotMin+Mi, infinity); -get_size_info({stretch,W,Mi,Ma}, TotW, NumW, TotFixed, TotMin, TotMax, Specs) -> - get_size_info(Specs, TotW+W, NumW+1, TotFixed, TotMin+Mi, TotMax+Ma). diff --git a/lib/gs/src/gs_widgets.erl b/lib/gs/src/gs_widgets.erl deleted file mode 100644 index f0351049f9..0000000000 --- a/lib/gs/src/gs_widgets.erl +++ /dev/null @@ -1,99 +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% -%% - -%% -%% ------------------------------------------------------------ -%% Widget specific data -%% ------------------------------------------------------------ -%% - --module(gs_widgets). - - -%% ----- Exports ----- --export([default_options/1, - container/1]). - - -%% ------------------------------------------------------------ -%% default_options for widgets -%% Keep the options in the list sorted! -%% ------------------------------------------------------------ - -default_options(arc) -> [{coords, [{0,0}, {0,0}]}]; -default_options(button) -> [{click,true}, {height,30}, {width,100}, {x,0}, - {y,0}]; -default_options(canvas) -> [{height,200}, {scrollregion,{0,0,300,200}}, - {width,300}, {x,0}, {y,0}]; -default_options(checkbutton) -> [{click,true}, {height,30}, {width,100}, {x,0}, - {y,0}]; -default_options(editor) -> [{height,200}, {width,300}, {x,0}, {y,0}]; -default_options(entry) -> [{height,30}, {width,100}, {x,0}, {y,0}]; -default_options(frame) -> [{height,100}, {width,150}, {x,0}, {y,0}]; -default_options(grid) -> [{bg,grey}, {cellheight,20}, - {columnwidths, [80,80,80,80]}, - {fg,black}, {font,{screen, 12}}, - {height,100}, - {hscroll,bottom}, - {rows,{1,10}}, - {vscroll,right}, - {width,300}, - {x,0}, {y,0}]; - % Keep the options in the list sorted! -default_options(gridline) -> [{click,true}, {doubleclick,false}, {row,undefined}]; -default_options(gs) -> [{kernel,false}, - {{default,all,font}, {screen,12}}]; -default_options(image) -> [{anchor,nw}, {coords,[{0,0}]}]; -default_options(label) -> [{height,30}, {width,100}, {x,0}, {y,0}]; -default_options(line) -> [{coords, [{-1,-1},{-1,-1}]}]; -default_options(listbox) -> [{height,130}, {hscroll,true}, - {selectmode,single}, {vscroll,true}, - {width,125}, {x,0}, {y,0}]; -default_options(menu) -> []; - % Keep the options in the list sorted! -default_options(menubar) -> [{bw,2}, {height,25}, {highlightbw,0}, - {relief,raised}]; -default_options(menubutton) -> [{anchor,nw}, {side,left}]; -default_options(menuitem) -> [{click,true}, {index,last}, {itemtype,normal}]; -default_options(message) -> [{height,75}, {width,100}]; -default_options(oval) -> [{coords, [{0,0},{0,0}]}]; -default_options(polygon) -> [{coords, [{0,0},{0,0}]}, {fg,black}, {fill,none}]; -default_options(prompter) -> [{height,200}, {prompt,[]}, {width,300}]; -default_options(radiobutton) -> [{click,true}, {height,30}, {width,100}, - {x,0}, {y,0}]; -default_options(rectangle) -> [{coords, [{0,0},{0,0}]}]; -default_options(scale) -> [{click,true}, {height,50}, {width,100}, - {x,0}, {y,0}]; - % Keep the options in the list sorted! -default_options(scrollbar) -> []; -default_options(text) -> [{anchor,nw}, {coords,[{0,0}]}, {justify,left}]; -default_options(window) -> [{configure,false}, {cursor,arrow}, {destroy,true}, - {height,200}, {map,false}, {width,300}]; -default_options(_) -> []. - -container(canvas) -> true; -container(frame) -> true; -container(grid) -> true; -container(menu) -> true; -container(menubar) -> true; -container(menubutton) -> true; -container(menuitem) -> true; -container(window) -> true; -container(_) -> false. diff --git a/lib/gs/src/gse.erl b/lib/gs/src/gse.erl deleted file mode 100644 index 10fb341894..0000000000 --- a/lib/gs/src/gse.erl +++ /dev/null @@ -1,788 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-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% -%% - -%% -%%%---------------------------------------------------------------------- -%%% Purpose : Wrapper library for GS to provide proper error handling -%%%---------------------------------------------------------------------- - --module(gse). --compile([{nowarn_deprecated_function,{gs,arc,2}}, - {nowarn_deprecated_function,{gs,arc,3}}, - {nowarn_deprecated_function,{gs,button,2}}, - {nowarn_deprecated_function,{gs,button,3}}, - {nowarn_deprecated_function,{gs,canvas,2}}, - {nowarn_deprecated_function,{gs,canvas,3}}, - {nowarn_deprecated_function,{gs,checkbutton,2}}, - {nowarn_deprecated_function,{gs,checkbutton,3}}, - {nowarn_deprecated_function,{gs,config,2}}, - {nowarn_deprecated_function,{gs,create,3}}, - {nowarn_deprecated_function,{gs,create,4}}, - {nowarn_deprecated_function,{gs,create_tree,2}}, - {nowarn_deprecated_function,{gs,destroy,1}}, - {nowarn_deprecated_function,{gs,editor,2}}, - {nowarn_deprecated_function,{gs,editor,3}}, - {nowarn_deprecated_function,{gs,entry,2}}, - {nowarn_deprecated_function,{gs,entry,3}}, - {nowarn_deprecated_function,{gs,frame,2}}, - {nowarn_deprecated_function,{gs,frame,3}}, - {nowarn_deprecated_function,{gs,grid,2}}, - {nowarn_deprecated_function,{gs,grid,3}}, - {nowarn_deprecated_function,{gs,gridline,2}}, - {nowarn_deprecated_function,{gs,gridline,3}}, - {nowarn_deprecated_function,{gs,image,2}}, - {nowarn_deprecated_function,{gs,image,3}}, - {nowarn_deprecated_function,{gs,label,2}}, - {nowarn_deprecated_function,{gs,label,3}}, - {nowarn_deprecated_function,{gs,line,2}}, - {nowarn_deprecated_function,{gs,line,3}}, - {nowarn_deprecated_function,{gs,listbox,2}}, - {nowarn_deprecated_function,{gs,listbox,3}}, - {nowarn_deprecated_function,{gs,menu,2}}, - {nowarn_deprecated_function,{gs,menu,3}}, - {nowarn_deprecated_function,{gs,menubar,2}}, - {nowarn_deprecated_function,{gs,menubar,3}}, - {nowarn_deprecated_function,{gs,menubutton,2}}, - {nowarn_deprecated_function,{gs,menubutton,3}}, - {nowarn_deprecated_function,{gs,menuitem,2}}, - {nowarn_deprecated_function,{gs,menuitem,3}}, - {nowarn_deprecated_function,{gs,message,2}}, - {nowarn_deprecated_function,{gs,message,3}}, - {nowarn_deprecated_function,{gs,oval,2}}, - {nowarn_deprecated_function,{gs,oval,3}}, - {nowarn_deprecated_function,{gs,polygon,2}}, - {nowarn_deprecated_function,{gs,polygon,3}}, - {nowarn_deprecated_function,{gs,prompter,2}}, - {nowarn_deprecated_function,{gs,prompter,3}}, - {nowarn_deprecated_function,{gs,radiobutton,2}}, - {nowarn_deprecated_function,{gs,radiobutton,3}}, - {nowarn_deprecated_function,{gs,read,2}}, - {nowarn_deprecated_function,{gs,rectangle,2}}, - {nowarn_deprecated_function,{gs,rectangle,3}}, - {nowarn_deprecated_function,{gs,scale,2}}, - {nowarn_deprecated_function,{gs,scale,3}}, - {nowarn_deprecated_function,{gs,scrollbar,2}}, - {nowarn_deprecated_function,{gs,scrollbar,3}}, - {nowarn_deprecated_function,{gs,start,0}}, - {nowarn_deprecated_function,{gs,start,1}}, - {nowarn_deprecated_function,{gs,text,2}}, - {nowarn_deprecated_function,{gs,text,3}}, - {nowarn_deprecated_function,{gs,window,2}}, - {nowarn_deprecated_function,{gs,window,3}}]). - -%%-compile(export_all). --export([ - start/0, - start/1, - create/3, - create_named/4, - config/2, - read/2, - destroy/1, - create_tree/2, - window/2, - named_window/3, - button/2, - named_button/3, - checkbutton/2, - named_checkbutton/3, - radiobutton/2, - named_radiobutton/3, - frame/2, - named_frame/3, - canvas/2, - named_canvas/3, - label/2, - named_label/3, - message/2, - named_message/3, - listbox/2, - named_listbox/3, - entry/2, - named_entry/3, - scrollbar/2, - named_scrollbar/3, - scale/2, - named_scale/3, - editor/2, - named_editor/3, - prompter/2, - named_prompter/3, - line/2, - named_line/3, - oval/2, - named_oval/3, - rectangle/2, - named_rectangle/3, - polygon/2, - named_polygon/3, - text/2, - named_text/3, - image/2, - named_image/3, - arc/2, - named_arc/3, - menu/2, - named_menu/3, - menubutton/2, - named_menubutton/3, - menubar/2, - named_menubar/3, - menuitem/2, - named_menuitem/3, - grid/2, - named_grid/3, - gridline/2, - named_gridline/3, - %% Convenience functions - enable/1, - disable/1, - select/1, - deselect/1, - map/1, - unmap/1, - resize/3, - name_occupied/1 - - ]). - - -%% -%% gse:start() -%% Returns: -%% An identifier to a top object for the graphic system -%% -%% Errors: -%% Exits with a {?MODULE,start,Reason} if there is a problem -%% creating the top level graphic object. -%% - - -start() -> - case gs:start() of - {error,Reason} -> - exit({?MODULE, start,Reason}); - Return -> Return - end. - -%% -%% gse:start(Opts) -%% Returns: -%% An identifier to a top object for the graphic system -%% -%% Errors: -%% Exits with a {?MODULE,start,Reason} if there is a problem -%% creating the top level graphic object. -%% - - -start(Opts) -> - case gs:start(Opts) of - {error,Reason} -> - exit({?MODULE, start,Reason}); - Return -> Return - end. - -%% -%% gse:create(Objtype,Parent,Opts) replaces -%% the unnecessary functions: -%% gs:create(Obj,Parent) -%% gs:create(Obj,Parent,Opt) -%% gs:create(Obj,Parent) -%% gs:create(Obj,Parent) -%% -%% Returns: -%% An identifier for the created object -%% -%% Errors: {?MODULE, create, Reason}, where Reason is one of: -%% {no_such_parent, Parent} -%% {unknown_type, Type} -%% {incvalid_option, Type, {Option,Value}} -%% -%% -create(Objtype,Parent,Opts) when is_list(Opts) -> - case gs:create(Objtype,Parent,Opts) of - {error,Reason} -> - exit({?MODULE, create,Reason}); - Return -> Return - end. - - -%% -%% gse:create_named(Name, Objtype,Parent, Opts) replaces -%% the confusing -%% gs:create(Name,Objtype, Parent, Opts) -%% -%% Returns: -%% An identifier for the created object -%% -%% Errors: {?MODULE, create, Reason}, where Reason is one of: -%% {no_such_parent, Parent} -%% {unknown_type, Type} -%% {incvalid_option, Type, {Option,Value}} -%% {name_occupied,Name} -%% - -create_named(Name,Objtype,Parent,Opts) when is_list(Opts) -> - case gs:create(Objtype,Name,Parent,Opts) of - {error,Reason} -> - exit({?MODULE, create_named,Reason}); - Return -> Return - end. - - - -%% -%% gse:config(Object, Options) replaces -%% the unnecessary -%% gs:config(Object, Opt) -%% - -config(Object,Opts) when is_list(Opts) -> - case gs:config(Object,Opts) of - {error,Reason} -> - exit({?MODULE, config,Reason}); - Return -> Return - end. - -%% -%% gs:read(Object, OptionKey) -%% -read(Object,OptionKey) -> - case gs:read(Object,OptionKey) of - {error,Reason} -> - exit({?MODULE, read,Reason}); - Return -> Return - end. - -%% -%% gs:destroy(Object) -%% - -destroy(Object)-> - case gs:destroy(Object) of - {error,Reason} -> - exit({?MODULE, destroy,Reason}); - Return -> Return - end. - -%% -%% gs:create_tree -%% - -create_tree(Parent, Tree)-> - case gs:create_tree(Parent,Tree) of - {error,Reason} -> - exit({?MODULE, create_tree,Reason}); - Return -> Return - end. - - -window(Parent,Options) when is_list(Options) -> - case gs:window(Parent,Options) of - {error, Reason} -> - exit({?MODULE,window,Reason}); - Return -> Return - end. - -named_window(Name,Parent,Options) when is_list(Options) -> - case gs:window(Name, Parent,Options) of - {error, Reason} -> - exit({?MODULE,named_window,Reason}); - Return -> Return - end. - - -button(Parent,Options) when is_list(Options) -> - case gs:button(Parent,Options) of - {error, Reason} -> - exit({?MODULE,button,Reason}); - Return -> Return - end. - - -named_button(Name,Parent,Options) when is_list(Options) -> - case gs:button(Name, Parent,Options) of - {error, Reason} -> - exit({?MODULE,named_button,Reason}); - Return -> Return - end. - - -checkbutton(Parent,Options) when is_list(Options) -> - case gs:checkbutton(Parent,Options) of - {error, Reason} -> - exit({?MODULE,checkbutton,Reason}); - Return -> Return - end. - - -named_checkbutton(Name,Parent,Options) when is_list(Options) -> - case gs:checkbutton(Name, Parent,Options) of - {error, Reason} -> - exit({?MODULE,named_checkbutton,Reason}); - Return -> Return - end. - - -radiobutton(Parent,Options) when is_list(Options) -> - case gs:radiobutton(Parent,Options) of - {error, Reason} -> - exit({?MODULE,radiobutton,Reason}); - Return -> Return - end. - - -named_radiobutton(Name,Parent,Options) when is_list(Options) -> - case gs:radiobutton(Name, Parent,Options) of - {error, Reason} -> - exit({?MODULE,named_radiobutton,Reason}); - Return -> Return - end. - - -frame(Parent,Options) when is_list(Options) -> - case gs:frame(Parent,Options) of - {error, Reason} -> - exit({?MODULE,frame,Reason}); - Return -> Return - end. - - -named_frame(Name,Parent,Options) when is_list(Options) -> - case gs:frame(Name, Parent,Options) of - {error, Reason} -> - exit({?MODULE,named_frame,Reason}); - Return -> Return - end. - - -canvas(Parent,Options) when is_list(Options) -> - case gs:canvas(Parent,Options) of - {error, Reason} -> - exit({?MODULE,canvas,Reason}); - Return -> Return - end. - - -named_canvas(Name,Parent,Options) when is_list(Options) -> - case gs:canvas(Name, Parent,Options) of - {error, Reason} -> - exit({?MODULE,named_canvas,Reason}); - Return -> Return - end. - - -label(Parent,Options) when is_list(Options) -> - case gs:label(Parent,Options) of - {error, Reason} -> - exit({?MODULE,label,Reason}); - Return -> Return - end. - - -named_label(Name,Parent,Options) when is_list(Options) -> - case gs:label(Name, Parent,Options) of - {error, Reason} -> - exit({?MODULE,named_label,Reason}); - Return -> Return - end. - - -message(Parent,Options) when is_list(Options) -> - case gs:message(Parent,Options) of - {error, Reason} -> - exit({?MODULE,message,Reason}); - Return -> Return - end. - - -named_message(Name,Parent,Options) when is_list(Options) -> - case gs:message(Name, Parent,Options) of - {error, Reason} -> - exit({?MODULE,named_message,Reason}); - Return -> Return - end. - - -listbox(Parent,Options) when is_list(Options) -> - case gs:listbox(Parent,Options) of - {error, Reason} -> - exit({?MODULE,listbox,Reason}); - Return -> Return - end. - - -named_listbox(Name,Parent,Options) when is_list(Options) -> - case gs:listbox(Name, Parent,Options) of - {error, Reason} -> - exit({?MODULE,named_listbox,Reason}); - Return -> Return - end. - - -entry(Parent,Options) when is_list(Options) -> - case gs:entry(Parent,Options) of - {error, Reason} -> - exit({?MODULE,entry,Reason}); - Return -> Return - end. - - -named_entry(Name,Parent,Options) when is_list(Options) -> - case gs:entry(Name, Parent,Options) of - {error, Reason} -> - exit({?MODULE,named_entry,Reason}); - Return -> Return - end. - - -scrollbar(Parent,Options) when is_list(Options) -> - case gs:scrollbar(Parent,Options) of - {error, Reason} -> - exit({?MODULE,scrollbar,Reason}); - Return -> Return - end. - - -named_scrollbar(Name,Parent,Options) when is_list(Options) -> - case gs:scrollbar(Name, Parent,Options) of - {error, Reason} -> - exit({?MODULE,named_scrollbar,Reason}); - Return -> Return - end. - - -scale(Parent,Options) when is_list(Options) -> - case gs:scale(Parent,Options) of - {error, Reason} -> - exit({?MODULE,scale,Reason}); - Return -> Return - end. - - -named_scale(Name,Parent,Options) when is_list(Options) -> - case gs:scale(Name, Parent,Options) of - {error, Reason} -> - exit({?MODULE,named_scale,Reason}); - Return -> Return - end. - - -editor(Parent,Options) when is_list(Options) -> - case gs:editor(Parent,Options) of - {error, Reason} -> - exit({?MODULE,editor,Reason}); - Return -> Return - end. - - -named_editor(Name,Parent,Options) when is_list(Options) -> - case gs:editor(Name, Parent,Options) of - {error, Reason} -> - exit({?MODULE,named_editor,Reason}); - Return -> Return - end. - - -prompter(Parent,Options) when is_list(Options) -> - case gs:prompter(Parent,Options) of - {error, Reason} -> - exit({?MODULE,prompter,Reason}); - Return -> Return - end. - - -named_prompter(Name,Parent,Options) when is_list(Options) -> - case gs:prompter(Name, Parent,Options) of - {error, Reason} -> - exit({?MODULE,named_prompter,Reason}); - Return -> Return - end. - - -line(Parent,Options) when is_list(Options) -> - case gs:line(Parent,Options) of - {error, Reason} -> - exit({?MODULE,line,Reason}); - Return -> Return - end. - - -named_line(Name,Parent,Options) when is_list(Options) -> - case gs:line(Name, Parent,Options) of - {error, Reason} -> - exit({?MODULE,named_line,Reason}); - Return -> Return - end. - - -oval(Parent,Options) when is_list(Options) -> - case gs:oval(Parent,Options) of - {error, Reason} -> - exit({?MODULE,oval,Reason}); - Return -> Return - end. - - -named_oval(Name,Parent,Options) when is_list(Options) -> - case gs:oval(Name, Parent,Options) of - {error, Reason} -> - exit({?MODULE,named_oval,Reason}); - Return -> Return - end. - - -rectangle(Parent,Options) when is_list(Options) -> - case gs:rectangle(Parent,Options) of - {error, Reason} -> - exit({?MODULE,rectangle,Reason}); - Return -> Return - end. - - -named_rectangle(Name,Parent,Options) when is_list(Options) -> - case gs:rectangle(Name, Parent,Options) of - {error, Reason} -> - exit({?MODULE,named_rectangle,Reason}); - Return -> Return - end. - - -polygon(Parent,Options) when is_list(Options) -> - case gs:polygon(Parent,Options) of - {error, Reason} -> - exit({?MODULE,polygon,Reason}); - Return -> Return - end. - - -named_polygon(Name,Parent,Options) when is_list(Options) -> - case gs:polygon(Name, Parent,Options) of - {error, Reason} -> - exit({?MODULE,named_polygon,Reason}); - Return -> Return - end. - - -text(Parent,Options) when is_list(Options) -> - case gs:text(Parent,Options) of - {error, Reason} -> - exit({?MODULE,text,Reason}); - Return -> Return - end. - - -named_text(Name,Parent,Options) when is_list(Options) -> - case gs:text(Name, Parent,Options) of - {error, Reason} -> - exit({?MODULE,named_text,Reason}); - Return -> Return - end. - - -image(Parent,Options) when is_list(Options) -> - case gs:image(Parent,Options) of - {error, Reason} -> - exit({?MODULE,image,Reason}); - Return -> Return - end. - - -named_image(Name,Parent,Options) when is_list(Options) -> - case gs:image(Name, Parent,Options) of - {error, Reason} -> - exit({?MODULE,named_image,Reason}); - Return -> Return - end. - - -arc(Parent,Options) when is_list(Options) -> - case gs:arc(Parent,Options) of - {error, Reason} -> - exit({?MODULE,arc,Reason}); - Return -> Return - end. - - -named_arc(Name,Parent,Options) when is_list(Options) -> - case gs:arc(Name, Parent,Options) of - {error, Reason} -> - exit({?MODULE,named_arc,Reason}); - Return -> Return - end. - - -menu(Parent,Options) when is_list(Options) -> - case gs:menu(Parent,Options) of - {error, Reason} -> - exit({?MODULE,menu,Reason}); - Return -> Return - end. - - -named_menu(Name,Parent,Options) when is_list(Options) -> - case gs:menu(Name, Parent,Options) of - {error, Reason} -> - exit({?MODULE,named_menu,Reason}); - Return -> Return - end. - - -menubutton(Parent,Options) when is_list(Options) -> - case gs:menubutton(Parent,Options) of - {error, Reason} -> - exit({?MODULE,menubutton,Reason}); - Return -> Return - end. - - -named_menubutton(Name,Parent,Options) when is_list(Options) -> - case gs:menubutton(Name, Parent,Options) of - {error, Reason} -> - exit({?MODULE,named_menubutton,Reason}); - Return -> Return - end. - - -menubar(Parent,Options) when is_list(Options) -> - case gs:menubar(Parent,Options) of - {error, Reason} -> - exit({?MODULE,menubar,Reason}); - Return -> Return - end. - - -named_menubar(Name,Parent,Options) when is_list(Options) -> - case gs:menubar(Name, Parent,Options) of - {error, Reason} -> - exit({?MODULE,named_menubar,Reason}); - Return -> Return - end. - - -menuitem(Parent,Options) when is_list(Options) -> - case gs:menuitem(Parent,Options) of - {error, Reason} -> - exit({?MODULE,menuitem,Reason}); - Return -> Return - end. - - -named_menuitem(Name,Parent,Options) when is_list(Options) -> - case gs:menuitem(Name, Parent,Options) of - {error, Reason} -> - exit({?MODULE,named_menuitem,Reason}); - Return -> Return - end. - - -grid(Parent,Options) when is_list(Options) -> - case gs:grid(Parent,Options) of - {error, Reason} -> - exit({?MODULE,grid,Reason}); - Return -> Return - end. - - -named_grid(Name,Parent,Options) when is_list(Options) -> - case gs:grid(Name, Parent,Options) of - {error, Reason} -> - exit({?MODULE,named_grid,Reason}); - Return -> Return - end. - - -gridline(Parent,Options) when is_list(Options) -> - case gs:gridline(Parent,Options) of - {error, Reason} -> - exit({?MODULE,gridline,Reason}); - Return -> Return - end. - - -named_gridline(Name,Parent,Options) when is_list(Options) -> - case gs:gridline(Name, Parent,Options) of - {error, Reason} -> - exit({?MODULE,named_gridline,Reason}); - Return -> Return - end. - - - -%% gs:config - Utility functions - - -%% -%% enable/disable -%% - -enable(Object) -> - gse:config(Object,[{enable,true}]). - -disable(Object) -> - gse:config(Object,[{enable,false}]). - - - -%% -%% select/deselect -%% - -deselect(Object) -> - gse:config(Object,[{select,false}]). - -select(Object) -> - gse:config(Object,[{select,true}]). - - -%% -%% map/unmap -%% - -map(Object) -> - gse:config(Object,[{map,true}]). - -unmap(Object) -> - gse:config(Object,[{map,false}]). - - - -%% -%% resize -%% - -resize(Object, Width, Height) -> - gse:config(Object,[{width,Width}, {height, Height}]). - - - -%% -%% Misc utility functions -%% - -name_occupied(Name) -> - case gs:read(Name,id) of - {error,_Reason} -> - false; - _Id -> true - end. - - diff --git a/lib/gs/src/gstk.erl b/lib/gs/src/gstk.erl deleted file mode 100644 index 3119245db7..0000000000 --- a/lib/gs/src/gstk.erl +++ /dev/null @@ -1,389 +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% -%% - -%% - --module(gstk). --compile([{nowarn_deprecated_function,{gs,assq,2}}, - {nowarn_deprecated_function,{gs,creation_error,2}}]). - --export([start_link/4, - stop/1, - create/2, - config/2, - read/2, - destroy/2, - pid_died/2, - event/2, - request/2, - init/1, - create_impl/2, - config_impl/3, - read_impl/3, - destroy_impl/2, - worker_init/1, - worker_do/1, - make_extern_id/2, - to_color/1, - to_ascii/1, - exec/1, - call/1]). - --include("gstk.hrl"). - -start_link(GsId,FrontendNode,Owner,Options) -> - case gs:assq(node,Options) of - false -> - Gstk = spawn_link(gstk, init,[{GsId, FrontendNode, Owner, Options}]), - receive - {ok, _PortHandler} -> - {ok, Gstk}; - {error, Reason} -> - {error, Reason} - end; - {value, Node} -> - rpc:call(Node,gen_server,start_link,[gstk, {Owner,Options},[]]) - end. - -stop(BackendServ) -> - request(BackendServ,stop). - -create(BackendServ,Args) -> - request(BackendServ,{create,Args}). - -config(BackendServ,Args) -> - request(BackendServ,{config,Args}). - -read(BackendServ,Args) -> - request(BackendServ,{read,Args}). - -destroy(BackendServ,Args) -> - request(BackendServ,{destroy,Args}). - -pid_died(BackendServ,Pid) -> - request(BackendServ,{pid_died,Pid}). - -call(Cmd) -> - %%io:format("Call:~p~n",[Cmd]), - gstk_port_handler:call(get(port_handler),Cmd). - -exec(Cmd) -> - gstk_port_handler:exec(Cmd). - -make_extern_id(IntId, DB) -> - [{_,Node}] = ets:lookup(DB,frontend_node), - {IntId,Node}. - -event(BackendServ,Event) -> - BackendServ!{event,Event}. - -%% ----------------------------------------------------------------------------- - -request(Who,Msg) -> - Who ! {self(),Msg}, - receive - {gstk_reply,R} -> R; - {'EXIT',Who,Reason} -> - self() ! {'EXIT',Who,Reason}, - {error,Reason} - end. - - --record(state,{db,frontendnode,port_handler}). - -%% ------------------------------------------------------------ -%% Initialize -%% -init({GsId,FrontendNode,Owner,Opts}) -> - put(gs_frontend,Owner), - case gstk_port_handler:start_link(self()) of - {error, Reason} -> - FrontendNode ! {error, Reason}, - exit(normal); - {ok, PortHandler} -> - FrontendNode ! {ok, PortHandler}, - put(port_handler,PortHandler), - {ok,Port} = gstk_port_handler:ping(PortHandler), - put(port,Port), - exec("wm withdraw ."), - DB = gstk_db:init(Opts), - ets:insert(DB,{frontend_node,FrontendNode}), - put(worker,spawn_link(gstk,worker_init,[0])), - Gstkid = #gstkid{id=GsId,widget="",owner=Owner,objtype=gs}, - gstk_db:insert_gs(DB,Gstkid), - gstk_font:init(), - loop(#state{db=DB,frontendnode=FrontendNode}) - end. - -loop(State) -> - receive - X -> - case (doit(X,State)) of - done -> loop(State); - stop -> bye - end - end. - -reply(To,Msg) -> - To ! {gstk_reply,Msg}, - done. - -doit({From,{config, {Id, Opts}}},#state{db=DB}) -> - reply(From,config_impl(DB,Id,Opts)); -doit({From,{create, Args}}, #state{db=DB}) -> - reply(From,create_impl(DB,Args)); -doit({From,{read,{Id,Opt}}},#state{db=DB}) -> - reply(From,read_impl(DB,Id,Opt)); -doit({From,{pid_died, Pid}}, #state{db=DB}) -> - pid_died_impl(DB, Pid), - reply(From,gstk_db:get_deleted(DB)); -doit({From,{destroy, Id}}, #state{db=DB}) -> - destroy_impl(DB, gstk_db:lookup_gstkid(DB,Id)), - reply(From,gstk_db:get_deleted(DB)); - -doit({From,dump_db},State) -> - io:format("gstk_db:~p~n",[lists:sort(ets:tab2list(State#state.db))]), - io:format("events:~p~n",[lists:sort(ets:tab2list(get(events)))]), - io:format("options:~p~n",[lists:sort(ets:tab2list(get(options)))]), - io:format("defaults:~p~n",[lists:sort(ets:tab2list(get(defaults)))]), - io:format("kids:~p~n",[lists:sort(ets:tab2list(get(kids)))]), - reply(From,State); - -doit({From,stop},_State) -> - gstk_port_handler:stop(get(port_handler)), - exit(get(worker),kill), - reply(From,stopped), - stop; - -doit({event,{Id, Etag, Args}},#state{db=DB}) -> - case gstk_db:lookup_event(DB, Id, Etag) of - {Etype, Edata} -> - Gstkid = gstk_db:lookup_gstkid(DB, Id), - apply(gstk_widgets:objmod(Gstkid),event,[DB,Gstkid,Etype,Edata,Args]); - _ -> true - end, - done. - - -%%---------------------------------------------------------------------- -%% Implementation of create,config,read,destroy -%% Comment: In the gstk process there is not concept call 'name', only -%% pure oids. Names are stripped of by 'gs' and this simplifies -%% gstk a lot. -%% Comment: For performance reasons gstk.erl ans gs.erl communicats through -%% tuples. This is unfortunate but we don't want to pack the same -%% thing too many times. -%% Pre (for all functions): GS guarantees that the object (and parent if -%% necessary) exists. -%%---------------------------------------------------------------------- - - -create_impl(DB, {Owner, {Objtype, Id, Parent, Opts}}) -> - Pgstkid = gstk_db:lookup_gstkid(DB, Parent), - GstkId=#gstkid{id=Id,owner=Owner,parent=Parent,objtype=Objtype}, - gstk_db:insert_opt(DB,Id,{data,[]}), - RealOpts=apply(gstk_widgets:objmod(Pgstkid), - mk_create_opts_for_child,[DB,GstkId,Pgstkid,Opts]), - case gstk_widgets:type2mod(Objtype) of - {error,Reason} -> {error,Reason}; - ObjMod -> - case apply(ObjMod, create, [DB, GstkId, RealOpts]) of - {bad_result, BR} -> - gstk_db:delete_gstkid(DB,GstkId), - gs:creation_error(GstkId,{bad_result, BR}); - Ngstkid when is_record(Ngstkid,gstkid) -> - gstk_db:insert_widget(DB, Ngstkid), - ok; - {error,Reason} -> {error,Reason}; - ok -> ok - end - end. - -config_impl(DB,Id,Opts) -> - Gstkid = gstk_db:lookup_gstkid(DB, Id), - case apply(gstk_widgets:objmod(Gstkid), config, [DB, Gstkid, Opts]) of - ok -> ok; - {bad_result,R} -> {error,R}; - {error,Reason} -> {error,Reason}; - Q -> {error,Q} - end. - - -read_impl(DB,Id,Opt) -> - Gstkid = gstk_db:lookup_gstkid(DB, Id), - case apply(gstk_widgets:objmod(Gstkid), read, [DB, Gstkid, Opt]) of - {bad_result,R} -> {error,R}; - {error,R} -> {error,R}; - Res -> Res - end. - - - -%%----------------------------------------------------------------------------- -%% DESTROYING A WIDGET -%%----------------------------------------------------------------------------- - -destroy_impl(DB, Gstkid) -> - worker_do({delay_is,50}), - Widget = delete_only_this_widget(DB,Gstkid), - destroy_widgets([Widget], DB), - worker_do({delay_is,5}), - true. - -delete_only_this_widget(DB,Gstkid) -> - #gstkid{id=ID,objtype=OT,parent=P} = Gstkid, - delete_widgets(gstk_db:lookup_kids(DB, ID), DB), - Widget = apply(gstk_widgets:type2mod(OT), delete, [DB, Gstkid]), - gstk_db:delete_kid(DB, P, ID), - Widget. - - -pid_died_impl(DB, Pid) -> - case lists:sort(gstk_db:lookup_ids(DB, Pid)) of - [ID | IDs] -> - Gstkid = gstk_db:lookup_gstkid(DB, ID), - destroy_impl(DB, Gstkid), - Tops = get_tops(IDs, DB), - destroy_widgets(Tops, DB); - _ -> - true - end. - - -get_tops([ID | IDs], DB) -> - case gstk_db:lookup_gstkid(DB, ID) of - undefined -> - get_tops(IDs, DB); - Gstkid -> - Parent = Gstkid#gstkid.parent, - case lists:member(Parent, IDs) of - true -> - delete_widgets([ID], DB), - get_tops(IDs, DB); - false -> - Widget = delete_only_this_widget(DB,Gstkid), - [Widget | get_tops(IDs, DB)] - end - end; -get_tops([], _DB) -> []. - - -delete_widgets([ID | Rest], DB) -> - delete_widgets(gstk_db:lookup_kids(DB, ID), DB), - case gstk_db:lookup_gstkid(DB, ID) of - undefined -> - delete_widgets(Rest, DB); - Gstkid -> - apply(gstk_widgets:objmod(Gstkid), delete, [DB, Gstkid]), - delete_widgets(Rest, DB) - end; -delete_widgets([], _) -> true. - - - -destroy_widgets(Widgets, DB) -> - case destroy_wids(Widgets, DB) of - [] -> true; - Destroys -> exec(["destroy ", Destroys]) - end. - - -destroy_wids([{Parent, ID, Objmod, Args} | Rest], DB) -> - gstk_db:delete_kid(DB, Parent, ID), - apply(Objmod, destroy, [DB | Args]), - destroy_wids(Rest, DB); - -destroy_wids([W | Rest], DB) -> - [W, " "| destroy_wids(Rest, DB)]; - -destroy_wids([], _DB) -> []. - - -%% ----- The Color Model ----- - -to_color({R,G,B}) -> - [$#,dec2hex(2,R),dec2hex(2,G),dec2hex(2,B)]; -to_color(Color) when is_atom(Color) -> atom_to_list(Color). - -%% ------------------------------------------------------------ -%% Decimal to Hex converter -%% M is number of digits we want -%% N is the decimal to be converted - -dec2hex(M,N) -> dec2hex(M,N,[]). - -dec2hex(0,_N,Ack) -> Ack; -dec2hex(M,N,Ack) -> dec2hex(M-1,N bsr 4,[d2h(N band 15)|Ack]). - -d2h(N) when N<10 -> N+$0; -d2h(N) -> N+$a-10. - - -%% ----- Value to String ----- - -to_ascii(V) when is_list(V) -> [$",to_ascii(V,[],[]),$"]; %% it's a string -to_ascii(V) when is_integer(V) -> integer_to_list(V); -to_ascii(V) when is_float(V) -> float_to_list(V); -to_ascii(V) when is_atom(V) -> to_ascii( atom_to_list(V)); -to_ascii(V) when is_tuple(V) -> to_ascii(lists:flatten(io_lib:format("~w",[V]))); -to_ascii(V) when is_pid(V) -> pid_to_list(V). - - % FIXME: Currently we accept newlines in strings and handle this at - % the Tcl side. Is this the best way or should we translate to "\n" - % here? -to_ascii([$[|R], Y, X) -> to_ascii(R, Y, [$[, $\\ | X]); - to_ascii([$]|R], Y, X) -> to_ascii(R, Y, [$], $\\ | X]); -to_ascii([${|R], Y, X) -> to_ascii(R, Y, [${, $\\ | X]); - to_ascii([$}|R], Y, X) -> to_ascii(R, Y, [$}, $\\ | X]); -to_ascii([$"|R], Y, X) -> to_ascii(R, Y, [$", $\\ | X]); -to_ascii([$$|R], Y, X) -> to_ascii(R, Y, [$$, $\\ | X]); -to_ascii([$\\|R], Y, X) -> to_ascii(R, Y, [$\\, $\\ | X]); -to_ascii([C|R], Y, X) when is_list(C) -> to_ascii(C, [R|Y], X); -to_ascii([C|R], Y, X) -> to_ascii(R, Y, [C|X]); -to_ascii([], [Y1|Y], X) -> to_ascii(Y1, Y, X); -to_ascii([], [], X) -> lists:reverse(X). - -worker_do(Msg) -> - get(worker) ! Msg. - -worker_init(Delay) -> - receive - {delay_is,D} -> - worker_init(D); - {match_delete,DBExprs} -> - worker_match(DBExprs), - if Delay > 0 -> - receive - {delay_is,D} -> - worker_init(D) - after Delay -> - worker_init(Delay) - end; - true -> - worker_init(Delay) - end - end. - -worker_match([{DB,[Expr|Exprs]}|DbExprs]) -> - ets:match_delete(DB,Expr), - worker_match([{DB,Exprs}|DbExprs]); -worker_match([{_DB,[]}|DbExprs]) -> - worker_match(DbExprs); -worker_match([]) -> done. diff --git a/lib/gs/src/gstk.hrl b/lib/gs/src/gstk.hrl deleted file mode 100644 index 931057573f..0000000000 --- a/lib/gs/src/gstk.hrl +++ /dev/null @@ -1,29 +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% -%% - -%% - -%% *NOTE*: if you change here, change ets:match in gstk_db too! --record(gstkid, {id=undefined, widget, widget_data, owner, parent, - objtype}). - --record(so, {main, object, hscroll, vscroll, misc}). - - diff --git a/lib/gs/src/gstk_arc.erl b/lib/gs/src/gstk_arc.erl deleted file mode 100644 index c38bbf4756..0000000000 --- a/lib/gs/src/gstk_arc.erl +++ /dev/null @@ -1,192 +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 Arc Type -%% ------------------------------------------------------------ - --module(gstk_arc). --compile([{nowarn_deprecated_function,{gs,creation_error,2}}]). - -%%----------------------------------------------------------------------------- -%% ARC OPTIONS -%% -%% Attributes: -%% bw Int -%% coords [{X1,Y1}, {X2,Y2}] -%% data Data -%% extent Degrees -%% fg Color -%% fill Color -%% start Degrees -%% stipple Bool -%% style pieslice, chord, arc -%% -%% Commands: -%% lower -%% move {Dx, Dy} -%% raise -%% scale {Xo, Yo, Sx, Sy} -%% setfocus Bool -%% -%% Events: -%% buttonpress [Bool | {Bool, Data}] -%% buttonrelease [Bool | {Bool, Data}] -%% enter [Bool | {Bool, Data}] -%% keypress [Bool | {Bool, Data}] -%% keyrelease [Bool | {Bool, Data}] -%% leave [Bool | {Bool, Data}] -%% motion [Bool | {Bool, Data}] -%% -%% Read Options: -%% children -%% id -%% parent -%% type -%% - --export([create/3, config/3, read/3, delete/2, destroy/3, event/5, - option/5,read_option/5]). - --include("gstk.hrl"). - -%%----------------------------------------------------------------------------- -%% MANDATORY INTERFACE FUNCTIONS -%%----------------------------------------------------------------------------- -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : create/7 -%% Purpose : Create a widget of the type defined in this module. -%% Args : DB - The Database -%% Objmod - An atom, this module -%% Objtype - An atom, the logical widget type -%% Owner - Pid of the creator -%% Name - An atom naming the widget -%% Parent - Gsid of the parent -%% Opts - A list of options for configuring the widget -%% -%% Return : [Gsid_of_new_widget | {bad_result, Reason}] -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -create(DB, GstkId, Opts) -> - case gstk_canvas:pickout_coords(Opts, [],GstkId#gstkid.objtype,2) of - {error, Error} -> - gs:creation_error(GstkId,Error); - {Coords, NewOpts} -> - Ngstkid=gstk_canvas:upd_gstkid(DB, GstkId, Opts), - #gstkid{widget=CanvasTkW}=Ngstkid, - MCmd = [CanvasTkW, " create ar ", Coords], - gstk_canvas:mk_cmd_and_call(NewOpts,Ngstkid,CanvasTkW,MCmd,DB) - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% 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) -> - gstk_canvas:item_config(DB, Gstkid, Opts). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% 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) -> - Item = Gstkid#gstkid.widget_data, - gstk_generic:read_option(DB,Gstkid,Opt,[gstk:to_ascii(Item)]). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% 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 | {Parent, Objmod, Args}. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -delete(DB, Gstkid) -> - gstk_canvas:item_delete_impl(DB,Gstkid). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : destroy/3 -%% Purpose : Destroy a widget -%% Args : DB - The Database -%% Canvas - The canvas tk widget -%% Item - The item number to destroy -%% -%% Return : [true | {bad_result, Reason}] -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -destroy(_DB, Canvas, Item) -> - gstk:exec([Canvas, " delete ", gstk:to_ascii(Item)]). - - -event(DB, Gstkid, Etype, Edata, Args) -> - gstk_generic:event(DB, Gstkid, Etype, Edata, Args). - -%%------------------------------------------------------------------------------ -%% MANDATORY FUNCTIONS -%%------------------------------------------------------------------------------ -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : option/5 -%% Purpose : Take care of options -%% Args : MainW - The main tk-widget -%% Canvas - The canvas tk-widget -%% Return : A tuple {OptionType, OptionCmd} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -option(Option, _Gstkid, _Canvas, _DB, _AItem) -> - case Option of - {bw, Int} -> {s, [" -w ", gstk:to_ascii(Int)]}; - {extent, Degrees} -> {s, [" -e ", gstk:to_ascii(Degrees)]}; - {fg, Color} -> {s, [" -outline ", gstk:to_color(Color)]}; - {start, Degrees} -> {s, [" -start ", gstk:to_ascii(Degrees)]}; - {style, Style} -> {s, [" -sty ", gstk:to_ascii(Style)]}; - _ -> invalid_option - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : read_option/5 -%% Purpose : Take care of a read option -%% Return : The value of the option or invalid_option -%% [OptionValue | {bad_result, Reason}] -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -read_option(Option, Gstkid, Canvas, _DB, AItem) -> - case Option of - bw -> tcl2erl:ret_int([Canvas, " itemcg ", AItem, " -w"]); - extent -> tcl2erl:ret_int([Canvas, " itemcg ", AItem, " -e"]); - fg -> tcl2erl:ret_color([Canvas, " itemcg ", AItem, " -outline"]); - start -> tcl2erl:ret_int([Canvas, " itemcg ", AItem, " -start"]); - stipple -> tcl2erl:ret_stipple([Canvas, " itemcg ", AItem, " -sti"]); - style -> tcl2erl:ret_atom([Canvas, " itemcg ", AItem, " -sty"]); - - _ -> {bad_result, {Gstkid#gstkid.objtype, invalid_option, Option}} - end. - -%% ----- Done ----- diff --git a/lib/gs/src/gstk_button.erl b/lib/gs/src/gstk_button.erl deleted file mode 100644 index 2b466c30c3..0000000000 --- a/lib/gs/src/gstk_button.erl +++ /dev/null @@ -1,221 +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 Button Type -%% ------------------------------------------------------------ - --module(gstk_button). - -%%------------------------------------------------------------------------------ -%% BUTTON OPTIONS -%% -%% Attributes: -%% activebg Color -%% activefg Color -%% align n,w,s,e,nw,se,ne,sw,center -%% anchor n,w,s,e,nw,se,ne,sw,center -%% bg Color -%% bw Int -%% data Data -%% disabledfg Color -%% fg Color -%% font Font -%% height Int -%% highlightbg Color -%% highlightbw Int -%% highlightfg Color -%% justify left|right|center -%% label {text, String} | {image, BitmapFile} -%% padx Int (Pixels) -%% pady Int (Pixels) -%% relief Relief [flat|raised|sunken|ridge|groove] -%% underline Int -%% width Int -%% wraplength Int -%% x Int -%% y Int -%% -%% Commands: -%% enable Bool -%% flash -%% invoke -%% setfocus Bool -%% -%% Events: -%% buttonpress [Bool | {Bool, Data}] -%% buttonrelease [Bool | {Bool, Data}] -%% click [Bool | {Bool, Data}] -%% configure [Bool | {Bool, Data}] -%% destroy [Bool | {Bool, Data}] -%% enter [Bool | {Bool, Data}] -%% focus [Bool | {Bool, Data}] -%% keypress [Bool | {Bool, Data}] -%% keyrelease [Bool | {Bool, Data}] -%% leave [Bool | {Bool, Data}] -%% motion [Bool | {Bool, Data}] -%% -%% Read Options: -%% children -%% id -%% parent -%% type -%% -%% Not Implemented: -%% cursor ?????? -%% font ?????? -%% - --export([create/3,config/3,read/3,delete/2,event/5,option/5,read_option/5]). - --include("gstk.hrl"). - -%%--------------------------------------------------------------------------- -%% MANDATORY INTERFACE FUNCTIONS -%%--------------------------------------------------------------------------- -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : create/3 -%% Purpose : Create a widget of the type defined in this module. -%% Return : [Gsid_of_new_widget | {bad_result, Reason}] -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -create(DB, GstkId, Opts) -> - TkW = gstk_generic:mk_tkw_child(DB,GstkId), - NGstkId=GstkId#gstkid{widget=TkW}, - PlacePreCmd = [";place ", TkW], - case gstk_generic:make_command(Opts,NGstkId,TkW,"",PlacePreCmd,DB) of - {error,Reason} -> {error,Reason}; - Cmd when is_list(Cmd) -> - gstk:exec(["button ", TkW," -rel raised -bo 2 ",Cmd]), - NGstkId - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% 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(Opts,Gstkid,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. - -event(DB, Gstkid, Etype, Edata, Args) -> - gstk_generic:event(DB, Gstkid, Etype, Edata, Args). - -%%------------------------------------------------------------------------------ -%% 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} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -option(Option, Gstkid, TkW, DB,_) -> - case Option of - {bitmap, Bitmap} -> {s, [" -bi @", Bitmap]}; - {disabledfg, Color} -> {s, [" -disabledf ", gstk:to_color(Color)]}; - {underline, Int} -> {s, [" -un ", gstk:to_ascii(Int)]}; - {wraplength, Int} -> {s, [" -wr ", gstk:to_ascii(Int)]}; - invoke -> {c, [TkW, " i;"]}; - flash -> {c, [TkW, " f;"]}; - {click, On} -> cbind(DB, Gstkid, click, On); - _ -> invalid_option - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : read_option/4 -%% 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 - disabledfg -> tcl2erl:ret_color([TkW, " cg -disabledf"]); - underline -> tcl2erl:ret_int([TkW, " cg -un"]); - wraplength -> tcl2erl:ret_int([TkW, " cg -wr"]); - - click -> gstk_db:is_inserted(DB, Gstkid, click); - - _ -> {bad_result, {Gstkid#gstkid.objtype, invalid_option, Option}} - end. - -%%------------------------------------------------------------------------------ -%% PRIMITIVES -%%------------------------------------------------------------------------------ - -%% -%% Config bind -%% -cbind(DB, Gstkid, Etype, On) -> - TkW = Gstkid#gstkid.widget, - Cmd = case On of - {true, Edata} -> - Eref = gstk_db:insert_event(DB, Gstkid, Etype, Edata), - [" -command {erlsend ", Eref, " \\\"[", TkW, " cg -text]\\\"}"]; - true -> - Eref = gstk_db:insert_event(DB, Gstkid, Etype, ""), - [" -command {erlsend ", Eref, " \\\"[", TkW, " cg -text]\\\"}"]; - _Other -> - gstk_db:delete_event(DB, Gstkid, Etype), - " -command {}" - end, - {s, Cmd}. - -%% ----- Done ----- - diff --git a/lib/gs/src/gstk_canvas.erl b/lib/gs/src/gstk_canvas.erl deleted file mode 100644 index 102b81df7a..0000000000 --- a/lib/gs/src/gstk_canvas.erl +++ /dev/null @@ -1,516 +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 Canvas Type -%% ------------------------------------------------------------ - --module(gstk_canvas). --compile([{nowarn_deprecated_function,{gs,pair,2}}, - {nowarn_deprecated_function,{gs,val,2}}]). - -%%----------------------------------------------------------------------------- -%% CANVAS OPTIONS -%% -%% Attributes: -%% activebg Color -%% anchor n,w,s,e,nw,se,ne,sw,center -%% bc Color -%% bg Color -%% bw Wth -%% data Data -%% height Int -%% highlightbg Color -%% highlightbw Wth -%% highlightfg Color -%% hscroll Bool | top | bottom -%% relief Relief -%% scrollbg Color -%% scrollfg Color -%% scrollregion {X1, Y1, X2, Y2} -%% selectbg Color -%% selectbw Width -%% selectfg Color -%% vscroll Bool | left | right -%% width Int -%% x Int -%% y Int -%% -%% -%% Commands: -%% find {X, Y} => Item at pos X,Y or false -%% setfocus Bool -%% -%% Events: -%% buttonpress [Bool | {Bool, Data}] -%% buttonrelease [Bool | {Bool, Data}] -%% configure [Bool | {Bool, Data}] -%% destroy [Bool | {Bool, Data}] -%% enter [Bool | {Bool, Data}] -%% focus [Bool | {Bool, Data}] -%% keypress [Bool | {Bool, Data}] -%% keyrelease [Bool | {Bool, Data}] -%% leave [Bool | {Bool, Data}] -%% motion [Bool | {Bool, Data}] -%% -%% Read Options: -%% children -%% id -%% parent -%% type -%% -%% Not Implemented: -%% fg Color -%% - --export([create/3,config/3,read/3,delete/2,event/5,option/5,read_option/5]). --export([make_command/5,make_command/6,pickout_coords/4, coords/1, - item_config/3,mk_create_opts_for_child/4, - upd_gstkid/3,item_delete_impl/2,mk_cmd_and_exec/6,mk_cmd_and_call/5]). - --include("gstk.hrl"). - -%%----------------------------------------------------------------------------- -%% MANDATORY INTERFACE FUNCTIONS -%%----------------------------------------------------------------------------- -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : create/3 -%% Return : [Gsid_of_new_widget | {bad_result, Reason}] -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -create(DB, Gstkid, Opts) -> - MainW = gstk_generic:mk_tkw_child(DB,Gstkid), - Canvas = lists:append(MainW,".z"), - {Vscroll, Hscroll, NewOpts} = gstk_generic:parse_scrolls(Opts), - WidgetD = #so{main=MainW, object=Canvas, - hscroll=Hscroll, vscroll=Vscroll}, - NGstkid=Gstkid#gstkid{widget=MainW, widget_data=WidgetD}, - MandatoryCmd = ["so_create canvas ", MainW], - case gstk:call(MandatoryCmd) of - {result, _} -> - SimplePreCmd = [MainW, " conf"], - PlacePreCmd = [";place ", MainW], - gstk_db:insert_opt(DB,Gstkid,gs:pair(scrollregion,Opts)), - case gstk_generic:make_command(NewOpts, NGstkid, MainW, - SimplePreCmd, PlacePreCmd, DB,Canvas) of - {error,Reason} -> {error,Reason}; - Cmd when is_list(Cmd) -> - gstk:exec(Cmd), - gstk:exec([MainW,".sy conf -rel sunken -bo 2;", - MainW,".pad.sx conf -rel sunken -bo 2;"]), - NGstkid - end; - Bad_Result -> - {bad_result, Bad_Result} - 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, Options) -> - SO = Gstkid#gstkid.widget_data, - MainW = Gstkid#gstkid.widget, - Canvas = SO#so.object, - NewOpts = gstk_generic:parse_scrolls(Gstkid, Options), - SimplePreCmd = [MainW, " conf"], - PlacePreCmd = [";place ", MainW], - gstk_generic:mk_cmd_and_exec(NewOpts, Gstkid, MainW, - SimplePreCmd, PlacePreCmd, DB,Canvas). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% 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) -> - SO = Gstkid#gstkid.widget_data, - gstk_generic:read_option(DB, Gstkid, Opt,SO#so.object). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% 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. - -event(DB, Gstkid, Etype, Edata, Args) -> - gstk_generic:event(DB, Gstkid, Etype, Edata, Args). - - -%%----------------------------------------------------------------------------- -%% MANDATORY FUNCTIONS -%%----------------------------------------------------------------------------- -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : option/5 -%% Purpose : Take care of options -%% Args : Option - An option tuple -%% Gstkid - The gstkid of the widget -%% MainW - The main tk-widget -%% Canvas - The canvas tk-widget -%% DB - The Database -%% -%% Return : A tuple {OptionType, OptionCmd} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -option(Option,Gstkid,_MainW,DB,Canvas) -> - case Option of - {scrollregion, {X1, Y1, X2, Y2}} -> - gstk_db:insert_opt(DB,Gstkid,Option), - {c, [Canvas, " conf -scrollr {", - gstk:to_ascii(X1), " ", gstk:to_ascii(Y1), " ", - gstk:to_ascii(X2), " ", gstk:to_ascii(Y2),"}"]}; - {yscrollpos, Y} -> - {_,Ymin,_,Ymax} = gstk_db:opt(DB,Gstkid,scrollregion), - K = 1/(Ymax-Ymin), - M = -K*Ymin, - PercentOffViewTop = K*Y+M, - {c, [Canvas," yvi mo ",gstk:to_ascii(PercentOffViewTop)]}; - {xscrollpos, X} -> - {Xmin,_,Xmax,_} = gstk_db:opt(DB,Gstkid,scrollregion), - K = 1/(Xmax-Xmin), - M = -K*Xmin, - PercentOffViewLeft = K*X+M, - {c, [Canvas," xvi mo ",gstk:to_ascii(PercentOffViewLeft)]}; - {buttonpress, On} -> bind(DB, Gstkid, Canvas, buttonpress, On); - {buttonrelease, On} -> bind(DB, Gstkid, Canvas, buttonrelease, On); - {configure, On} -> bind(DB, Gstkid, Canvas, configure, On); - {destroy, On} -> bind(DB, Gstkid, Canvas, destroy, On); - {enter, On} -> bind(DB, Gstkid, Canvas, enter, On); - {focus, On} -> bind(DB, Gstkid, Canvas, focus, On); - {keypress, On} -> bind(DB, Gstkid, Canvas, keypress, On); - {keyrelease, On} -> bind(DB, Gstkid, Canvas, keyrelease, On); - {leave, On} -> bind(DB, Gstkid, Canvas, leave, On); - {motion, On} -> bind(DB, Gstkid, Canvas, motion, On); - - {secret_hack_gridit, GridGstkid} -> - CRef = gstk_db:insert_event(DB, GridGstkid, click, []), - ClickCmd = [Canvas, " bind all {erlsend ", CRef, - " [",Canvas, " find withtag current]};"], - DRef = gstk_db:insert_event(DB, GridGstkid, doubleclick, []), - DclickCmd = [Canvas," bind all {erlsend ", - DRef," [",Canvas, " find withtag current]}"], - %% bind all at once for preformance reasons. - {c, [ClickCmd,DclickCmd]}; - {secret_forwarded_grid_event, {Event,On},GridGstkid} -> - bind(DB,GridGstkid,Canvas,Event,On); - _ -> invalid_option - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : read_option/5 -%% Purpose : Take care of a read option -%% Return : The value of the option or invalid_option -%% [OptionValue | {bad_result, Reason}] -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -read_option(Option,Gstkid,_MainW,DB,Canvas) -> - case Option of - scrollregion -> gstk_db:opt(DB,Gstkid,scrollregion); - {hit, {X,Y}} -> - hit(DB,Canvas,X,Y,X,Y); - {hit, [{X1,Y1},{X2,Y2}]} -> - hit(DB,Canvas,X1,Y1,X2,Y2); - % {% hidden above, % of total area that is visible + % hidden above} - yscrollpos -> - {PercentOffViewTop,_} = tcl2erl:ret_tuple([Canvas," yvi"]), - {_,Ymin,_,Ymax} = gstk_db:opt(DB,Gstkid,scrollregion), - K = 1/(Ymax-Ymin), - M = -K*Ymin, - _Y = round((PercentOffViewTop - M)/K); - xscrollpos -> - {PercentOffViewLeft,_} = tcl2erl:ret_tuple([Canvas," xvi"]), - {Xmin,_,Xmax,_} = gstk_db:opt(DB,Gstkid,scrollregion), - K = 1/(Xmax-Xmin), - M = -K*Xmin, - _X = round((PercentOffViewLeft-M)/K); - buttonpress -> gstk_db:is_inserted(DB, Gstkid, buttonpress); - buttonrelease -> gstk_db:is_inserted(DB, Gstkid, buttonrelease); - configure -> gstk_db:is_inserted(DB, Gstkid, configure); - destroy -> gstk_db:is_inserted(DB, Gstkid, destroy); - enter -> gstk_db:is_inserted(DB, Gstkid, enter); - focus -> gstk_db:is_inserted(DB, Gstkid, focus); - keypress -> gstk_db:is_inserted(DB, Gstkid, keypress); - keyrelease -> gstk_db:is_inserted(DB, Gstkid, keyrelease); - leave -> gstk_db:is_inserted(DB, Gstkid, leave); - motion -> gstk_db:is_inserted(DB, Gstkid, motion); - - _ -> {bad_result, {Gstkid#gstkid.objtype, invalid_option, Option}} - end. - -hit(DB,Canvas,X1,Y1,X2,Y2) -> - Ax1 = gstk:to_ascii(X1), - Ay1 = gstk:to_ascii(Y1), - Ax2 = gstk:to_ascii(X2), - Ay2 = gstk:to_ascii(Y2), - case tcl2erl:ret_list([Canvas," find overlapping ", - Ax1,$ ,Ay1,$ ,Ax2,$ ,Ay2]) of - Items when is_list(Items) -> - [{_,Node}] = ets:lookup(DB,frontend_node), - fix_ids(Items,DB,Canvas,Node); - Other -> - {bad_result, Other} - end. - -fix_ids([Item|Items],DB,Canvas,Node) -> - [{gstk_db:lookup_item(DB,Canvas,Item),Node}|fix_ids(Items,DB,Canvas,Node)]; -fix_ids([],_,_,_) -> []. - -%%----------------------------------------------------------------------------- -%% PRIMITIVES -%%----------------------------------------------------------------------------- - -%% -%% Event bind main function -%% -%% Should return a list of tcl commands or invalid_option -%% -%% WS = Widget suffix for c widgets -%% -bind(DB, Gstkid, TkW, Etype, On) -> - case bind(DB, Gstkid, TkW, Etype, On, "") of - invalid_option -> invalid_option; - Cmd -> {c, Cmd} - end. - -bind(DB, Gstkid, TkW, Etype, On, WS) -> - case On of - true -> ebind(DB, Gstkid, TkW, Etype, WS, ""); - false -> eunbind(DB, Gstkid, TkW, Etype, WS, ""); - {true, Edata} -> ebind(DB, Gstkid, TkW, Etype, WS, Edata); - {false, Edata} -> eunbind(DB, Gstkid, TkW, Etype, WS, Edata); - _ -> invalid_option - end. - - -%% -%% Event bind on -%% -%% Should return a list of tcl commands or invalid_option -%% -%% WS = Widget suffix for complex widgets -%% -ebind(DB, Gstkid, TkW, Etype, WS, Edata) -> - Eref = gstk_db:insert_event(DB, Gstkid, Etype, Edata), - P = ["bind ", TkW, WS], - Cmd = case Etype of - motion -> [P, " {erlsend ", Eref, " [", - TkW, " canvasx %x] [", TkW, " canvasy %y] %x %y}"]; - keypress -> - [P, " {erlsend ", Eref," %K %N 0 0 [", - TkW, " canvasx %x] [", TkW, " canvasy %y]};", - P, " {erlsend ", Eref, " %K %N 1 0 [", - TkW, " canvasx %x] [", TkW, " canvasy %y]};", - P, " {erlsend ", Eref, " %K %N 0 1 [", - TkW, " canvasx %x] [", TkW, " canvasy %y]};", - P, " {erlsend ", Eref," %K %N 1 1 [", - TkW, " canvasx %x] [", TkW, " canvasy %y]}"]; - keyrelease -> - [P, " {erlsend ", Eref," %K %N 0 0 [", - TkW, " canvasx %x] [", TkW, " canvasy %y]};", - P, " {erlsend ", Eref, " %K %N 1 0 [", - TkW, " canvasx %x] [", TkW, " canvasy %y]};", - P, " {erlsend ", Eref, " %K %N 0 1 [", - TkW, " canvasx %x] [", TkW, " canvasy %y]};", - P," {erlsend ",Eref," %K %N 1 1[", - TkW, " canvasx %x] [", TkW, " canvasy %y]}"]; - buttonpress -> - [P, "