From 84adefa331c4159d432d22840663c38f155cd4c1 Mon Sep 17 00:00:00 2001 From: Erlang/OTP Date: Fri, 20 Nov 2009 14:54:40 +0000 Subject: The R13B03 release. --- lib/gs/src/gstk_editor.erl | 396 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 396 insertions(+) create mode 100644 lib/gs/src/gstk_editor.erl (limited to 'lib/gs/src/gstk_editor.erl') 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 ----- -- cgit v1.2.3