summaryrefslogtreecommitdiff
path: root/appl/wm/man.b
diff options
context:
space:
mode:
Diffstat (limited to 'appl/wm/man.b')
-rw-r--r--appl/wm/man.b769
1 files changed, 769 insertions, 0 deletions
diff --git a/appl/wm/man.b b/appl/wm/man.b
new file mode 100644
index 00000000..89b4d12f
--- /dev/null
+++ b/appl/wm/man.b
@@ -0,0 +1,769 @@
+implement WmMan;
+
+include "sys.m";
+ sys: Sys;
+include "draw.m";
+ draw: Draw;
+include "tk.m";
+ tk: Tk;
+include "tkclient.m";
+ tkclient: Tkclient;
+include "plumbmsg.m";
+include "man.m";
+ man: Man;
+
+WmMan: module {
+ init: fn (ctxt: ref Draw->Context, argv: list of string);
+};
+
+window: ref Tk->Toplevel;
+
+W: adt {
+ textwidth: fn(nil: self ref W, text: Parseman->Text): int;
+};
+
+ROMAN: con "/fonts/lucidasans/unicode.7.font";
+BOLD: con "/fonts/lucidasans/typelatin1.7.font";
+ITALIC: con "/fonts/lucidasans/italiclatin1.7.font";
+HEADING1: con "/fonts/lucidasans/boldlatin1.7.font";
+HEADING2: con "/fonts/lucidasans/italiclatin1.7.font";
+rfont, bfont, ifont, h1font, h2font: ref Draw->Font;
+
+GOATTR: con Parseman->ATTR_LAST << iota;
+MANPATH: con "/man/1/man";
+INDENT: con 40;
+
+metrics: Parseman->Metrics;
+parser: Parseman;
+
+
+tkconfig := array [] of {
+ "frame .input",
+ "frame .view",
+ "text .view.t -state disabled -width 0 -height 0 -bg white -yscrollcommand {.view.yscroll set} -xscrollcommand {.view.xscroll set}",
+ "scrollbar .view.yscroll -orient vertical -command {.view.t yview}",
+ "scrollbar .view.xscroll -orient horizontal -command {.view.t xview}",
+ "entry .input.e -bg white",
+ "button .input.back -state disabled -bitmap small_color_left.bit -command {send nav b}",
+ "button .input.forward -state disabled -bitmap small_color_right.bit -command {send nav f}",
+
+ "pack .input.back .input.forward -side left -anchor w",
+ "pack .input.e -expand 1 -fill x",
+
+ "pack .view.yscroll -fill y -side left",
+ "pack .view.t -expand 1 -fill both",
+
+ "bind .input.e <Key-\n> {send nav e}",
+ "bind .input.e <Button-1> +{grab set .input.e}",
+ "bind .input.e <ButtonRelease-1> +{grab release .input.e}",
+ "bind .view.t <Button-1> +{grab set .view.t}",
+ "bind .view.t <ButtonRelease-1> +{grab release .view.t}",
+ "bind .view.t <ButtonRelease-3> {send plumb %x %y}",
+
+ "pack .input -fill x",
+ "pack .view -expand 1 -fill both",
+ "pack propagate . 0",
+ ". configure -width 500 -height 500",
+ "focus .input.e",
+};
+
+History: adt {
+ prev: cyclic ref History;
+ next: cyclic ref History;
+ topline: string;
+ searchstart: string;
+ searchend: string;
+ pick {
+ Search =>
+ search: list of string;
+ Go =>
+ path: string;
+ }
+};
+
+history: ref History;
+
+
+init(ctxt: ref Draw->Context, argv: list of string)
+{
+ doplumb := 0;
+
+ sys = load Sys Sys->PATH;
+ if (ctxt == nil) {
+ sys->fprint(sys->fildes(2), "man: no window context\n");
+ raise "fail:bad context";
+ }
+ sys->pctl(Sys->NEWPGRP, nil);
+
+ draw = load Draw Draw->PATH;
+ if (draw == nil)
+ loaderr("Draw");
+
+ tk = load Tk Tk->PATH;
+ if (tk == nil)
+ loaderr(Tk->PATH);
+
+ man = load Man Man->PATH;
+ if (man == nil)
+ loaderr(Man->PATH);
+
+ tkclient = load Tkclient Tkclient->PATH;
+ if (tkclient == nil)
+ loaderr(Tkclient->PATH);
+
+ parser = load Parseman Parseman->PATH;
+ if (parser == nil)
+ loaderr(Parseman->PATH);
+ parser->init();
+
+ plumber := load Plumbmsg Plumbmsg->PATH;
+ if (plumber != nil) {
+ if (plumber->init(1, nil, 0) >= 0)
+ doplumb = 1;
+ }
+
+ argv = tl argv;
+
+ rfont = draw->(Draw->Font).open(ctxt.display, ROMAN);
+ bfont = draw->(Draw->Font).open(ctxt.display, BOLD);
+ ifont = draw->(Draw->Font).open(ctxt.display, ITALIC);
+ h1font = draw->(Draw->Font).open(ctxt.display, HEADING1);
+ h2font = draw->(Draw->Font).open(ctxt.display, HEADING2);
+
+ em := draw->rfont.width("m");
+ en := draw->rfont.width("n");
+ metrics = Parseman->Metrics(490, 80, em, en, 14, 40, 20);
+
+ tkclient->init();
+ buts := Tkclient->Resize | Tkclient->Hide;
+ winctl: chan of string;
+ (window, winctl) = tkclient->toplevel(ctxt, nil, "Man", buts);
+ nav := chan of string;
+ plumb := chan of string;
+ tk->namechan(window, nav, "nav");
+ tk->namechan(window, plumb, "plumb");
+ for(tc:=0; tc<len tkconfig; tc++)
+ tkcmd(window, tkconfig[tc]);
+ if ((err := tkcmd(window, "variable lasterror")) != nil) {
+ sys->fprint(sys->fildes(2), "man: tk initialization failed: %s\n", err);
+ raise "fail:tk";
+ }
+ fittoscreen(window);
+ tkcmd(window, "update");
+ mktags();
+
+ vw := int tkcmd(window, ".view.t cget -actwidth") - 10;
+ if (vw <= 0)
+ vw = 1;
+ metrics.pagew = vw;
+
+ linechan := chan of list of (int, Parseman->Text);
+ man->loadsections(nil);
+
+ pidc := chan of int;
+
+ if (argv != nil) {
+ if (hd argv == "-f") {
+ first: ref History;
+ for (argv = tl argv; argv != nil; argv = tl argv) {
+ hnode := ref History.Go(history, nil, "", "", "", hd argv);
+ if (history != nil)
+ history.next = hnode;
+ history = hnode;
+ if (first == nil)
+ first = history;
+ }
+ history = first;
+ } else
+ history = ref History.Search(nil, nil, "", "", "", argv);
+ }
+
+ if (history == nil)
+ history = ref History.Go(nil, nil, "", "", "", MANPATH);
+
+ setbuttons();
+ spawn printman(pidc, linechan, history);
+ layoutpid := <- pidc;
+ tkclient->onscreen(window, nil);
+ tkclient->startinput(window, "kbd"::"ptr"::nil);
+ for (;;) alt {
+ s := <-window.ctxt.kbd =>
+ tk->keyboard(window, s);
+ s := <-window.ctxt.ptr =>
+ tk->pointer(window, *s);
+ s := <-window.ctxt.ctl or
+ s = <-window.wreq or
+ s = <-winctl =>
+ e := tkclient->wmctl(window, s);
+ if (e == nil && s[0] == '!') {
+ topline := tkcmd(window, ".view.t yview");
+ (nil, toptoks) := sys->tokenize(topline, " ");
+ if (toptoks != nil)
+ history.topline = hd toptoks;
+ vw = int tkcmd(window, ".view.t cget -actwidth") - 10;
+ if (vw <= 0)
+ vw = 1;
+ if (vw != metrics.pagew) {
+ if (layoutpid != -1)
+ kill(layoutpid);
+ metrics.pagew = vw;
+ tkcmd(window, ".view.t delete 1.0 end");
+ tkcmd(window, "update");
+ spawn printman(pidc, linechan, history);
+ layoutpid = <- pidc;
+ }
+ }
+ line := <- linechan =>
+ if (line == nil) {
+ # layout done
+ if (history.topline != "") {
+ topline := tkcmd(window, ".view.t yview");
+ (nil, toptoks) := sys->tokenize(topline, " ");
+ if (toptoks != nil)
+ if (hd toptoks == "0")
+ tkcmd(window, ".view.t yview moveto " + history.topline);
+ }
+ tkcmd(window, "update");
+ } else
+ setline(line);
+ go := <- nav =>
+ topline := tkcmd(window, ".view.t yview");
+ (nil, toptoks) := sys->tokenize(topline, " ");
+ if (toptoks != nil)
+ history.topline = hd toptoks;
+ case go[0] {
+ 'f' =>
+ # forward
+ history = history.next;
+ setbuttons();
+ if (layoutpid != -1)
+ kill(layoutpid);
+ tkcmd(window, ".view.t delete 1.0 end");
+ tkcmd(window, "update");
+ spawn printman(pidc, linechan, history);
+ layoutpid = <- pidc;
+ 'b' =>
+ # back
+ history = history.prev;
+ setbuttons();
+ if (layoutpid != -1)
+ kill(layoutpid);
+ tkcmd(window, ".view.t delete 1.0 end");
+ tkcmd(window, "update");
+ spawn printman(pidc, linechan, history);
+ layoutpid = <- pidc;
+ 'e' or 'l' =>
+ t := "";
+ if (go[0] == 'l') {
+ # link
+ t = go[1:];
+ } else {
+ # entry
+ t = tkcmd(window, ".input.e get");
+ for (i := 0; i < len t; i++)
+ if (!(t[i] == ' ' || t[i] == '\t'))
+ break;
+ if (i == len t)
+ break;
+ t = t[i:];
+ if (t[0] == '/' || t[0] == '?') {
+ search(t);
+ break;
+ }
+ }
+ (n, toks) := sys->tokenize(t, " \t");
+ if (n == 0)
+ continue;
+ h := ref History.Search(history, nil, "", "", "", toks);
+ history.next = h;
+ history = h;
+ setbuttons();
+ if (layoutpid != -1)
+ kill(layoutpid);
+ tkcmd(window, ".view.t delete 1.0 end");
+ tkcmd(window, "update");
+ spawn printman(pidc, linechan, history);
+ layoutpid = <- pidc;
+ 'g' =>
+ # goto file
+ h := ref History.Go(history, nil, "", "", "", go[1:]);
+ history.next = h;
+ history = h;
+ setbuttons();
+ if (layoutpid != 0)
+ kill(layoutpid);
+ tkcmd(window, ".view.t delete 1.0 end");
+ tkcmd(window, "update");
+ spawn printman(pidc, linechan, history);
+ layoutpid = <- pidc;
+ }
+ p := <- plumb =>
+ if (!doplumb)
+ break;
+ (nil, l) := sys->tokenize(p, " ");
+ x := int hd l;
+ y := int hd tl l;
+ index := tkcmd(window, ".view.t index @"+string x+","+string y);
+ selindex := tkcmd(window, ".view.t tag ranges sel");
+ insel := 0;
+ if(selindex != "")
+ insel = tkcmd(window, ".view.t compare sel.first <= "+index)=="1" &&
+ tkcmd(window, ".view.t compare sel.last >= "+index)=="1";
+ text := "";
+ attr := "";
+ if (insel)
+ text = tkcmd(window, ".view.t get sel.first sel.last");
+ else{
+ # have line with text in it
+ # now extract whitespace-bounded string around click
+ (nil, w) := sys->tokenize(index, ".");
+ charno := int hd tl w;
+ left := tkcmd(window, ".view.t index {"+index+" linestart}");
+ right := tkcmd(window, ".view.t index {"+index+" lineend}");
+ line := tkcmd(window, ".view.t get "+left+" "+right);
+ for(i:=charno; i>0; --i)
+ if(line[i-1]==' ' || line[i-1]=='\t')
+ break;
+ for(j:=charno; j<len line; j++)
+ if(line[j]==' ' || line[j]=='\t')
+ break;
+ text = line[i:j];
+ attr = "click="+string (charno-i);
+ }
+ msg := ref Plumbmsg->Msg(
+ "WmMan",
+ "",
+ "",
+ "text",
+ attr,
+ array of byte text);
+ plumber->msg.send();
+
+ layoutpid = <- pidc =>
+ ;
+ }
+}
+
+search(pat: string)
+{
+ dir: string;
+ start: string;
+ if (pat[0] == '/') {
+ dir = "-forwards";
+ start = history.searchend;
+ } else {
+ dir = "-backwards";
+ start = history.searchstart;
+ }
+ pat = pat[1:];
+ if (start == "")
+ start = "1.0";
+ r := tkcmd(window, ".view.t search " + dir + " -- " + tk->quote(pat) + " " + start);
+ if (r != nil) {
+ history.searchstart = r;
+ history.searchend = r + "+" + string len pat + "c";
+ tkcmd(window, ".view.t tag remove sel 1.0 end");
+ tkcmd(window, ".view.t tag add sel " + history.searchstart + " " + history.searchend);
+ tkcmd(window, ".view.t see " + r);
+ tkcmd(window, "update");
+ }
+}
+
+setbuttons()
+{
+ if (history.prev == nil)
+ tkcmd(window, ".input.back configure -state disabled");
+ else
+ tkcmd(window, ".input.back configure -state normal");
+ if (history.next == nil)
+ tkcmd(window, ".input.forward configure -state disabled");
+ else
+ tkcmd(window, ".input.forward configure -state normal");
+}
+
+dolayout(linechan: chan of list of (int, Parseman->Text), path: string)
+{
+ fd := sys->open(path, Sys->OREAD);
+ if (fd == nil) {
+ layouterror(linechan, sys->sprint("cannot open file %s: %r", path));
+ return;
+ }
+ w: ref W;
+ parser->parseman(fd, metrics, 0, w, linechan);
+}
+
+printman(pidc: chan of int, linechan: chan of list of (int, Parseman->Text), h: ref History)
+{
+ pidc <-= sys->pctl(0, nil);
+ args: list of string;
+ pick hp := h {
+ Search =>
+ args = hp.search;
+ Go =>
+ dolayout(linechan, hp.path);
+ pidc <-= -1;
+ return;
+ }
+ sections: list of string;
+ argstext := "";
+ addsections := 1;
+ keywords: list of string;
+ for (; args != nil; args = tl args) {
+ arg := hd args;
+ if (arg == nil)
+ continue;
+ if (addsections && !isint(arg)) {
+ addsections = 0;
+ keywords = args;
+ }
+ if (addsections)
+ sections = arg :: sections;
+ argstext = argstext + " " + arg;
+ }
+ manpages := man->getfiles(sections, keywords);
+ pagelist := sortpages(manpages);
+ if (len pagelist == 1) {
+ (nil, path, nil) := hd pagelist;
+ dolayout(linechan, path);
+ pidc <-= -1;
+ return;
+ }
+
+ tt := Parseman->Text(Parseman->FONT_ROMAN, 0, "Search:", 1, nil);
+ at := Parseman->Text(Parseman->FONT_BOLD, 0, argstext, 0, nil);
+ linechan <-= (0, tt)::(0, at)::nil;
+ tt.text = "";
+ linechan <-= (0, tt)::nil;
+
+ if (pagelist == nil) {
+ donet := Parseman->Text(Parseman->FONT_ROMAN, 0, "No matches", 0, nil);
+ linechan <-= (INDENT, donet) :: nil;
+ linechan <-= nil;
+ pidc <-= -1;
+ return;
+ }
+
+ linelist: list of list of Parseman->Text;
+ pathlist: list of Parseman->Text;
+
+ maxkwlen := 0;
+ comma := Parseman->Text(Parseman->FONT_ROMAN, 0, ", ", 0, "");
+ for (; pagelist != nil; pagelist = tl pagelist) {
+ (n, p, kwl) := hd pagelist;
+ l := 0;
+ keywords: list of Parseman->Text = nil;
+ for (; kwl != nil; kwl = tl kwl) {
+ kw := hd kwl;
+ kwt := Parseman->Text(Parseman->FONT_ITALIC, GOATTR, kw, 0, p);
+ nt := Parseman->Text(Parseman->FONT_ROMAN, GOATTR, "(" + string n + ")", 0, p);
+ l += textwidth(kwt) + textwidth(nt);
+ if (keywords != nil) {
+ l += textwidth(comma);
+ keywords = nt :: kwt :: comma :: keywords;
+ } else
+ keywords = nt :: kwt :: nil;
+ }
+ if (l > maxkwlen)
+ maxkwlen = l;
+ linelist = keywords :: linelist;
+ ptext := Parseman->Text(Parseman->FONT_ROMAN, GOATTR, p, 0, "");
+ pathlist = ptext :: pathlist;
+ }
+
+ for (; pathlist != nil; (pathlist, linelist) = (tl pathlist, tl linelist)) {
+ line := (10 + INDENT + maxkwlen, hd pathlist) :: nil;
+ for (ll := hd linelist; ll != nil; ll = tl ll) {
+ litem := hd ll;
+ if (tl ll == nil)
+ line = (INDENT, litem) :: line;
+ else
+ line = (0, litem) :: line;
+ }
+ linechan <-= line;
+ }
+ linechan <-= nil;
+ pidc <-= -1;
+}
+
+layouterror(linechan: chan of list of (int, Parseman->Text), msg: string)
+{
+ text := "ERROR: " + msg;
+ t := Parseman->Text(Parseman->FONT_ROMAN, 0, text, 0, nil);
+ linechan <-= (0, t)::nil;
+ linechan <-= nil;
+}
+
+loaderr(modname: string)
+{
+ sys->print("cannot load %s module: %r\n", modname);
+ raise "fail:init";
+}
+
+W.textwidth(nil: self ref W, text: Parseman->Text): int
+{
+ return textwidth(text);
+}
+
+textwidth(text: Parseman->Text): int
+{
+ f: ref Draw->Font;
+ if (text.heading == 1)
+ f = h1font;
+ else if (text.heading == 2)
+ f = h2font;
+ else {
+ case text.font {
+ Parseman->FONT_ROMAN =>
+ f = rfont;
+ Parseman->FONT_BOLD =>
+ f = bfont;
+ Parseman->FONT_ITALIC =>
+ f = ifont;
+ * =>
+ return 8 * len text.text;
+ }
+ }
+ return draw->f.width(text.text);
+}
+
+lnum := 0;
+
+setline(line: list of (int, Parseman->Text))
+{
+ tabstr := "";
+ linestr := "";
+ lastoff := 0;
+ curfont := Parseman->FONT_ROMAN;
+ curlink := "";
+ curgtag := "";
+ curheading := 0;
+ fonttext := "";
+
+ for (l := line; l != nil; l = tl l) {
+ (offset, nil) := hd l;
+ if (offset != 0) {
+ lastoff = offset;
+ if (tabstr != "")
+ tabstr[len tabstr] = ' ';
+ tabstr = tabstr + string offset;
+ }
+ }
+ # fudge up tabs for rest of line
+ if (lastoff != 0)
+ tabstr = tabstr + " " + string lastoff + " " + string (lastoff + INDENT);
+ ttag := "";
+ gtag := "";
+ if (tabstr != nil)
+ ttag = tabtag(tabstr) + " ";
+
+ for (l = line; l != nil; l = tl l) {
+ (offset, text) := hd l;
+ gtag = "";
+ if (text.link != nil) {
+ if (text.attr & GOATTR)
+ gtag = gotag(text.link) + " ";
+ else {
+ gtag = linktag(text.link) + " ";
+ }
+ }
+ if (offset != 0)
+ fonttext[len fonttext] = '\t';
+ if (text.font != curfont || text.link != curlink || text.heading != curheading || gtag != curgtag) {
+ # need to change tags
+ linestr = linestr + " " + tk->quote(fonttext) + " {" + ttag + curgtag + fonttag(curfont, curheading) + "}";
+ ttag = "";
+ curgtag = gtag;
+ fonttext = "";
+ curfont = text.font;
+ curlink = text.link;
+ curheading = text.heading;
+ }
+ fonttext = fonttext + text.text;
+ }
+ if (fonttext != nil)
+ linestr = linestr + " " + tk->quote(fonttext) + " {" + ttag + curgtag + fonttag(curfont, curheading) + "}";
+ tkcmd(window, ".view.t insert end " + linestr);
+ tkcmd(window, ".view.t insert end {\n}");
+ # only update on every other line
+ if (lnum++ & 1)
+ tkcmd(window, "update");
+}
+
+mktags()
+{
+ tkcmd(window, ".view.t tag configure ROMAN -font " + ROMAN);
+ tkcmd(window, ".view.t tag configure BOLD -font " + BOLD);
+ tkcmd(window, ".view.t tag configure ITALIC -font " + ITALIC);
+ tkcmd(window, ".view.t tag configure H1 -font " + HEADING1);
+ tkcmd(window, ".view.t tag configure H2 -font " + HEADING2);
+}
+
+fonttag(font, heading: int): string
+{
+ if (heading == 1)
+ return "H1";
+ if (heading == 2)
+ return "H2";
+ case font {
+ Parseman->FONT_ROMAN =>
+ return "ROMAN";
+ Parseman->FONT_BOLD =>
+ return "BOLD";
+ Parseman->FONT_ITALIC =>
+ return "ITALIC";
+ }
+ return nil;
+}
+
+nexttag := 0;
+lasttabstr := "";
+lasttagname := "";
+
+tabtag(tabstr: string): string
+{
+ if (tabstr == lasttabstr)
+ return lasttagname;
+ lasttagname = "TAB" + string nexttag++;
+ lasttabstr = tabstr;
+ tkcmd(window, ".view.t tag configure " + lasttagname + " -tabs " + tk->quote(tabstr));
+ return lasttagname;
+}
+
+# optimise this!
+gotag(path: string): string
+{
+ cmd := "{send nav g" + path + "}";
+ name := "GO" + string nexttag++;
+ tkcmd(window, ".view.t tag bind " + name + " <ButtonRelease-1> +" + cmd);
+ tkcmd(window, ".view.t tag configure " + name + " -fg green");
+ return name;
+}
+
+# and this!
+linktag(search: string): string
+{
+ cmd := tk->quote("send nav l" + search);
+ name := "LN" + string nexttag++;
+ tkcmd(window, ".view.t tag bind " + name + " <ButtonRelease-1> +" + cmd);
+ tkcmd(window, ".view.t tag configure " + name + " -fg green");
+ return name;
+}
+
+isint(s: string): int
+{
+ for (i := 0; i < len s; i++)
+ if (s[i] < '0' || s[i] > '9')
+ return 0;
+ return 1;
+}
+
+kill(pid: int)
+{
+ pctl := sys->open("/prog/" + string pid + "/ctl", Sys->OWRITE);
+ if (pctl != nil) {
+ poison := array of byte "kill";
+ sys->write(pctl, poison, len poison);
+ }
+}
+
+revsortuniq(strlist: list of string): list of string
+{
+ strs := array [len strlist] of string;
+ for (i := 0; strlist != nil; (i, strlist) = (i+1, tl strlist))
+ strs[i] = hd strlist;
+
+ # simple sort (ascending)
+ for (i = 0; i < len strs - 1; i++) {
+ for (j := i+1; j < len strs; j++)
+ if (strs[i] < strs[j])
+ (strs[i], strs[j]) = (strs[j], strs[i]);
+ }
+
+ # construct list (result is descending)
+ r: list of string;
+ prev := "";
+ for (i = 0; i < len strs; i++) {
+ if (strs[i] != prev) {
+ r = strs[i] :: r;
+ prev = strs[i];
+ }
+ }
+ return r;
+}
+
+sortpages(pagelist: list of (int, string, string)): list of (int, string, list of string)
+{
+ pages := array [len pagelist] of (int, string, string);
+ for (i := 0; pagelist != nil; (i, pagelist) = (i+1, tl pagelist))
+ pages[i] = hd pagelist;
+
+ for (i = 0; i < len pages - 1; i++) {
+ for (j := i+1; j < len pages; j++) {
+ (nil, nil, ipath) := pages[i];
+ (nil, nil, jpath) := pages[j];
+ if (ipath > jpath)
+ (pages[i], pages[j]) = (pages[j], pages[i]);
+ }
+ }
+
+ r: list of (int, string, list of string);
+ filecmds: list of string;
+ lastfile := "";
+ lastsect := 0;
+ for (i = 0; i < len pages; i++) {
+ (section, cmd, file) := pages[i];
+ if (lastfile == "") {
+ lastfile = file;
+ lastsect = section;
+ }
+
+ if (file != lastfile) {
+ r = (lastsect, lastfile, filecmds) :: r;
+ lastfile = file;
+ lastsect = section;
+ filecmds = nil;
+ }
+ filecmds = cmd :: filecmds;
+ }
+ if (filecmds != nil)
+ r = (lastsect, lastfile, revsortuniq(filecmds)) :: r;
+ return r;
+}
+
+fittoscreen(win: ref Tk->Toplevel)
+{
+ Point, Rect: import draw;
+ if (win.image == nil || win.image.screen == nil)
+ return;
+ r := win.image.screen.image.r;
+ scrsize := Point((r.max.x - r.min.x), (r.max.y - r.min.y));
+ bd := int tkcmd(win, ". cget -bd");
+ winsize := Point(int tkcmd(win, ". cget -actwidth") + bd * 2, int tkcmd(win, ". cget -actheight") + bd * 2);
+ if (winsize.x > scrsize.x)
+ tkcmd(win, ". configure -width " + string (scrsize.x - bd * 2));
+ if (winsize.y > scrsize.y)
+ tkcmd(win, ". configure -height " + string (scrsize.y - bd * 2));
+ actr: Rect;
+ actr.min = Point(int tkcmd(win, ". cget -actx"), int tkcmd(win, ". cget -acty"));
+ actr.max = actr.min.add((int tkcmd(win, ". cget -actwidth") + bd*2,
+ int tkcmd(win, ". cget -actheight") + bd*2));
+ (dx, dy) := (actr.dx(), actr.dy());
+ if (actr.max.x > r.max.x)
+ (actr.min.x, actr.max.x) = (r.max.x - dx, r.max.x);
+ if (actr.max.y > r.max.y)
+ (actr.min.y, actr.max.y) = (r.max.y - dy, r.max.y);
+ if (actr.min.x < r.min.x)
+ (actr.min.x, actr.max.x) = (r.min.x, r.min.x + dx);
+ if (actr.min.y < r.min.y)
+ (actr.min.y, actr.max.y) = (r.min.y, r.min.y + dy);
+ tkcmd(win, ". configure -x " + string actr.min.x + " -y " + string actr.min.y);
+}
+
+tkcmd(top: ref Tk->Toplevel, s: string): string
+{
+ e := tk->cmd(top, s);
+ if (e != nil && e[0] == '!') {
+ sys->print("tk error %s on '%s'\n", e, s);
+ }
+ return e;
+}
generated by cgit v1.2.3 (git 2.46.0) at 2025-12-10 15:13:47 +0000