diff options
author | Björn Gustavsson <[email protected]> | 2016-06-27 11:48:03 +0200 |
---|---|---|
committer | Björn Gustavsson <[email protected]> | 2016-06-27 11:49:57 +0200 |
commit | 6931dce17580d097351dd7be09ce7c9ed3f72827 (patch) | |
tree | 2456845e95ed0112c2f08ed8ab6e867686b91d7a /lib/gs/src/gstk_editor.erl | |
parent | dfccd57cb2b69fc3ab01acd0ccbfc894a8403358 (diff) | |
download | otp-6931dce17580d097351dd7be09ce7c9ed3f72827.tar.gz otp-6931dce17580d097351dd7be09ce7c9ed3f72827.tar.bz2 otp-6931dce17580d097351dd7be09ce7c9ed3f72827.zip |
Remove the gs application
The gs application ws deprecated in R15B01.
Diffstat (limited to 'lib/gs/src/gstk_editor.erl')
-rw-r--r-- | lib/gs/src/gstk_editor.erl | 400 |
1 files changed, 0 insertions, 400 deletions
diff --git a/lib/gs/src/gstk_editor.erl b/lib/gs/src/gstk_editor.erl deleted file mode 100644 index 6376efc851..0000000000 --- a/lib/gs/src/gstk_editor.erl +++ /dev/null @@ -1,400 +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 Editor Type -%% ------------------------------------------------------------ - --module(gstk_editor). --compile([{nowarn_deprecated_function,{gs,assq,2}}, - {nowarn_deprecated_function,{gs,error,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 -%% fg Color -%% font Font -%% height Int -%% highlightbg Color -%% highlightbw Wth -%% highlightfg Color -%% hscroll Bool | top | bottom -%% insertbg Color -%% insertbw Wth -%% insertpos {Row,Col}|'end' (Row: 1..Max, Col: 0..Max) -%% justify left|right|center -%% padx Int (Pixels) -%% pady Int (Pixels) -%% relief Relief -%% scrollbg Color -%% scrollfg Color -%% selectbg Color -%% selectbw Width -%% selectfg Color -%% vscroll Bool | left | right -%% width Int -%% wrap none | char | word -%% x Int -%% y Int -%% -%% -%% Commands: -%% clear -%% del {FromIdx, ToIdx} -%% enable Bool -%% file String -%% get {FromIdx, ToIdx} => Text -%% insert {Index, Text}Index = [insert,{Row,lineend},end,{Row,Col}] -%% setfocus Bool -%% -%% Events: -%% buttonpress [Bool | {Bool, Data}] -%% buttonrelease [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 -%% - -%.t tag names 2.7 -> red blue (blue is the colour) -%.t tag add blue 2.1 2.10 tag the text -%.t tag configure blue -foregr blue create tag -% .t index end -> MaxRows.cols -% .t yview moveto (Row-1)/MaxRows - --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. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -create(DB, Gstkid, Opts) -> - MainW = gstk_generic:mk_tkw_child(DB,Gstkid), - Editor = lists:append(MainW,".z"), - {Vscroll, Hscroll, NewOpts} = gstk_generic:parse_scrolls(Opts), - WidgetD = #so{main=MainW, object=Editor, - hscroll=Hscroll, vscroll=Vscroll,misc=[{1,white}]}, - NGstkid=Gstkid#gstkid{widget=MainW, widget_data=WidgetD}, - gstk_db:insert_widget(DB,NGstkid), - MandatoryCmd = ["so_create text ", MainW], - case gstk:call(MandatoryCmd) of - {result, _} -> - SimplePreCmd = [MainW, " conf"], - PlacePreCmd = [";place ", MainW], - case gstk_generic:make_command(NewOpts, NGstkid, MainW, SimplePreCmd, - PlacePreCmd, DB,Editor) of - {error,Reason} -> {error,Reason}; - Cmd -> - gstk:exec(Cmd), - gstk:exec( - [Editor," conf -bo 2 -relief sunken -highlightth 2;", - MainW,".sy conf -rel sunken -bo 2;", - MainW,".pad.sx conf -rel sunken -bo 2;", - Editor, " tag co c1 -for white;"]), - ok - end - 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, Options) -> - SO = Gstkid#gstkid.widget_data, - MainW = Gstkid#gstkid.widget, - Editor = SO#so.object, - NewOpts = - case {gs:assq(vscroll,Options),gs:assq(hscroll,Options)} of - {false,false} -> Options; - _ -> gstk_generic:parse_scrolls(Gstkid, Options) - end, - SimplePreCmd = [MainW, " conf"], - PlacePreCmd = [";place ", MainW], - gstk_generic:mk_cmd_and_exec(NewOpts, Gstkid, MainW, SimplePreCmd, - PlacePreCmd, DB, Editor). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% 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 -%% Editor - The Editor tk-widget -%% DB - The Database -%% -%% Return : A tuple {OptionType, OptionCmd} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -option(Option, Gstkid, _MainW, DB, Editor) -> - case Option of - {font,Font} when is_tuple(Font) -> - gstk_db:insert_opt(DB,Gstkid,Option), - {c, [Editor, " conf -font ", gstk_font:choose_ascii(DB,Font)]}; - {font_style, {{Start,End},Font}} -> % should be only style - {Tag,Ngstkid} = get_style_tag(DB,Editor,Font,Gstkid), - gstk_db:update_widget(DB,Ngstkid), - {c, Ngstkid, [Editor, " tag ad ", Tag, " ", p_index(Start), " ", - p_index(End)]}; - {fg, {{Start,End},Color}} -> - {Tag,Ngstkid} = get_color_tag(Editor,Color,Gstkid), - gstk_db:update_widget(DB,Ngstkid), - {c, Ngstkid, [Editor, " tag ad ", Tag, " ", p_index(Start), " ", - p_index(End)]}; - {padx, Pad} -> {c, [Editor," conf -padx ",gstk:to_ascii(Pad)]}; - {pady, Pad} -> {c, [Editor," conf -pady ",gstk:to_ascii(Pad)]}; - {selection, {From, To}} -> - {c, [Editor," tag ad sel ",p_index(From)," ", p_index(To)]}; - {vscrollpos, Row} -> - {MaxRow,_Col} = ret_ed_index([Editor," ind end"]), - {c, [Editor, " yv mo ",gstk:to_ascii(Row/MaxRow)]}; - {wrap, How} -> - {c, [Editor, " conf -wrap ", gstk:to_ascii(How)]}; - {fg, Color} -> - {c, [Editor, " conf -fg ", gstk:to_color(Color)]}; - {insertbw, Wth} -> - {c, [Editor, " conf -insertbo ", gstk:to_ascii(Wth)]}; - {insertbg, Color} -> - {c, [Editor, " conf -insertba ", gstk:to_color(Color)]}; - {insertpos, Index} -> - {c, [Editor, " m s insert ", p_index(Index)]}; - {insert, {Index, Text}} -> - {c, [Editor, " ins ", p_index(Index), " ", gstk:to_ascii(Text)]}; - {del, {From, To}} -> - {c, [Editor, " del ", p_index(From), " ", p_index(To)]}; - {overwrite, {Index, Text}} -> - AI = p_index(Index), - Len = gstk:to_ascii(lists:flatlength(Text)), - {c, [Editor, " del ",AI," \"",AI,"+",Len,"c\";", - Editor, " ins ",AI," ", gstk:to_ascii(Text)]}; - clear -> {c, [Editor, " delete 1.0 end"]}; - {load, File} -> - F2 = re:replace(File, [92,92], "/", [global,{return,list}]), - case gstk:call(["ed_load ", Editor, " ", gstk:to_ascii(F2)]) of - {result, _} -> none; - {bad_result,Re} -> - {error,{no_such_file,editor,load,F2,Re}} - end; - {save, File} -> - F2 = re:replace(File, [92,92], "/", [global,{return,list}]), - case gstk:call(["ed_save ",Editor," ",gstk:to_ascii(F2)]) of - {result, _} -> none; - {bad_result,Re} -> - {error,{no_such_file,editor,save,F2,Re}} - end; - {enable, true} -> {c, [Editor, " conf -state normal"]}; - {enable, false} -> {c, [Editor, " conf -state disabled"]}; - - {setfocus, true} -> {c, ["focus ", Editor]}; - {setfocus, false} -> {c, ["focus ."]}; - _ -> 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,Editor) -> - case Option of - font -> gstk_db:opt(DB,GstkId,font,undefined); - padx -> tcl2erl:ret_atom([Editor," cg -padx"]); - pady -> tcl2erl:ret_atom([Editor," cg -pady"]); - enable -> tcl2erl:ret_enable([Editor," cg -st"]); - fg -> tcl2erl:ret_color([Editor," cg -fg"]); - {fg, Pos} -> - L=tcl2erl:ret_list([Editor," tag nam ", p_index(Pos)]), - SO = GstkId#gstkid.widget_data, - case last_tag_val(undefined, $c, L, SO#so.misc) of - undefined -> tcl2erl:ret_color([Editor," cg -fg"]); - Color -> Color - end; - {font_style, Pos} -> - L=tcl2erl:ret_list([Editor," tag nam ", p_index(Pos)]), - SO = GstkId#gstkid.widget_data, - case last_tag_val(undefined, $f, L, SO#so.misc) of - undefined -> 'my style? nyi'; - Style -> Style - end; - selection -> ret_ed_indexes([Editor," tag ne sel 1.0"]); - char_height -> tcl2erl:ret_int([Editor, " cg -he"]); - char_width -> tcl2erl:ret_int([Editor, " cg -wi"]); - insertbg -> tcl2erl:ret_color([Editor," cg -insertba"]); - insertbw -> tcl2erl:ret_int([Editor," cg -insertbo"]); - insertpos -> ret_ed_index([Editor, " ind insert"]); - setfocus -> tcl2erl:ret_focus(Editor, "focus"); - wrap -> tcl2erl:ret_atom([Editor," cg -wrap"]); - size -> {MaxRow,_Col} = ret_ed_index([Editor," ind end"]), - MaxRow-1; - vscrollpos -> - {MaxRow,_Col} = ret_ed_index([Editor," ind end"]), - [Top,_Bot] = tcl2erl:ret_list([Editor," yvi"]), - round(Top*(MaxRow-1))+1; - {get, {From, To}} -> - tcl2erl:ret_str([Editor, " get ", p_index(From), " ", p_index(To)]); - _ -> {bad_result, {GstkId#gstkid.objtype, invalid_option, Option}} - end. - - -%%------------------------------------------------------------------------------ -%% PRIMITIVES -%%------------------------------------------------------------------------------ - -p_index({Line, lineend}) -> [$",gstk:to_ascii(Line), ".1 lineend",$"]; -p_index({Line, Char}) -> [gstk:to_ascii(Line), $., gstk:to_ascii(Char)]; -p_index(insert) -> "insert"; -p_index('end') -> "end"; -p_index(Idx) -> gs:error("bad index in editor: ~w~n",[Idx]),0. - -ret_ed_index(Cmd) -> - case gstk:call(Cmd) of - {result, Val} -> - case io_lib:fread("~d.~d", Val) of - {ok, [Row,Col], []} -> {Row, Col}; - Other -> {bad_result, Other} - end; - Bad_result -> Bad_result - end. - -ret_ed_indexes(Cmd) -> - case gstk:call(Cmd) of - {result, ""} -> undefined; - {result, Val} -> - case io_lib:fread("~d.~d ~d.~d", Val) of - {ok, [Row1,Col1,Row2,Col2], []} -> {{Row1, Col1}, {Row2,Col2}}; - Other -> {bad_result, Other} - end; - Bad_result -> Bad_result - end. - - -%%---------------------------------------------------------------------- -%% Returns: {Tag text(), NewGstkId} -%%---------------------------------------------------------------------- -%% The misc field of the so record is a list of {ColorNo, Color|Font|...} -get_color_tag(Editor,Color,Gstkid) -> - SO = Gstkid#gstkid.widget_data, - Tags = SO#so.misc, - case lists:keysearch(Color, 2, Tags) of -% {value, {No, _}} -> {["c",gstk:to_ascii(No)], Gstkid}; -% false -> % don't reuse tags, priority order spoils that - _Any -> - {No,_} = lists:max(Tags), - N=No+1, - SO2 = SO#so{misc=[{N,Color}|Tags]}, - TagStr=["c",gstk:to_ascii(N)], - gstk:exec([Editor," tag co ",TagStr," -for ", gstk:to_color(Color)]), - {TagStr,Gstkid#gstkid{widget_data=SO2}} - end. - -get_style_tag(DB,Editor,Style,Gstkid) -> - SO = Gstkid#gstkid.widget_data, - Tags = SO#so.misc, - case lists:keysearch(Style, 2, Tags) of -% {value, {No, _}} -> {["f",gstk:to_ascii(No)], Gstkid}; -% false -> % don't reuse tags, priority order spoils that - _Any -> - {No,_} = lists:max(Tags), - N=No+1, - SO2 = SO#so{misc=[{N,Style}|Tags]}, - TagStr=["f",gstk:to_ascii(N)], - gstk:exec([Editor," tag co ",TagStr," -font ", - gstk_font:choose_ascii(DB,Style)]), % should be style only - {TagStr,Gstkid#gstkid{widget_data=SO2}} - end. - -%%---------------------------------------------------------------------- -%% Purpose: Given a list of tags for a char, return its visible color -%% (that is that last color tag in the list). -%%---------------------------------------------------------------------- -last_tag_val(TagVal, _Chr, [], _TagDict) -> TagVal; -last_tag_val(TagVal, Chr, [Tag|Ts],TagDict) -> - case atom_to_list(Tag) of - [Chr|ANo] -> - No = list_to_integer(ANo), - last_tag_val(gs:val(No, TagDict),Chr,Ts,TagDict); - _NoAcolor -> - last_tag_val(TagVal,Chr, Ts,TagDict) - end. - -%%% ----- Done ----- |