1implement Titlebar; 2include "sys.m"; 3 sys: Sys; 4include "draw.m"; 5 draw: Draw; 6 Point, Rect: import draw; 7include "tk.m"; 8 tk: Tk; 9include "titlebar.m"; 10 11title_cfg := array[] of { 12 "frame .Wm_t -bg #aaaaaa -borderwidth 1", 13 "label .Wm_t.title -anchor w -bg #aaaaaa -fg white", 14 "button .Wm_t.e -bitmap exit.bit -command {send wm_title exit} -takefocus 0", 15 "pack .Wm_t.e -side right", 16 "bind .Wm_t <Button-1> {send wm_title move %X %Y}", 17 "bind .Wm_t <Double-Button-1> {send wm_title lower .}", 18 "bind .Wm_t <Motion-Button-1> {}", 19 "bind .Wm_t <Motion> {}", 20 "bind .Wm_t.title <Button-1> {send wm_title move %X %Y}", 21 "bind .Wm_t.title <Double-Button-1> {send wm_title lower .}", 22 "bind .Wm_t.title <Motion-Button-1> {}", 23 "bind .Wm_t.title <Motion> {}", 24 "bind . <FocusIn> {.Wm_t configure -bg blue;"+ 25 ".Wm_t.title configure -bg blue;update}", 26 "bind . <FocusOut> {.Wm_t configure -bg #aaaaaa;"+ 27 ".Wm_t.title configure -bg #aaaaaa;update}", 28}; 29 30init() 31{ 32 sys = load Sys Sys->PATH; 33 draw = load Draw Draw->PATH; 34 tk = load Tk Tk->PATH; 35} 36 37new(top: ref Tk->Toplevel, buts: int): chan of string 38{ 39 ctl := chan of string; 40 tk->namechan(top, ctl, "wm_title"); 41 42 if(buts & Plain) 43 return ctl; 44 45 for(i := 0; i < len title_cfg; i++) 46 cmd(top, title_cfg[i]); 47 48 if(buts & OK) 49 cmd(top, "button .Wm_t.ok -bitmap ok.bit"+ 50 " -command {send wm_title ok} -takefocus 0; pack .Wm_t.ok -side right"); 51 52 if(buts & Hide) 53 cmd(top, "button .Wm_t.top -bitmap task.bit"+ 54 " -command {send wm_title task} -takefocus 0; pack .Wm_t.top -side right"); 55 56 if(buts & Resize) 57 cmd(top, "button .Wm_t.m -bitmap maxf.bit"+ 58 " -command {send wm_title size} -takefocus 0; pack .Wm_t.m -side right"); 59 60 if(buts & Help) 61 cmd(top, "button .Wm_t.h -bitmap help.bit"+ 62 " -command {send wm_title help} -takefocus 0; pack .Wm_t.h -side right"); 63 64 # pack the title last so it gets clipped first 65 cmd(top, "pack .Wm_t.title -side left"); 66 cmd(top, "pack .Wm_t -fill x"); 67 68 return ctl; 69} 70 71title(top: ref Tk->Toplevel): string 72{ 73 if(tk->cmd(top, "winfo class .Wm_t.title")[0] != '!') 74 return cmd(top, ".Wm_t.title cget -text"); 75 return nil; 76} 77 78settitle(top: ref Tk->Toplevel, t: string): string 79{ 80 s := title(top); 81 tk->cmd(top, ".Wm_t.title configure -text '" + t); 82 return s; 83} 84 85sendctl(top: ref Tk->Toplevel, c: string) 86{ 87 cmd(top, "send wm_title " + c); 88} 89 90minsize(top: ref Tk->Toplevel): Point 91{ 92 buts := array[] of {"e", "ok", "top", "m", "h"}; 93 r := tk->rect(top, ".", Tk->Border); 94 r.min.x = r.max.x; 95 r.max.y = r.min.y; 96 for(i := 0; i < len buts; i++){ 97 br := tk->rect(top, ".Wm_t." + buts[i], Tk->Border); 98 if(br.dx() > 0) 99 r = r.combine(br); 100 } 101 r.max.x += tk->rect(top, ".Wm_t." + buts[0], Tk->Border).dx(); 102 return r.size(); 103} 104 105cmd(top: ref Tk->Toplevel, s: string): string 106{ 107 e := tk->cmd(top, s); 108 if (e != nil && e[0] == '!') 109 sys->fprint(sys->fildes(2), "wmclient: tk error %s on '%s'\n", e, s); 110 return e; 111} 112