ref: 60ecd07e6d3f5786c8723dc9172c35d580fdadc8
dir: /appl/lib/tcl_tk.b/
implement TclLib; include "sys.m"; sys: Sys; include "draw.m"; include "string.m"; str : String; include "tk.m"; tk: Tk; include "tkclient.m"; tkclient: Tkclient; 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->PATH; str = load String String->PATH; tk = load Tk Tk->PATH; tkclient = load Tkclient Tkclient->PATH; if (tkclient==nil || str==nil || tk==nil) return "Not Initialised"; # set up Draw context tkclient->init(); 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<len argv;j++){ (msg,han)=sweepthru(argv[j]); if (msg==nil){ if (argv[j][0]=='.') argv[j]=argv[j][1:]; for(i:=0;i<100;i++){ (retval,nil,c)=windows[i]; if (retval==argv[1]){ c <-= "exit"; break; } } } else msg=tkcmd(whan,"destroy "+msg); } return (error,msg); "bind" or "bitmap" or "button" or "canvas" or "checkbutton" or "entry" or "focus" or "frame" or "grab" or "image" or "label" or "listbox" or "lower" or "menu" or "menubutton" or "pack" or "radiobutton" or "raise" or "scale" or "scrollbar" or "text" or "update" or "variable" => ; # do nothing "toplevel" => msg=do_toplevel(argv); return (error,msg); * => return (0,"Unknown"); } # so it's 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;i<len argv;i++){ (argv[i],han)=sweepthru(argv[i]); if (han!=nil) whan=han; if (argv[i]!="-tcl") retval+=argv[i]; if (i+1<len argv && (argv[i]=="-command" || argv[i]=="-yscrollcommand" || argv[i]=="-tcl" || argv[i]=="-xscrollcommand")) argv[i+1]="{send Tcl_Chan "+argv[i+1]+"}"; if (argv[i]!="-tcl") retval[len retval]=' '; } retval=retval[0:len retval -1]; if (tclmod.debug==1) sys->print("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;i<len windows;i++){ (ret,han,nil)=windows[i]; if (ret==wname) break; } if (i==len windows) return (s,nil); return (rest,han); } do_toplevel(argv : array of string): string { name : string; whan : ref Tk->Toplevel; if (len argv!=2) return notify(1,"toplevel name"); if (argv[1][0]=='.') argv[1]=argv[1][1:]; for(i:=0;i<len windows;i++){ (name,whan,nil)=windows[i]; if(whan==nil || name==argv[1]) break; } if (i==len windows) return notify(0,"Too many top level windows"); if (name==argv[1]) return notify(0,argv[1]+" is already a window name in use."); (top, menubut) := tkclient->toplevel(tclmod.context, "", argv[1], Tkclient->Appl); whan = top; 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]); for(i=0; i<len w_cfg; i++) tk->cmd(whan, w_cfg[i]); tkclient->onscreen(whan, nil); tkclient->startinput(whan, "kbd"::"ptr"::nil); stop := chan of int; spawn tkclient->handler(whan, stop); spawn menulisten(whan,menubut, stop); return nil; } menulisten(t : ref Tk->Toplevel, menubut : chan of string, stop: chan of int) { for(;;) alt { menu := <-menubut => if(menu == "exit"){ for(i:=0;i<len windows;i++){ (name,whan,nil):=windows[i]; if(whan==t) break; } if (i!=len windows) windows[i]=("",nil,nil); stop <-= 1; exit; } tkclient->wmctl(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; } }