ref: 1018d7a7091fd5e0433f501a3474cdc3fec322cc
dir: /appl/wm/samtk.b/
implement Samtk; include "sys.m"; sys: Sys; sprint, FD: import sys; include "draw.m"; draw: Draw; include "samterm.m"; Context, Flayer, Text, Section: import Samterm; include "tkclient.m"; include "samtk.m"; ctxt: ref Context; tk: Tk; tkclient: Tkclient; tksam1 := array[] of { "frame .w", "scrollbar .w.s -command {send scroll}", "text .w.t -width 80w -height 8h", "pack .w.s -side left -fill y", "pack .w.t -fill both -expand 1", "pack .Wm_t -fill x", "pack .w -fill both -expand 1", "pack propagate . 0", }; tkwork1 := array[] of { "frame .w", "scrollbar .w.s -command {send scroll}", "text .w.t -width 80w -height 20h", "pack .w.s -side left -fill y", "pack .w.t -fill both -expand 1", "pack .Wm_t -fill x", "pack .w -fill both -expand 1", "pack propagate . 0", }; tkcmdlist := array[] of { "bind .w.t <Key> {send keys {%A}}", "bind .w.t <Key-\b> {send keys {%A}}", "bind .w.s <ButtonRelease-1> +{send scroll %s %b %y}", "bind .w.t <ButtonPress-1> +{send button1 %s %b %x %y}", "bind .w.t <ButtonRelease-1> +{send button1 %s %b %x %y}", "bind .w.t <Double-ButtonPress-1> {send button1 2 %b %x %y}", "bind .w.t <Double-ButtonRelease-1> {send button1 3 %b %x %y}", "bind .w.t <ButtonPress-2> {.m2 post %x %y; grab set .m2}", "bind .w.t <ButtonPress-3> {.m3 post %x %y; grab set .m3}", "bind . <Configure> {send titlesel resize}", "focus .w.t", "update" }; menuidx := array[2] of {"0","0"}; init(c: ref Context) { ctxt = c; sys = load Sys Sys->PATH; draw = load Draw Draw->PATH; tk = load Tk Tk->PATH; tkclient = load Tkclient Tkclient->PATH; tkclient->init(); scrollpos = scrolllines = 0; } x := 10; y := 10; newflayer(tag, tp: int): ref Flayer { if (ctxt.which != nil) { tk->cmd(ctxt.which.t, ".Wm_t.title configure -background blue; update"); } (t, cmdc) := tkclient->toplevel(ctxt.ctxt.screen, "-borderwidth 1 -relief raised", "SamTerm", Tkclient->Appl); tk->cmd(t, ". configure -x "+string x+" -y "+string y+"; update"); if (x == 10 && y == 10) { y = 200; } else { x += 40; y += 40; } n := chanadd(); ctxt.titlesel[n] = cmdc; tk->namechan(t, ctxt.menu3sel[n], "menu3"); tk->namechan(t, ctxt.menu2sel[n], "menu2"); tk->namechan(t, ctxt.buttonsel[n], "button1"); tk->namechan(t, ctxt.keysel[n], "keys"); tk->namechan(t, ctxt.scrollsel[n], "scroll"); tk->namechan(t, ctxt.titlesel[n], "titlesel"); lines: int; if (tp) { lines = 8; tkclient->tkcmds(t, tksam1); mkmenu2c(t); } else { lines = 20; tkclient->tkcmds(t, tkwork1); mkmenu2(t); } mkmenu3(t); tkclient->tkcmds(t, tkcmdlist); f := ref Flayer( tag, # tag t, # t "SamTerm", # tkwin (0, 0), # scope (0, 0), # dot int tk->cmd(t, ".w.t cget actwidth"), # screen width int tk->cmd(t, ".w.t cget actheight") / lines, # lineheigth lines, # lines (0, 1), # scrollbar -1 # typepoint ); ctxt.flayers[n] = f; return f; } menu2str := array [] of { "cut", "paste", "snarf", "look", # "exch", "send", # storage for last pattern }; menu3str := array [] of { "new", "zerox", "close", "write", }; mkmenu2c(t: ref Tk->Toplevel) { menus := array [NMENU2+1] of string; menus[0] = "menu .m2"; for (i := 0; i < NMENU2; i++) { menus[i+1] = addmenuitem(2, "menu2", menu2str[i]); } tkclient->tkcmds(t, menus); } mkmenu2(t: ref Tk->Toplevel) { menus := array [NMENU2+1] of string; menus[0] = "menu .m2"; for (i := 0; i < NMENU2-1; i++) { menus[i+1] = addmenuitem(2, "menu2", menu2str[i]); } menus[NMENU2] = addmenuitem(2, "edit", "/"); tkclient->tkcmds(t, menus); } mkmenu3(t: ref Tk->Toplevel) { menus := array [NMENU3+len ctxt.menus+1] of string; menus[0] = "menu .m3"; for (i := 0; i < NMENU3; i++) { menus[i+1] = addmenuitem(3, "menu3", menu3str[i]); } for (i = 0; i < len ctxt.menus; i++) { menus[i+NMENU3+1] = addmenuitem(3, "menu3", ctxt.menus[i].name); } tkclient->tkcmds(t, menus); } addmenuitem(d: int, m, s: string): string { return sprint(".m%d add command -text %s -command {send %s %s}", d, s, m, s); } menuins(pos: int, s: string) { for (i := 0; i < len ctxt.flayers; i++) tk->cmd(ctxt.flayers[i].t, sprint(".m3 insert %d command -text %s -command {send menu3 %s}", pos + NMENU3, s, s)); } menudel(pos: int) { for (i := 0; i < len ctxt.flayers; i++) tk->cmd(ctxt.flayers[i].t, sprint(".m3 delete %d", pos + NMENU3)); } hsetpat(s: string) { for (i := 0; i < len ctxt.flayers; i++) { fl := ctxt.flayers[i]; if (fl.tag != ctxt.cmd.tag) { tk->cmd(fl.t, ".m2 entryconfigure " + string Search + " -command {send menu2 search} -text '/" + s); } } } lastsearchstring := "//"; setmenu(num : int,c : string){ fl := ctxt.flayers[num]; (nil, l) := sys->tokenize(c, " "); x1 := int hd l - 50; y1 := int hd tl l - int tk->cmd(fl.t, ".m"+string num+" yposition "+menuidx[num-2]) - 10; tk->cmd(fl.t, ".m"+string num+" activate "+menuidx[num-2]+ "; .m"+string num+" post "+string x1+" "+string y1+ "; grab set .m"+string num+"; update"); } titlectl(win: int, menu: string) { tkclient->wmctl(ctxt.flayers[win].t, menu); } flraise(t: ref Text, fl: ref Flayer) { nfls: list of ref Flayer; nfls = nil; t.flayers = fl :: dellist(t.flayers, fl); tk->cmd(fl.t, "raise .; focus .w.t; update"); } dellist(fls: list of ref Flayer, fl: ref Flayer): list of ref Flayer { if (fls == nil) return nil; if (hd fls == fl) return dellist(tl fls, fl); return hd fls :: dellist(tl fls, fl); } append(fls: list of ref Flayer, fl: ref Flayer): list of ref Flayer { if (fls == nil) return fl :: nil; return hd fls :: append(tl fls, fl); } focus(fl: ref Flayer) { tk->cmd(fl.t, "focus .w.t; update"); } newcur(t: ref Text, fl: ref Flayer) { if (ctxt.which == fl) return; flraise(t, fl); ctxt.which = fl; if (t != ctxt.cmd) ctxt.work = fl; } settitle(t: ref Text, s: string) { sd := ""; sz := ""; if (t.state & Samterm->Dirty) sd = " (Dirty)"; if (t != ctxt.cmd && (t.state & Samterm->LDirty)) sd = " (Modified)"; if (len t.flayers > 1) sz = " (Zeroxed)"; for (fls := t.flayers; fls != nil; fls = tl fls) { fl := hd fls; fl.tkwin = s; tkclient->settitle(fl.t, s + sd + sz); tk->cmd(fl.t, "update"); } } resize(fl: ref Flayer) { fl.lines = int tk->cmd(fl.t, ".w.t cget actheight") / fl.lineheigth; } allflayers(s: string) { for (i := 0; i < len ctxt.texts; i++) for (fls := ctxt.texts[i].flayers; fls != nil; fls = tl fls) { fl := hd fls; tk->cmd(fl.t, s); } } setdot(fl: ref Flayer, l1, l2: int) { tk->cmd(fl.t, ".w.t tag remove sel 0.0 end"); fl.dot.first = l1; fl.dot.last = l2; if (l2 <= fl.scope.first) tk->cmd(fl.t, ".w.t mark set insert 0.0"); else if (fl.scope.last <= l1) tk->cmd(fl.t, ".w.t mark set insert end"); else { tk->cmd(fl.t, sprint(".w.t mark set insert 0.0+%dchars", l1-fl.scope.first)); if (l1 != l2) tk->cmd(fl.t, sprint(".w.t tag add sel 0.0+%dchars 0.0+%dchars", l1-fl.scope.first, l2-fl.scope.first)); } tk->cmd(fl.t, "update"); } panic(s: string) { stderr := sys->fildes(2); sys->fprint(stderr, "Panic: %s\n", s); f := sys->sprint("#p/%d/ctl", ctxt.pgrp); if ((fd := sys->open(f, sys->OWRITE)) != nil) sys->write(fd, array of byte "killgrp\n", 8); exit; } whichmenu(tag: int): int { for (i := 0; i < len ctxt.menus; i++) if (ctxt.menus[i].tag == tag) return i; return -1; } whichtext(tag: int): int { for (i := 0; i < len ctxt.texts; i++) if (ctxt.texts[i].tag == tag) return i; return -1; } setscrollbar(t: ref Text, fl: ref Flayer) { ll := real t.nrunes; f1 := 0.0; f2 := 1.0; if (ll != 0.0) { f1 = real fl.scope.first / ll; if (fl.scope.last > t.nrunes) f2 = 1.0; else f2 = real fl.scope.last / ll; } fl.scrollbar = fl.scope; tk->cmd(fl.t, sprint(".w.s set %f %f; update", f1, f2)); } buttonselect(fl: ref Flayer, s: string): int { tag := fl.tag; if ((i := whichtext(tag)) < 0) panic("buttonselect: whichtext"); t := ctxt.texts[i]; (n, l) := sys->tokenize(s, " "); if (n != 4) panic("buttonselect"); # ignore mouse down -- wait for mouse up if (hd l == "1" || hd l == "3") return 0; if (ctxt.which != fl) { if (ctxt.menus[i].text != ctxt.cmd) ctxt.work = fl; newcur(t, fl); # setdot(fl, fl.dot.first, fl.dot.first); return 0; } if (hd l == "2") { # Double click l = tl tl l; s = tk->cmd(fl.t, ".w.t index @" + hd l + "," + hd tl l); fl.dot.first = fl.dot.last = coord2pos(t, fl, s); return 1; } rg := tk->cmd(fl.t, ".w.t tag ranges sel"); if (rg == "") { # Nothing selected, find insertion point l = tl tl l; s = tk->cmd(fl.t, ".w.t index @" + hd l + "," + hd tl l); fl.dot.first = fl.dot.last = coord2pos(t, fl, s); } else { (n, l) = sys->tokenize(rg, " "); #if (n == 4 && hd tl l == hd tl tl l) # lst := hd tl tl tl l; #else if (n != 2) panic("buttonselect: tag ranges"); #else lst = hd tl l; # We only have one contiguous selection, so, take the # first as dot.first and the last as dot.last fst:=hd l; lst:=fst; while(l!=nil){ lst=hd l; l = tl l; } fl.dot.first = coord2pos(t, fl, fst); fl.dot.last = coord2pos(t, fl, lst); tk->cmd(fl.t, ".w.t mark set insert " + fst); tk->cmd(fl.t, "update"); } return 0; } coord2pos(t: ref Text, fl: ref Flayer, s: string): int { x, y: int; (n, l) := sys->tokenize(s, "."); if (n != 2) panic("coord2pos"); y = (int hd l) - 1; x = int hd tl l; if (x == 0 && y == 0) return fl.scope.first; first := fl.scope.first; for (scts := t.sects; scts != nil; scts = tl scts) { sct := hd scts; if (first >= sct.nrunes) { first -= sct.nrunes; continue; } if (first > 0) i := first; else i = 0; while (i < len sct.text) { if (y) { if (sct.text[i++] == '\n') y--; } else { if (x <= 1) return fl.scope.first - first + i + x; if (sct.text[i++] == '\n') panic("coord2pos"); x--; } } if (len sct.text < sct.nrunes) panic("coord2pos: hole"); first -= sct.nrunes; } if (x <= 0 && y == 0) return t.nrunes; panic("coord2pos: can't find"); return(-1); } scrollpos, scrolllines: int; scroll(fl: ref Flayer, s: string): (int, int) { tag := fl.tag; if ((i := whichtext(tag)) < 0) panic("scroll: whichtext"); t := ctxt.texts[i]; (n, l) := sys->tokenize(s, " "); height := fl.scrollbar.last - fl.scrollbar.first; length := t.nrunes; case (hd l) { "0" => if (n != 3) panic("scroll: format"); return (scrollpos, scrolllines); "moveto" => if (n != 2) panic("scroll: format"); f := real hd tl l; if (f < 0.0) f = 0.0; if (f > 1.0) f = 1.0; scrollpos = int (f * real length) - height/2; scrolllines = 1; "scroll" => if (n != 3) panic("scroll: format"); l = tl l; n = int hd l; case(hd tl l) { "page" => if (n < 0) { scrollpos = fl.scrollbar.first; scrolllines = fl.lines; break; } scrollpos = fl.scrollbar.last; scrolllines = 0; "unit" => if (n < 0) { scrollpos = fl.scrollbar.first - 1; scrolllines = 1; break; } (p, q) := rasplines(t.sects, fl.scrollbar.first, 1); if (p > 0) { scrollpos = p; scrolllines = 0; } else { scrollpos = fl.scrollbar.first; scrolllines = 0; } } * => panic("scroll: input"); } if (scrollpos > length) scrollpos = length; if (scrollpos < 0) { scrollpos = 0; scrolllines = 0; } if (length != 0) tk->cmd(fl.t, sprint(".w.s set %f %f", real scrollpos / real length, real (scrollpos + height) / real length)); else tk->cmd(fl.t, ".w.s set 0.0 1.0"); tk->cmd(fl.t, "update"); return (-1, -1); } flclear(fl: ref Flayer) { tk->cmd(fl.t, ".w.t delete 0.0 end"); tk->cmd(fl.t, "update"); } flinsert(fl: ref Flayer, l: int, s: string) { offset := l-fl.scope.first; tk->cmd(fl.t, ".w.t insert 0.0+" + string offset + "chars '" + s); setdot(fl, fl.dot.first, fl.dot.last); } fldelexcess(fl: ref Flayer) { tk->cmd(fl.t, ".w.t delete " + string (fl.lines+1) + ".0 end"); } fldelete(fl: ref Flayer, l1, l2: int) { s: string; if (l1 <= fl.scope.first) { if (l2 >= fl.scope.last) { s = sprint(".w.t delete 0.0 end"); fl.scope.first = fl.scope.last = l1; } else { s = sprint(".w.t delete 0.0 0.0+%dchars", l2 - fl.scope.first); fl.scope.last -= l2 - l1; fl.scope.first = l1; } } else { if (l2 >= fl.scope.last) { s = sprint(".w.t delete 0.0+%dchars end", l1 - fl.scope.first); fl.scope.last = l1; } else { s = sprint(".w.t delete 0.0+%dchars 0.0+%dchars", l1 - fl.scope.first, l2 - fl.scope.first); fl.scope.last -= l2 - l1; } } if (fl.dot.first >= l2) fl.dot.first -= l2-l1; else if (fl.dot.first > l1) fl.dot.first = l1; if (fl.dot.last >= l2) fl.dot.last -= l2-l1; else if (fl.dot.last > l1) fl.dot.last = l1; tk->cmd(fl.t, s); setdot(fl, fl.dot.first, fl.dot.last); tk->cmd(fl.t, "update"); } # Calculate position forward or backward nlines lines from pos. # If lines > 0 count forward, if lines < 0 count backward.\ # Returns a pair, (position, nlines). Nlines is the remaining # number of lines to be found. If non-zero, beginning or end of # rasp was encountered while still counting, or a hole was # encountered. In the former case, position will be 0 or nrunes, # in the latter case, position will be set to -1. # To search to the beginning of the current line, set nlines to -1; rasplines(scts: list of ref Section, pos, nlines: int): (int, int) { p, i: int; if (nlines < 0) { if (scts != nil) { sct := hd scts; scts = tl scts; if (pos > sct.nrunes) { (p, nlines) = rasplines(scts, pos - sct.nrunes, nlines); if (p < 0) return (p, nlines); pos = p + sct.nrunes; if (nlines == 0) return (pos, 0); } if (pos > len sct.text) return (-1, nlines); for (p = pos-1; p >= 0; p--) { if (sct.text[p] == '\n') nlines++; if (nlines == 0) return (p+1, 0); } } return (0, nlines); } else { p = 0; while (scts != nil) { sct := hd scts; scts = tl scts; if (pos < sct.nrunes) { for (i = pos; i < len sct.text; i++) { if (sct.text[i] == '\n') nlines--; if (nlines == 0) return (p+i+1, 0); } if (i < sct.nrunes) return (-1, nlines); } pos -= sct.nrunes; if (pos < 0) pos = 0; p += sct.nrunes; } return (p, nlines); } } chanadd(): int { l := len ctxt.flayers; keysel := array [l+1] of chan of string; keysel[0:] = ctxt.keysel; keysel[l] = chan of string; ctxt.keysel = keysel; scrollsel := array [l+1] of chan of string; scrollsel[0:] = ctxt.scrollsel; scrollsel[l] = chan of string; ctxt.scrollsel = scrollsel; buttonsel := array [l+1] of chan of string; buttonsel[0:] = ctxt.buttonsel; buttonsel[l] = chan of string; ctxt.buttonsel = buttonsel; menu2sel := array [l+1] of chan of string; menu2sel[0:] = ctxt.menu2sel; menu2sel[l] = chan of string; ctxt.menu2sel = menu2sel; menu3sel := array [l+1] of chan of string; menu3sel[0:] = ctxt.menu3sel; menu3sel[l] = chan of string; ctxt.menu3sel = menu3sel; titlesel := array [l+1] of chan of string; titlesel[0:] = ctxt.titlesel; titlesel[l] = chan of string; ctxt.titlesel = titlesel; flayers := array [l+1] of ref Flayer; flayers[0:] = ctxt.flayers; flayers[l] = nil; ctxt.flayers = flayers; return l; } chandel(n: int) { l := len ctxt.flayers; if (n >= l) panic("chandel"); keysel := array [l-1] of chan of string; keysel[0:] = ctxt.keysel[0:n]; keysel[n:] = ctxt.keysel[n+1:]; ctxt.keysel = keysel; scrollsel := array [l-1] of chan of string; scrollsel[0:] = ctxt.scrollsel[0:n]; scrollsel[n:] = ctxt.scrollsel[n+1:]; ctxt.scrollsel = scrollsel; buttonsel := array [l-1] of chan of string; buttonsel[0:] = ctxt.buttonsel[0:n]; buttonsel[n:] = ctxt.buttonsel[n+1:]; ctxt.buttonsel = buttonsel; menu2sel := array [l-1] of chan of string; menu2sel[0:] = ctxt.menu2sel[0:n]; menu2sel[n:] = ctxt.menu2sel[n+1:]; ctxt.menu2sel = menu2sel; menu3sel := array [l-1] of chan of string; menu3sel[0:] = ctxt.menu3sel[0:n]; menu3sel[n:] = ctxt.menu3sel[n+1:]; ctxt.menu3sel = menu3sel; titlesel := array [l-1] of chan of string; titlesel[0:] = ctxt.titlesel[0:n]; titlesel[n:] = ctxt.titlesel[n+1:]; ctxt.titlesel = titlesel; flayers := array [l-1] of ref Flayer; flayers[0:] = ctxt.flayers[0:n]; flayers[n:] = ctxt.flayers[n+1:]; ctxt.flayers = flayers; }