aboutsummaryrefslogtreecommitdiffstats
path: root/lib/gs/src/gstk_editor.erl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/gs/src/gstk_editor.erl')
-rw-r--r--lib/gs/src/gstk_editor.erl396
1 files changed, 396 insertions, 0 deletions
diff --git a/lib/gs/src/gstk_editor.erl b/lib/gs/src/gstk_editor.erl
new file mode 100644
index 0000000000..3e0c8240e4
--- /dev/null
+++ b/lib/gs/src/gstk_editor.erl
@@ -0,0 +1,396 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%% ------------------------------------------------------------
+%% Basic Editor Type
+%% ------------------------------------------------------------
+
+-module(gstk_editor).
+
+%%------------------------------------------------------------------------------
+%% 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 �r f�rgen)
+%.t tag add blue 2.1 2.10 tagga text
+%.t tag configure blue -foregr blue skapa 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} ->
+ {ok, F2,_} = regexp:gsub(File, [92,92], "/"),
+ 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} ->
+ {ok, F2,_} = regexp:gsub(File, [92,92], "/"),
+ 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 -----
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-18 16:43:29 +0000