implement TclLib; include "sys.m"; sys: Sys; include "draw.m"; draw: Draw; include "string.m"; str : String; include "tk.m"; tk: Tk; include "tklib.m"; tklib: Tklib; include "wmlib.m"; wmlib: Wmlib; include "tcl.m"; include "tcllib.m"; error,started : int; w_cfg := array[] of { "pack .Wm_t -side top -fill x", "update", }; tclmod : ref Tcl_Core->TclData; windows := array[100] of (string, ref Tk->Toplevel, chan of string); valid_commands:= array[] of { "bind" , "bitmap" , "button" , "canvas" , "checkbutton" , "destroy" , "entry" , "focus", "frame" , "grab", "image" , "label" , "listbox" ,"lower", "menu" , "menubutton" , "pack" , "radiobutton" , "raise", "scale" , "scrollbar" , "text" , "update" , "toplevel" , "variable" }; about() : array of string { return valid_commands; } init() : string { sys = load Sys "$Sys"; draw = load Draw "$Draw"; str = load String String->PATH; tklib= load Tklib Tklib->PATH; wmlib= load Wmlib Wmlib->PATH; tk = load Tk Tk->PATH; if (tklib==nil || wmlib==nil || str==nil || tk==nil) return "Not Initialised"; # set up Draw context wmlib->init(); tklib->init(tclmod.context); started=1; return nil; } exec(tcl : ref Tcl_Core->TclData,argv : array of string) : (int,string) { retval : string; retval=""; han,whan : ref Tk->Toplevel; whan=nil; msg : string; c : chan of string; msg=nil; error=0; tclmod=tcl; if (!started) if (init()!=nil) return (1,"Can't Initialise TK"); if (argv[0][0]!='.') case argv[0] { "destroy" => for (j:=1;j ; # do nothing "toplevel" => msg=do_toplevel(argv); return (error,msg); * => return (0,"Unknown"); } # so its a tk-command ... replace any -command with # a send on the tcl channel. if (argv[0]=="bind") argv[3]="{send Tcl_Chan "+argv[3]+"}"; for (i:=0;iprint("Sending [%s] to tkcmd.\n",retval); msg=tkcmd(whan,retval); if (msg!="" && msg[0]=='!') error=1; return (error,msg); } sweepthru(s: string) : (string,ref Tk->Toplevel) { han : ref Tk->Toplevel; ret : string; if (s=="" || s=="." || s[0]!='.') return (s,nil); (wname,rest):=str->splitl(s[1:],"."); for (i:=0;iToplevel; if (len argv!=2) return notify(1,"toplevel name"); if (argv[1][0]=='.') argv[1]=argv[1][1:]; for(i:=0;itoplevel((tclmod.context).screen, " -borderwidth 2 -relief raised"); menubut := wmlib->titlebar(whan, argv[1],Wmlib->Appl); windows[i]=(argv[1],whan,menubut); if (tclmod.debug==1) sys->print("creating window %d, name %s, handle %ux\n",i,argv[1],whan); cmd := chan of string; tk->namechan(whan, cmd, argv[1]); tklib->tkcmds(whan, w_cfg); spawn menulisten(whan,menubut); return nil; } menulisten(t : ref Tk->Toplevel, menubut : chan of string) { for(;;) alt { menu := <-menubut => if(menu[0] == 'e'){ for(i:=0;ititlectl(t, menu); } } tkcmd(t : ref Tk->Toplevel, cmd: string): string { if (len cmd ==0 || tclmod.top==nil) return nil; if (t==nil){ t=tclmod.top; #sys->print("Sending to WishPad\n"); } s := tk->cmd(t, cmd); tk->cmd(t,"update"); return s; } notify(num : int,s : string) : string { error=1; case num{ 1 => return sys->sprint( "wrong # args: should be \"%s\"",s); * => return s; } }