[mercury-users] changes to mercury-extras/graphics/

[Holger Krug]

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

-- 
Holger Krug
hkrug at rationalizer.com
-------------- next part --------------
Index: graphics//mercury_tcltk/Mmakefile
===================================================================
RCS file: /usr/local/dev/cvs/rat/rationality/logic/mercury/extras/graphics/mercury_tcltk/Mmakefile,v
retrieving revision 1.1
retrieving revision 1.2
diff -r1.1 -r1.2
4c4,6
< MLLIBS    = -ltk8.0 -ltcl8.0 -L/usr/X11R6/lib -lX11 -lXmu -lXext -lm -ldl
---
> MLLIBS    = -ltk8.0 -ltcl8.0 -L/usr/X11R6/lib -lX11 -lXmu -lXext -lm -ldl \
>    	    -lXt -lICE -lSM
> 
Index: graphics//mercury_tcltk/mtcltk.m
===================================================================
RCS file: /usr/local/dev/cvs/rat/rationality/logic/mercury/extras/graphics/mercury_tcltk/mtcltk.m,v
retrieving revision 1.1
retrieving revision 1.2
diff -r1.1 -r1.2
141c141,142
<     MR_incr_hp(LVALUE_CAST(Word, argv), argc + 1);
---
>     /* 07/13/01 changed from LVALUE_CAST to MR_LVALUE_CAST */
>     MR_incr_hp(MR_LVALUE_CAST(Word, argv), argc + 1);
Index: graphics//mercury_tcltk/mtk.m
===================================================================
RCS file: /usr/local/dev/cvs/rat/rationality/logic/mercury/extras/graphics/mercury_tcltk/mtk.m,v
retrieving revision 1.1
retrieving revision 1.2
diff -r1.1 -r1.2
2a3
> % Copyright (C) 2001 The Rationalizer Intelligent Software AG
11a13
> %
14a17,26
> % 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"
> %
162a175,183
> % 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.	
> 
616a638,640
> % The straightforward implementation of root_window.
> root_window = window(".").
> 
633c657
< 	{ string__format("%s.button%d", [s(Parent), i(Id)], Widget) },
---
> 	{ string__format("%s.button%d", [s(no_dot_wpath(Parent)), i(Id)], Widget) },
670c694
< 	{ string__format("%s.canvas%d", [s(Parent), i(Id)], Widget) },
---
> 	{ string__format("%s.canvas%d", [s(no_dot_wpath(Parent)), i(Id)], Widget) },
800c824
< 	{ string__format("%s.entry%d", [s(Parent), i(Id)], Widget) },
---
> 	{ string__format("%s.entry%d", [s(no_dot_wpath(Parent)), i(Id)], Widget) },
813c837
< 	{ string__format("%s.frame%d", [s(Parent), i(Id)], Widget) },
---
> 	{ string__format("%s.frame%d", [s(no_dot_wpath(Parent)), i(Id)], Widget) },
826c850
< 	{ string__format("%s.label%d", [s(Parent), i(Id)], Widget) },
---
> 	{ string__format("%s.label%d", [s(no_dot_wpath(Parent)), i(Id)], Widget) },
839c863
< 	{ string__format("%s.listbox%d", [s(Parent), i(Id)], Widget) },
---
> 	{ string__format("%s.listbox%d", [s(no_dot_wpath(Parent)), i(Id)], Widget) },
907c931
< 	{ string__format("%s.menubutton%d", [s(Parent), i(Id)], Widget) },
---
> 	{ string__format("%s.menubutton%d", [s(no_dot_wpath(Parent)), i(Id)], Widget) },
920c944
< 	{ string__format("%s.menu%d", [s(Parent), i(Id)], Widget) },
---
> 	{ string__format("%s.menu%d", [s(no_dot_wpath(Parent)), i(Id)], Widget) },
960c984
< 	{ string__format("%s.radiobutton%d", [s(Parent), i(Id)], Widget) },
---
> 	{ string__format("%s.radiobutton%d", [s(no_dot_wpath(Parent)), i(Id)], Widget) },
974c998
< 	{ string__format("%s.scrollbar%d", [s(Parent), i(Id)], Widget) },
---
> 	{ string__format("%s.scrollbar%d", [s(no_dot_wpath(Parent)), i(Id)], Widget) },
987c1011
< 	{ string__format("%s.text%d", [s(Parent), i(Id)], Widget) },
---
> 	{ string__format("%s.text%d", [s(no_dot_wpath(Parent)), i(Id)], Widget) },
1619a1644,1655
> 
> % 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
>   ).
Index: graphics//samples/calc/calc.m
===================================================================
RCS file: /usr/local/dev/cvs/rat/rationality/logic/mercury/extras/graphics/samples/calc/calc.m,v
retrieving revision 1.1
retrieving revision 1.2
diff -r1.1 -r1.2
9a10,12
> % 07/13/01 hkrug at rationalizer.com:
> %        * only one toplevel window is created
> % 
18a22
> %-----------------------------------------------------------------------------%
19a24
> %-----------------------------------------------------------------------------%
22c27
< :- import_module bool, list, string, int, float, std_util, require.
---
> :- import_module bool, list, string, char, int, float, std_util, require.
24,25d28
< main -->
< 	main(mymain, ["calc"]).
27,34c30,33
< 	% 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"]).
76,78c75,76
< 	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),
122c120
< 	pack(Interp, [pack(Display, [top]), pack(NumPad, [top])]).
---
> 	pack(Interp, [pack(NumPad, [top])]).