1implement Tabs; 2 3# pseudo-widget for folder tab selections 4 5# 6# Copyright © 1996-1999 Lucent Technologies Inc. All rights reserved. 7# Revisions Copyright © 2000-2002 Vita Nuova Holdings Limited. All rights reserved. 8# 9 10include "sys.m"; 11 sys: Sys; 12 13include "draw.m"; 14 15include "tk.m"; 16 tk: Tk; 17 18include "string.m"; 19 str: String; # could load on demand 20 21include "tabs.m"; 22 23TABSXdelta : con 2; 24TABSXslant : con 5; 25TABSXoff : con 5; 26TABSYheight : con 35; 27TABSYtop : con 10; 28TABSBord : con 1; 29 30init() 31{ 32 sys = load Sys Sys->PATH; 33 tk = load Tk Tk->PATH; 34 str = load String String->PATH; 35} 36 37mktabs(t: ref Tk->Toplevel, dot: string, tabs: array of (string, string), dflt: int): chan of string 38{ 39 lab, widg: string; 40 cmd(t, "canvas "+dot+" -height "+string TABSYheight); 41 cmd(t, "pack propagate "+dot+" 0"); 42 c := chan of string; 43 tk->namechan(t, c, dot[1:]); 44 xpos := 2*TABSXdelta; 45 ypos := TABSYheight - 3; 46 back := cmd(t, dot+" cget -background"); 47 dark := "#999999"; 48 light := "#ffffff"; 49 w := 20; 50 h := 30; 51 last := ""; 52 for(i := 0; i < len tabs; i++){ 53 (lab, widg) = tabs[i]; 54 tag := "tag" + string i; 55 sel := "sel" + string i; 56 xs := xpos; 57 xpos += TABSXslant + TABSXoff; 58 v := cmd(t, dot+" create text "+string xpos+" "+string ypos+" -text "+tk->quote(lab)+" -anchor sw -tags "+tag); 59 bbox := tk->cmd(t, dot+" bbox "+tag); 60 if(bbox[0] == '!') 61 break; 62 (r, nil) := parserect(bbox); 63 r.max.x += TABSXoff; 64 x1 := " "+string xs; 65 x2 := " "+string(xs + TABSXslant); 66 x3 := " "+string r.max.x; 67 x4 := " "+string(r.max.x + TABSXslant); 68 y1 := " "+string(TABSYheight - 2); 69 y2 := " "+string TABSYtop; 70 cmd(t, dot+" create polygon " + x1+y1 + x2+y2 + x3+y2 + x4+y1 + 71 " -fill "+back+" -tags "+tag); 72 cmd(t, dot+" create line " + x3+y2 + x4+y1 + 73 " -fill "+dark+" -width 1 -tags "+tag); 74 cmd(t, dot+" create line " + x1+y1 + x2+y2 + x3+y2 + 75 " -fill "+light+" -width 1 -tags "+tag); 76 77 x1 = " "+string(xs+2); 78 x4 = " "+string(r.max.x + TABSXslant - 2); 79 y1 = " "+string(TABSYheight); 80 cmd(t, dot+" create line " + x1+y1 + x4+y1 + 81 " -fill "+back+" -width 2 -tags "+sel); 82 83 cmd(t, dot+" raise "+v); 84 cmd(t, dot+" bind "+tag+" <ButtonRelease-1> 'send "+ 85 dot[1:]+" "+string i); 86 87 cmd(t, dot+" lower "+tag+" "+last); 88 last = tag; 89 90 xpos = r.max.x; 91 ww := int cmd(t, widg+" cget -width"); 92 wh := int cmd(t, widg+" cget -height"); 93 if(wh > h) 94 h = wh; 95 if(ww > w) 96 w = ww; 97 } 98 xpos += 4*TABSXslant; 99 if(w < xpos) 100 w = xpos; 101 102 for(i = 0; i < len tabs; i++){ 103 (nil, widg) = tabs[i]; 104 cmd(t, "pack propagate "+widg+" 0"); 105 cmd(t, widg+" configure -width "+string w+" -height "+string h); 106 } 107 108 w += 2*TABSBord; 109 h += 2*TABSBord + TABSYheight; 110 111 cmd(t, dot+" create line 0 "+string TABSYheight+ 112 " "+string w+" "+string TABSYheight+" -width 2 -fill "+light); 113 cmd(t, dot+" create line 1 "+string TABSYheight+ 114 " 1 "+string(h-1)+" -width 2 -fill "+light); 115 cmd(t, dot+" create line 0 "+string(h-1)+ 116 " "+string w+" "+string(h-1)+" -width 2 -fill "+dark); 117 cmd(t, dot+" create line "+string(w-1)+" "+string TABSYheight+ 118 " "+string(w-1)+" "+string(h-1)+" -width 2 -fill "+dark); 119 120 cmd(t, dot+" configure -width "+string w+" -height "+string h); 121 cmd(t, dot+" configure -scrollregion {0 0 "+string w+" "+string h+"}"); 122 tabsctl(t, dot, tabs, -1, string dflt); 123 return c; 124} 125 126tabsctl(t: ref Tk->Toplevel, 127 dot: string, 128 tabs: array of (string, string), 129 id: int, 130 s: string): int 131{ 132 lab, widg: string; 133 134 nid := int s; 135 if(id == nid) 136 return id; 137 if(id >= 0){ 138 (lab, widg) = tabs[id]; 139 tag := "tag" + string id; 140 cmd(t, dot+" lower sel" + string id); 141# pos := cmd(t, dot+" coords " + tag); 142# if(len pos >= 1 && pos[0] != '!'){ 143# (p, nil) := parsept(pos); 144# cmd(t, dot+" coords "+tag+" "+string(p.x+1)+ 145# " "+string(p.y+1)); 146# } 147 if(id > 0) 148 cmd(t, dot+" lower "+ tag + " tag"+string (id - 1)); 149 cmd(t, dot+" delete win" + string id); 150 } 151 id = nid; 152 (lab, widg) = tabs[id]; 153# pos := tk->cmd(t, dot+" coords tag" + string id); 154# if(len pos >= 1 && pos[0] != '!'){ 155# (p, nil) := parsept(pos); 156# cmd(t, dot+" coords tag"+string id+" "+string(p.x-1)+" "+string(p.y-1)); 157# } 158 cmd(t, dot+" raise tag"+string id); 159 cmd(t, dot+" raise sel"+string id); 160 cmd(t, dot+" create window "+string TABSBord+" "+ 161 string(TABSYheight+TABSBord)+" -window "+widg+" -anchor nw -tags win"+string id); 162 cmd(t, "update"); 163 return id; 164} 165 166parsept(s: string): (Draw->Point, string) 167{ 168 p: Draw->Point; 169 170 (p.x, s) = str->toint(s, 10); 171 (p.y, s) = str->toint(s, 10); 172 return (p, s); 173} 174 175parserect(s: string): (Draw->Rect, string) 176{ 177 r: Draw->Rect; 178 179 (r.min, s) = parsept(s); 180 (r.max, s) = parsept(s); 181 return (r, s); 182} 183 184cmd(top: ref Tk->Toplevel, s: string): string 185{ 186 e := tk->cmd(top, s); 187 if (e != nil && e[0] == '!') 188 sys->fprint(sys->fildes(2), "%s: tk error %s on [%s]\n", PATH, e, s); 189 return e; 190} 191