ref: a411870ee4640241e3c494367d922847da84f972
dir: purgatorio/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, "-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;
tkcmds(t, tksam1);
mkmenu2c(t);
} else {
lines = 20;
tkcmds(t, tkwork1);
mkmenu2(t);
}
mkmenu3(t);
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]);
}
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", "/");
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);
}
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;
}
tkcmd(t: ref Tk->Toplevel, s: string): string
{
res := tk->cmd(t, s);
return res;
}
tkcmds(top: ref Tk->Toplevel, a: array of string)
{
for(i := 0; i < len a; i++)
v := tkcmd(top, a[i]);
}