%%
%% %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} ->
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 -----
