[m-rev.] Re: [mercury-users] changes to mercury-extras/graphics/
Fergus Henderson
fjh at cs.mu.OZ.AU
Mon Jul 16 20:20:37 AEST 2001
On 16-Jul-2001, Fergus Henderson <fjh at cs.mu.OZ.AU> wrote:
> In mail to mercury-users,
> On 16-Jul-2001, Holger Krug <hkrug at rationalizer.com> wrote:
> > Appended is a diff for mercury-extras/graphics concerning:
> >
> > * bug fixed in graphics/mercury_tcltk/mtk.m:
> > LVALUE_CAST renamed to MR_LVALUE_CAST
> > * access to root window allowed in graphics/mercury_tcltk/mtk.m
> > * only one toplevel window created in graphics/samples/calc/calc.m
>
> That looks good, thanks.
> I'll go ahead and commit that.
Estimated hours taken: 0.5 (plus unknown by original contributor)
Apply some improvements to extras/graphics
from Holger Krug <hkrug at rationalizer.com>.
extras/graphics/mercury_tcltk/mtk.m:
Fix a bug: LVALUE_CAST renamed to MR_LVALUE_CAST.
extras/graphics/mercury_tcltk/mtk.m:
Provide access to the root window.
extras/graphics/samples/calc/calc.m:
Only create on top-level window.
Workspace: /mnt/mars/home/mars/fjh/ws2/mercury
Index: extras/graphics/mercury_tcltk/mtk.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/graphics/mercury_tcltk/mtk.m,v
retrieving revision 1.3
diff -u -d -r1.3 mtk.m
--- extras/graphics/mercury_tcltk/mtk.m 2000/12/05 02:07:22 1.3
+++ extras/graphics/mercury_tcltk/mtk.m 2001/07/16 09:49:31
@@ -1,5 +1,6 @@
%-----------------------------------------------------------------------------%
% Copyright (C) 1997-1998,2000 The University of Melbourne.
+% Copyright (C) 2001 The Rationalizer Intelligent Software AG
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -9,9 +10,20 @@
% main author: conway.
% stability: very low.
%
+%
% This file provides an interface to the Tk widget set, [conceptually]
% bypassing Tcl.
%
+% 07/13/01 hkrug at rationalizer.com:
+% * interface:
+% - added constant root_window for access of the root window by
+% the application
+% * implementation:
+% - more carefull formation of internal Tk-names for created
+% widgets, when the parent is the root window:
+% string__format("%s.button%d", [s("."), i(13)], Widget)
+% would result in the invalid name "..button13"
+%
%-----------------------------------------------------------------------------%
:- module mtk.
@@ -160,6 +172,15 @@
window(ground)
)).
+% A constant to access the root window in the Tk hierarchy,
+% comp. John K. Ousterhout, Tcl and the Tk Toolkit, 1994, p.151.
+% The root window is the one designated as "." in Tk way of
+% speaking. It is necessary to access not only a top level window
+% created by the application, but the main application window
+% provided by the framework.
+:- func root_window = widget.
+:- mode root_window = out(toplevel) is det.
+
:- inst window = bound((
window(ground)
; frame(ground)
@@ -614,6 +635,9 @@
%------------------------------------------------------------------------------%
+% The straightforward implementation of root_window.
+root_window = window(".").
+
window(Interp, Configs, window(Widget)) -->
get_thingy_counter(Id),
set_thingy_counter(Id + 1),
@@ -630,7 +654,7 @@
{ unwrap(ParentWidget, Parent) },
get_thingy_counter(Id),
set_thingy_counter(Id + 1),
- { string__format("%s.button%d", [s(Parent), i(Id)], Widget) },
+ { string__format("%s.button%d", [s(no_dot_wpath(Parent)), i(Id)], Widget) },
{ string__format("button %s ", [s(Widget)], Str0) },
stringify_configs(Interp, Configs, Str1),
{ string__append(Str0, Str1, Str) },
@@ -667,7 +691,7 @@
{ unwrap(ParentWidget, Parent) },
get_thingy_counter(Id),
set_thingy_counter(Id + 1),
- { string__format("%s.canvas%d", [s(Parent), i(Id)], Widget) },
+ { string__format("%s.canvas%d", [s(no_dot_wpath(Parent)), i(Id)], Widget) },
{ string__format("canvas %s ", [s(Widget)], Str0) },
stringify_configs(Interp, Configs, Str1),
{ string__append(Str0, Str1, Str) },
@@ -797,7 +821,7 @@
{ unwrap(ParentWidget, Parent) },
get_thingy_counter(Id),
set_thingy_counter(Id + 1),
- { string__format("%s.entry%d", [s(Parent), i(Id)], Widget) },
+ { string__format("%s.entry%d", [s(no_dot_wpath(Parent)), i(Id)], Widget) },
{ string__format("entry %s ", [s(Widget)], Str0) },
stringify_configs(Interp, Configs, Str1),
{ string__append(Str0, Str1, Str) },
@@ -810,7 +834,7 @@
{ unwrap(ParentWidget, Parent) },
get_thingy_counter(Id),
set_thingy_counter(Id + 1),
- { string__format("%s.frame%d", [s(Parent), i(Id)], Widget) },
+ { string__format("%s.frame%d", [s(no_dot_wpath(Parent)), i(Id)], Widget) },
{ string__format("frame %s ", [s(Widget)], Str0) },
stringify_configs(Interp, Configs, Str1),
{ string__append(Str0, Str1, Str) },
@@ -823,7 +847,7 @@
{ unwrap(ParentWidget, Parent) },
get_thingy_counter(Id),
set_thingy_counter(Id + 1),
- { string__format("%s.label%d", [s(Parent), i(Id)], Widget) },
+ { string__format("%s.label%d", [s(no_dot_wpath(Parent)), i(Id)], Widget) },
{ string__format("label %s ", [s(Widget)], Str0) },
stringify_configs(Interp, Configs, Str1),
{ string__append(Str0, Str1, Str) },
@@ -836,7 +860,7 @@
{ unwrap(ParentWidget, Parent) },
get_thingy_counter(Id),
set_thingy_counter(Id + 1),
- { string__format("%s.listbox%d", [s(Parent), i(Id)], Widget) },
+ { string__format("%s.listbox%d", [s(no_dot_wpath(Parent)), i(Id)], Widget) },
{ string__format("listbox %s ", [s(Widget)], Str0) },
stringify_configs(Interp, Configs, Str1),
{ string__append(Str0, Str1, Str) },
@@ -904,7 +928,7 @@
{ unwrap(ParentWidget, Parent) },
get_thingy_counter(Id),
set_thingy_counter(Id + 1),
- { string__format("%s.menubutton%d", [s(Parent), i(Id)], Widget) },
+ { string__format("%s.menubutton%d", [s(no_dot_wpath(Parent)), i(Id)], Widget) },
{ string__format("menubutton %s ", [s(Widget)], Str0) },
stringify_configs(Interp, Configs, Str1),
{ string__append(Str0, Str1, Str) },
@@ -917,7 +941,7 @@
{ unwrap(ParentWidget, Parent) },
get_thingy_counter(Id),
set_thingy_counter(Id + 1),
- { string__format("%s.menu%d", [s(Parent), i(Id)], Widget) },
+ { string__format("%s.menu%d", [s(no_dot_wpath(Parent)), i(Id)], Widget) },
{ string__format("menu %s ", [s(Widget)], Str0) },
stringify_configs(Interp, Configs, Str1),
{ string__append(Str0, Str1, Str) },
@@ -957,7 +981,7 @@
{ unwrap(ParentWidget, Parent) },
get_thingy_counter(Id),
set_thingy_counter(Id + 1),
- { string__format("%s.radiobutton%d", [s(Parent), i(Id)], Widget) },
+ { string__format("%s.radiobutton%d", [s(no_dot_wpath(Parent)), i(Id)], Widget) },
{ string__format("radiobutton %s -indicatoron 0 -variable %s -value %s ",
[s(Widget), s(RadioVar), s(Value)], Str0) },
stringify_configs(Interp, Configs, Str1),
@@ -971,7 +995,7 @@
{ unwrap(ParentWidget, Parent) },
get_thingy_counter(Id),
set_thingy_counter(Id + 1),
- { string__format("%s.scrollbar%d", [s(Parent), i(Id)], Widget) },
+ { string__format("%s.scrollbar%d", [s(no_dot_wpath(Parent)), i(Id)], Widget) },
{ string__format("scrollbar %s ", [s(Widget)], Str0) },
stringify_configs(Interp, Configs, Str1),
{ string__append(Str0, Str1, Str) },
@@ -984,7 +1008,7 @@
{ unwrap(ParentWidget, Parent) },
get_thingy_counter(Id),
set_thingy_counter(Id + 1),
- { string__format("%s.text%d", [s(Parent), i(Id)], Widget) },
+ { string__format("%s.text%d", [s(no_dot_wpath(Parent)), i(Id)], Widget) },
{ string__format("text %s ", [s(Widget)], Str0) },
stringify_configs(Interp, Configs, Str1),
{ string__append(Str0, Str1, Str) },
@@ -1617,6 +1641,18 @@
unwrap(scrollbar(Path), Path).
unwrap(text(Path), Path).
unwrap(window(Path), Path).
+
+% function to reduce the path "." of the root window to the
+% empty string "", used when forming names for new widgets
+:- func no_dot_wpath(wpath) = wpath.
+:- mode no_dot_wpath(in) = out is det.
+
+no_dot_wpath(WPATH) = REDUCED_WPATH :-
+ unwrap( root_window, ROOT_WPATH ),
+ ( if WPATH = ROOT_WPATH
+ then REDUCED_WPATH = ""
+ else REDUCED_WPATH = WPATH
+ ).
:- pred command_wrapper(pred(tcl_interp, io__state, io__state), tcl_interp,
list(string), tcl_status, string, io__state, io__state).
Index: extras/graphics/samples/calc/calc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/graphics/samples/calc/calc.m,v
retrieving revision 1.3
diff -u -d -r1.3 calc.m
--- extras/graphics/samples/calc/calc.m 1997/09/11 22:08:53 1.3
+++ extras/graphics/samples/calc/calc.m 2001/07/16 09:49:42
@@ -7,6 +7,9 @@
%
% A simple Tcl/Tk based calculator.
%
+% 07/13/01 hkrug at rationalizer.com:
+% * only one toplevel window is created
+%
%-----------------------------------------------------------------------------%
:- module calc.
@@ -16,22 +19,18 @@
:- pred main(io__state::di, io__state::uo) is det.
+%-----------------------------------------------------------------------------%
:- implementation.
+%-----------------------------------------------------------------------------%
:- import_module mtcltk, mtk.
-:- import_module bool, list, string, int, float, std_util, require.
-
-main -->
- main(mymain, ["calc"]).
+:- import_module bool, list, string, char, int, float, std_util, require.
- % Main Tk callback
-:- pred mymain(tcl_interp, io__state, io__state).
-:- mode mymain(in, di, uo) is det.
-mymain(Interp) -->
- window(Interp, [], Parent),
- make_calculator(Interp, Parent),
- eval(Interp, "wm iconify .", _, _).
+main -->
+ mtcltk__main(pred(Interp::in, di, uo) is det -->
+ make_calculator(Interp, mtk__root_window)
+ , ["CALC"]).
%-----------------------------------------------------------------------------%
@@ -73,9 +72,8 @@
:- mode make_calculator(in, in(window), di, uo) is det.
make_calculator(Interp, Frame) -->
- frame(Interp, [], Frame, Display),
- label(Interp, [text("ArithMate (TM) C9+")], Display, DisLab),
- label(Interp, [text("0"), relief("sunken")], Display, AnsLab),
+ label(Interp, [text("ArithMate (TM) C9+")], Frame, DisLab),
+ label(Interp, [text("0"), relief("sunken")], Frame, AnsLab),
pack(Interp, [pack(DisLab, [top, expand, fill_x]),
pack(AnsLab, [top, expand, fill_x])]),
@@ -119,7 +117,7 @@
config_calc(Interp, State0),
- pack(Interp, [pack(Display, [top]), pack(NumPad, [top])]).
+ pack(Interp, [pack(NumPad, [top])]).
:- pred init_calc_state(list(pair(widget, calc_button)), widget, widget,
calculator).
--
Fergus Henderson <fjh at cs.mu.oz.au> | "I have always known that the pursuit
The University of Melbourne | of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh> | -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list