1implement Popup; 2include "sys.m"; 3 sys: Sys; 4include "draw.m"; 5 Point: import Draw; 6include "tk.m"; 7 tk: Tk; 8include "popup.m"; 9 10init() 11{ 12 sys = load Sys Sys->PATH; 13 tk = load Tk Tk->PATH; 14} 15 16post(win: ref Tk->Toplevel, p: Point, a: array of string, n: int): chan of int 17{ 18 rc := chan of int; 19 spawn postproc(win, p, a, n, rc); 20 return rc; 21} 22 23postproc(win: ref Tk->Toplevel, p: Point, a: array of string, n: int, rc: chan of int) 24{ 25 c := chan of string; 26 tk->namechan(win, c, "c.popup"); 27 mkpopupmenu(win, a); 28 cmd(win, ".popup entryconfigure " + string n + " -state active"); 29 cmd(win, "bind .popup <Unmap> {send c.popup unmap}"); 30 31 dy := ypos(win, n) - ypos(win, 0); 32 p.y -= dy; 33 cmd(win, ".popup post " + string p.x + " " + string p.y + 34 ";grab set .popup"); 35 n = -1; 36 while ((e := <-c) != "unmap") 37 n = int e; 38 39 cmd(win, "destroy .popup"); 40 rc <-= n; 41} 42 43mkpopupmenu(win: ref Tk->Toplevel, a: array of string) 44{ 45 cmd(win, "menu .popup"); 46 for (i := 0; i < len a; i++) { 47 cmd(win, ".popup add command -command {send c.popup " + string i + 48 "} -text '" + a[i]); 49 } 50} 51 52Blank: con "-----"; 53 54# XXX what should we do about popups containing no items. 55mkbutton(win: ref Tk->Toplevel, w: string, a: array of string, n: int): chan of string 56{ 57 c := chan of string; 58 if (len a == 0) { 59 cmd(win, "label " + w + " -bd 2 -relief raised -text '" + Blank); 60 return c; 61 } 62 tk->namechan(win, c, "c" + w); 63 mkpopupmenu(win, a); 64 cmd(win, "label " + w + " -bd 2 -relief raised -width [.popup cget -width] -text '" + a[n]); 65 cmd(win, "bind " + w + " <Button-1> {send c" + w + " " + w + "}"); 66 cmd(win, "destroy .popup"); 67 return c; 68} 69 70changebutton(win: ref Tk->Toplevel, w: string, a: array of string, n: int) 71{ 72 if (len a > 0) { 73 mkpopupmenu(win, a); 74 cmd(win, w + " configure -width [.popup cget -width] -text '" + a[n]); 75 cmd(win, "bind " + w + " <Button-1> {send c" + w + " " + w + "}"); 76 cmd(win, "destroy .popup"); 77 } else { 78 cmd(win, w + " configure -text '" + Blank); 79 cmd(win, "bind " + w + " <Button-1> {}"); 80 } 81} 82 83add(a: array of string, s: string): (array of string, int) 84{ 85 for (i := 0; i < len a; i++) 86 if (s == a[i]) 87 return (a, i); 88 na := array[len a + 1] of string; 89 na[0:] = a; 90 na[len a] = s; 91 return (na, len a); 92} 93 94#event(win: ref Tk->Toplevel, e: string, a: array of string): int 95#{ 96# w := e; 97# p := Point(int cmd(win, w + " cget -actx"), int cmd(win, w + " cget -acty")); 98# s := cmd(win, w + " cget -text"); 99# for (i := 0; i < len a; i++) 100# if (s == a[i]) 101# break; 102# if (i == len a) 103# i = 0; 104# 105# n := post(win, p, a, i); 106# if (n != -1) { 107# cmd(win, w + " configure -text '" + a[n]); 108# i = n; 109# } 110# return i; 111#} 112 113ypos(win: ref Tk->Toplevel, n: int): int 114{ 115 return int cmd(win, ".popup yposition " + string n); 116} 117 118cmd(win: ref Tk->Toplevel, s: string): string 119{ 120 r := tk->cmd(win, s); 121 if (len r > 0 && r[0] == '!') 122 sys->print("error executing '%s': %s\n", s, r[1:]); 123 return r; 124} 125