1implement TclLib; 2 3include "sys.m"; 4 sys: Sys; 5 6include "draw.m"; 7 8include "string.m"; 9 str : String; 10 11include "tk.m"; 12 tk: Tk; 13 14include "tkclient.m"; 15 tkclient: Tkclient; 16 17include "tcl.m"; 18 19include "tcllib.m"; 20 21error,started : int; 22w_cfg := array[] of { 23 "pack .Wm_t -side top -fill x", 24 "update", 25}; 26 27tclmod : ref Tcl_Core->TclData; 28 29windows := array[100] of (string, ref Tk->Toplevel, chan of string); 30 31valid_commands:= array[] of { 32 "bind" , "bitmap" , "button" , 33 "canvas" , "checkbutton" , "destroy" , 34 "entry" , "focus", "frame" , "grab", "image" , "label" , 35 "listbox" ,"lower", "menu" , "menubutton" , 36 "pack" , "radiobutton" , "raise", "scale" , 37 "scrollbar" , "text" , "update" , 38 "toplevel" , "variable" 39}; 40 41about() : array of string { 42 return valid_commands; 43} 44 45init() : string { 46 sys = load Sys Sys->PATH; 47 str = load String String->PATH; 48 tk = load Tk Tk->PATH; 49 tkclient = load Tkclient Tkclient->PATH; 50 if (tkclient==nil || str==nil || tk==nil) 51 return "Not Initialised"; 52 # set up Draw context 53 tkclient->init(); 54 started=1; 55 return nil; 56} 57 58exec(tcl : ref Tcl_Core->TclData,argv : array of string) : (int,string) { 59 retval : string; 60 retval=""; 61 han,whan : ref Tk->Toplevel; 62 whan=nil; 63 msg : string; 64 c : chan of string; 65 msg=nil; 66 error=0; 67 tclmod=tcl; 68 if (!started) 69 if (init()!=nil) 70 return (1,"Can't Initialise TK"); 71 if (argv[0][0]!='.') 72 case argv[0] { 73 "destroy" => 74 for (j:=1;j<len argv;j++){ 75 (msg,han)=sweepthru(argv[j]); 76 if (msg==nil){ 77 if (argv[j][0]=='.') 78 argv[j]=argv[j][1:]; 79 for(i:=0;i<100;i++){ 80 (retval,nil,c)=windows[i]; 81 if (retval==argv[1]){ 82 c <-= "exit"; 83 break; 84 } 85 } 86 } 87 else 88 msg=tkcmd(whan,"destroy "+msg); 89 } 90 return (error,msg); 91 "bind" or "bitmap" or "button" or 92 "canvas" or "checkbutton" or "entry" or 93 "focus" or "frame" or "grab" or 94 "image" or "label" or "listbox" or "lower" or 95 "menu" or "menubutton" or "pack" or 96 "radiobutton" or "raise" or "scale" or 97 "scrollbar" or "text" or "update" or 98 "variable" => 99 ; # do nothing 100 "toplevel" => 101 msg=do_toplevel(argv); 102 return (error,msg); 103 * => 104 return (0,"Unknown"); 105 } 106 # so it's a tk-command ... replace any -command with 107 # a send on the tcl channel. 108 if (argv[0]=="bind") 109 argv[3]="{send Tcl_Chan "+argv[3]+"}"; 110 for (i:=0;i<len argv;i++){ 111 (argv[i],han)=sweepthru(argv[i]); 112 if (han!=nil) whan=han; 113 if (argv[i]!="-tcl") 114 retval+=argv[i]; 115 if (i+1<len argv && 116 (argv[i]=="-command" || argv[i]=="-yscrollcommand" 117 || argv[i]=="-tcl" || argv[i]=="-xscrollcommand")) 118 argv[i+1]="{send Tcl_Chan "+argv[i+1]+"}"; 119 if (argv[i]!="-tcl") 120 retval[len retval]=' '; 121 } 122 retval=retval[0:len retval -1]; 123 if (tclmod.debug==1) 124 sys->print("Sending [%s] to tkcmd.\n",retval); 125 msg=tkcmd(whan,retval); 126 if (msg!="" && msg[0]=='!') 127 error=1; 128 return (error,msg); 129} 130 131 132sweepthru(s: string) : (string,ref Tk->Toplevel) { 133 han : ref Tk->Toplevel; 134 ret : string; 135 if (s=="" || s=="." || s[0]!='.') 136 return (s,nil); 137 (wname,rest):=str->splitl(s[1:],"."); 138 for (i:=0;i<len windows;i++){ 139 (ret,han,nil)=windows[i]; 140 if (ret==wname) 141 break; 142 } 143 if (i==len windows) 144 return (s,nil); 145 return (rest,han); 146} 147 148do_toplevel(argv : array of string): string 149{ 150 name : string; 151 whan : ref Tk->Toplevel; 152 if (len argv!=2) 153 return notify(1,"toplevel name"); 154 if (argv[1][0]=='.') 155 argv[1]=argv[1][1:]; 156 for(i:=0;i<len windows;i++){ 157 (name,whan,nil)=windows[i]; 158 if(whan==nil || name==argv[1]) 159 break; 160 } 161 if (i==len windows) 162 return notify(0,"Too many top level windows"); 163 if (name==argv[1]) 164 return notify(0,argv[1]+" is already a window name in use."); 165 166 (top, menubut) := tkclient->toplevel(tclmod.context, "", argv[1], Tkclient->Appl); 167 whan = top; 168 169 windows[i]=(argv[1],whan,menubut); 170 if (tclmod.debug==1) 171 sys->print("creating window %d, name %s, handle %ux\n",i,argv[1],whan); 172 cmd := chan of string; 173 tk->namechan(whan, cmd, argv[1]); 174 for(i=0; i<len w_cfg; i++) 175 tk->cmd(whan, w_cfg[i]); 176 tkclient->onscreen(whan, nil); 177 tkclient->startinput(whan, "kbd"::"ptr"::nil); 178 stop := chan of int; 179 spawn tkclient->handler(whan, stop); 180 spawn menulisten(whan,menubut, stop); 181 return nil; 182} 183 184 185menulisten(t : ref Tk->Toplevel, menubut : chan of string, stop: chan of int) { 186 for(;;) alt { 187 menu := <-menubut => 188 if(menu == "exit"){ 189 for(i:=0;i<len windows;i++){ 190 (name,whan,nil):=windows[i]; 191 if(whan==t) 192 break; 193 } 194 if (i!=len windows) 195 windows[i]=("",nil,nil); 196 stop <-= 1; 197 exit; 198 } 199 tkclient->wmctl(t, menu); 200 } 201} 202 203tkcmd(t : ref Tk->Toplevel, cmd: string): string { 204 if (len cmd ==0 || tclmod.top==nil) return nil; 205 if (t==nil){ 206 t=tclmod.top; 207 #sys->print("Sending to WishPad\n"); 208 } 209 s := tk->cmd(t, cmd); 210 tk->cmd(t,"update"); 211 return s; 212} 213 214notify(num : int,s : string) : string { 215 error=1; 216 case num{ 217 1 => 218 return sys->sprint( 219 "wrong # args: should be \"%s\"",s); 220 * => 221 return s; 222 } 223} 224