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.erl400
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 -----
generated by cgit v1.2.3 (git 2.25.1) at 2024-06-09 03:54:41 +0000