implement Brutus; include "sys.m"; sys: Sys; include "draw.m"; draw: Draw; Context: import draw; ctxt: ref Context; include "tk.m"; tk: Tk; include "wmlib.m"; wmlib: Wmlib; include "bufio.m"; bufio: Bufio; Iobuf: import bufio; include "workdir.m"; include "plumbmsg.m"; plumbmsg: Plumbmsg; Msg: import plumbmsg; include "brutus.m"; include "brutusext.m"; EXTDIR: con "/dis/wm/brutus"; NEXTRA: con NTAG-NFONTTAG; DEFFONT: con "/fonts/lucidasans/unicode.8.font"; DEFFONTNAME: con "Roman"; DEFSIZE: con 10; DEFTAG: con "Roman.10"; SETFONT: con " -font "+DEFFONT+" "; FOCUS: con "focus .ft.t"; NOSEL: con ".ft.t tag remove sel sel.first sel.last"; UPDATE: con "update"; # # Foreign keyboards and languages # Remaptab: adt { in, out: int; }; include "hebrew.m"; BS: con 8; # ^h backspace character BSW: con 23; # ^w bacspace word BSL: con 21; # ^u backspace line ESC: con 27; # ^[ cut selection Name: con "Brutus"; # build menu menu_cfg := array[] of { # menu "menu .m", ".m add command -text Cut -command {send edit cut}", ".m add command -text Paste -command {send edit paste}", ".m add command -text Snarf -command {send edit snarf}", ".m add command -text Look -command {send edit look}", }; brutus_cfg := array[] of { # buttons "button .b.Tag -text Tag -command {send cmd tag} -state disabled", "menubutton .b.Font -text Roman -menu .b.Font.menu -underline -1 -state disabled", "menu .b.Font.menu", ".b.Font.menu add command -label Roman -command {send cmd font Roman}", ".b.Font.menu add command -label Italic -command {send cmd font Italic}", ".b.Font.menu add command -label Bold -command {send cmd font Bold}", ".b.Font.menu add command -label Type -command {send cmd font Type}", "checkbutton .b.Applyfont -variable Applyfont -command {send cmd applyfont}} -state disabled", "button .b.Applyfontnow -text Font -command {send cmd applyfontnow} -state disabled", "button .b.Applysizenow -text Size -command {send cmd applysizenow} -state disabled", "button .b.Applyfontsizenow -text F&S -command {send cmd applyfontsizenow} -state disabled", "menubutton .b.Size -text 10pt -menu .b.Size.menu -underline -1 -state disabled", "menu .b.Size.menu", ".b.Size.menu add command -label 6pt -command {send cmd size 6}", ".b.Size.menu add command -label 8pt -command {send cmd size 8}", ".b.Size.menu add command -label 10pt -command {send cmd size 10}", ".b.Size.menu add command -label 12pt -command {send cmd size 12}", ".b.Size.menu add command -label 16pt -command {send cmd size 16}", "button .b.Put -text Put -command {send cmd put} -state disabled", # text "frame .ft", "scrollbar .ft.scroll -command {.ft.t yview}", "text .ft.t -height 7c -tabs {1c} -wrap word -yscrollcommand {.ft.scroll set}", FOCUS, # pack "pack .b.File .b.Ext .b.Tag .b.Applyfontnow .b.Applysizenow .b.Applyfontsizenow .b.Applyfont .b.Font .b.Size .b.Put -side left", "pack .b -anchor w", "pack .ft.scroll -side left -fill y", "pack .ft.t -fill both -expand 1", "pack .ft -fill both -expand 1", "pack propagate . 0", }; control_cfg := array[] of { # text "frame .ft", "scrollbar .ft.scroll -command {.ft.t yview}", "text .ft.t -height 4c -wrap word -yscrollcommand {.ft.scroll set}", "pack .b.File", "pack .b -anchor w", "pack .ft.scroll -side left -fill y", "pack .ft.t -fill both -expand 1", "pack .ft -fill both -expand 1", "pack propagate . 0", }; # bindings to build nice controls in text widget input_cfg := array[] of { # input "bind .ft.t {send keys {%A}}", "bind .ft.t {send keys {%A}}", "bind .ft.t {send keys {%A}}", "bind .ft.t {send keys {%A}}", "bind .ft.t +{grab set .ft.t; send but1 pressed}", "bind .ft.t +{grab set .ft.t; send but1 pressed}", "bind .ft.t +{grab release .ft.t; send but1 released}", "bind .ft.t {send but2 %X %Y}", "bind .ft.t {}", "bind .ft.t {}", "bind .ft.t {send but3 pressed}", "bind .ft.t {send but3 released %x %y}", "bind .ft.t {}", "bind .ft.t {}", "bind .ft.t {}", "bind .ft.t {}", "bind .ft.t +{send cmd focus}", "bind .m {.m tkMenuButtonUp %x %y}", UPDATE }; fontbuts := array[] of { ".b.Ext", ".b.Tag", ".b.Applyfontnow", ".b.Applysizenow", ".b.Applyfontsizenow", ".b.Applyfont", ".b.Font", ".b.Size", }; fontname = array[NFONT] of { "Roman", "Italic", "Bold", "Type", }; sizename = array[NSIZE] of { "6", "8", "10", "12", "16", }; tagname = array[NTAG] of { # first NFONT*NSIZE are font/size names "Roman.6", "Roman.8", "Roman.10", "Roman.12", "Roman.16", "Italic.6", "Italic.8", "Italic.10", "Italic.12", "Italic.16", "Bold.6", "Bold.8", "Bold.10", "Bold.12", "Bold.16", "Type.6", "Type.8", "Type.10", "Type.12", "Type.16", "Example", "Caption", "List", "List-elem", "Label", "Label-ref", "Exercise", "Heading", "No-fill", "Author", "Title", "Index", "Index-topic", }; tagconfig = array[NTAG] of { "-font /fonts/lucidasans/unicode.6.font", "-font /fonts/lucidasans/unicode.7.font", "-font /fonts/lucidasans/unicode.8.font", "-font /fonts/lucidasans/unicode.10.font", "-font /fonts/lucidasans/unicode.13.font", "-font /fonts/lucidasans/italiclatin1.6.font", "-font /fonts/lucidasans/italiclatin1.7.font", "-font /fonts/lucidasans/italiclatin1.8.font", "-font /fonts/lucidasans/italiclatin1.10.font", "-font /fonts/lucidasans/italiclatin1.13.font", "-font /fonts/lucidasans/boldlatin1.6.font", "-font /fonts/lucidasans/boldlatin1.7.font", "-font /fonts/lucidasans/boldlatin1.8.font", "-font /fonts/lucidasans/boldlatin1.10.font", "-font /fonts/lucidasans/boldlatin1.13.font", "-font /fonts/lucidasans/typelatin1.6.font", "-font /fonts/lucidasans/typelatin1.7.font", "-font /fonts/pelm/latin1.9.font", "-font /fonts/pelm/ascii.12.font", "-font /fonts/pelm/ascii.16.font", "-foreground #444444 -lmargin1 1c -lmargin2 1c; .ft.t tag lower Example", "-foreground #444444; .ft.t tag lower Caption", "-foreground #444444 -lmargin1 1c -lmargin2 1c; .ft.t tag lower List", "-foreground #0000A0; .ft.t tag lower List-elem", "-foreground #444444; .ft.t tag lower Label", "-foreground #444444; .ft.t tag lower Label-ref", "-foreground #444444; .ft.t tag lower Exercise", "-foreground #444444; .ft.t tag lower Heading", "-foreground #444444; .ft.t tag lower No-fill", "-foreground #444444; .ft.t tag lower Author", "-foreground #444444; .ft.t tag lower Title", "-foreground #444444; .ft.t tag lower Index", "-foreground #444444; .ft.t tag lower Index-topic", }; enabled := array[] of {"disabled", "normal"}; File: adt { tk: ref Tk->Toplevel; isctl: int; applyfont: int; fontsused: int; name: string; dirty: int; font: string; # set by the buttons, not nec. by the text size: int; # set by the buttons, not nec. by the text fonttag: string; # set by the buttons, not nec. by the text configed: array of int; button1: int; button3: int; fontsok: int; # fonts and tags can be set extensions: list of ref Ext; }; Ext: adt { tkname: string; modname: string; mod: Brutusext; args: string; }; menuindex := "0"; snarftext := ""; snarfsgml := ""; central: chan of (ref File, string); files: array of ref File; # global but modified only by control thread plumbed := 0; curdir := ""; lang := ""; init(c: ref Context, argv: list of string) { ctxt = c; sys = load Sys Sys->PATH; draw = load Draw Draw->PATH; tk = load Tk Tk->PATH; wmlib = load Wmlib Wmlib->PATH; bufio = load Bufio Bufio->PATH; plumbmsg = load Plumbmsg Plumbmsg->PATH; if(plumbmsg->init(1, "edit", 1000) >= 0){ plumbed = 1; workdir := load Workdir Workdir->PATH; curdir = workdir->init(); workdir = nil; } wmlib->init(); sys->pctl(Sys->NEWPGRP, nil); # so we can pass "exit" command to wmlib file := ""; argv = tl argv; if(argv != nil) file = hd argv; central = chan of (ref File, string); spawn control(ctxt); <-central; spawn brutus(ctxt, file); } # build menu button for dynamically generated menu buttoncfg(label, enable: string): string { return "label .b."+label+" -text "+label + " " + enable + ";bind .b."+label+" {send cmd "+label+"}" + ";bind .b."+label+" {}" + ";bind .b."+label+" {}" + ";bind .b."+label+" {}" + ";bind .b."+label+" {}" + ";bind .b."+label+" {.b."+label+" configure -background #EEEEEE}" + ";bind .b."+label+" {.b."+label+" configure -background #DDDDDD}"; } tkchans(t: ref Tk->Toplevel): (chan of string, chan of string, chan of string, chan of string, chan of string, chan of string, chan of string) { keys := chan of string; tk->namechan(t, keys, "keys"); edit := chan of string; tk->namechan(t, edit, "edit"); cmd := chan of string; tk->namechan(t, cmd, "cmd"); but1 := chan of string; tk->namechan(t, but1, "but1"); but2 := chan of string; tk->namechan(t, but2, "but2"); but3 := chan of string; tk->namechan(t, but3, "but3"); drag := chan of string; tk->namechan(t, drag, "Wm_drag"); return (keys, edit, cmd, but1, but2, but3, drag); } control(ctxt: ref Context) { (t, titlectl) := wmlib->titlebar(ctxt.screen, SETFONT, Name, Wmlib->Appl); # f is not used to store anything, just to simplify interfaces # shared by control and brutus f := ref File (t, 1, 0, 0, "", 0, DEFFONTNAME, DEFSIZE, DEFTAG, nil, 0, 0, 0, nil); tkcmds(t, menu_cfg); tkcmd(t, "frame .b"); tkcmd(t, buttoncfg("File", "")); tkcmds(t, control_cfg); tkcmds(t, input_cfg); files = array[1] of ref File; files[0] = f; (keys, edit, cmd, but1, but2, but3, drag) := tkchans(t); tkcmd(t, ".ft.t mark set typingstart 1.0; .ft.t mark gravity typingstart left"); central <-= (nil, ""); # signal readiness spawn wmlib->titlectl(t, "task"); curfile: ref File; plumbc := chan of (string, string); spawn plumbproc(plumbc); for(;;) alt { menu := <-titlectl => if(menu[0] == 'e'){ if(shutdown(ctxt.screen, t)){ killplumb(); wmlib->titlectl(t, menu); } break; } spawn wmlib->titlectl(t, menu); ecmd := <-edit => editor(f, ecmd); tkcmd(t, FOCUS); c := <-cmd => (nil, s) := sys->tokenize(c, " "); case hd s { * => sys->print("unknown control cmd %s\n",c ); "File" => filemenu(t, 0, 0); "new" => (name, ok, nil) := getfilename(ctxt.screen, t, "file for new window", f.name, 1, 0, 0); if(ok) spawn brutus(ctxt, name); "select" => n := int hd tl s; if(n > len files) break; if(n > 0) curfile = files[n]; tkcmd(files[n].tk, ". map; raise .; focus .ft.t"); "focus" => ; } (file, action) := <-central => (nil, s) := sys->tokenize(action, " "); case hd s { * => sys->print("control unknown central command %s\n", action); "new" => curfile = file; nfiles := array[len files+1] of ref File; nfiles[0:] = files; files = nfiles; nfiles = nil; # make sure references don't linger files[len files-1] = file; "name" => name := nameof(file); index := 0; for(i:=1; iprint("can't find file\n"); "focus" => if(file != f) curfile = file; "select" => n := int hd tl s; if(n >= len files) break; if(n > 0) curfile = files[n]; tkcmd(files[n].tk, ". map; raise .; focus .ft.t; update"); "exiting" => if(file == nil) break; if(file == curfile) curfile = nil; index := 0; for(i:=1; iprint("can't find file\n"); else{ # make a new one rather than slice, to clean up references nfiles := array[len files-1] of ref File; for(i=0; i char := typing(f, c); if(curfile!=nil && char=='\n' && insat(t, "end")) execute(t, curfile, tkcmd(t, ".ft.t get insert-1line insert")); c := <-but1 => mousebut1(f, c); c := <-but2 => mousebut2(f, c); c := <-but3 => mousebut3(f, c); c := <-drag => if(len c < 6 || c[0:5] != "path=") break; spawn brutus(ctxt, c[5:]); (fname, addr) := <-plumbc => for(i:=1; i0; ){ if(filename[i] == ':'){ (ok, dir) := sys->stat(filename[0:i]); if(ok >= 0){ addr = filename[i+1:]; filename = filename[0:i]; break; } } } (t, titlectl) := wmlib->titlebar(ctxt.screen, SETFONT, Name, Wmlib->Appl); f := ref File (t, 0, 0, 0, filename, 0, DEFFONTNAME, DEFSIZE, DEFTAG, nil, 0, 0, 0, nil); f.configed = array[NTAG] of {* => 0}; tkcmds(t, menu_cfg); tkcmd(t, "frame .b"); tkcmd(t, buttoncfg("File", "")); tkcmd(t, buttoncfg("Ext", "-state disabled")); tkcmds(t, brutus_cfg); tkcmds(t, input_cfg); # buttons work better when they grab the mouse a := array[] of {".b.Tag", ".b.Applyfontnow", ".b.Applysizenow", ".b.Applyfontsizenow"}; for(i=0; i +{grab set "+a[i]+"}"); tkcmd(t, "bind "+a[i]+" +{grab release "+a[i]+"}"); } (keys, edit, cmd, but1, but2, but3, drag) := tkchans(t); configfont(f, "Heading"); configfont(f, "Title"); configfont(f, f.fonttag); tkcmd(t, ".ft.t mark set typingstart 1.0; .ft.t mark gravity typingstart left"); tkcmd(t, "image create bitmap waiting -file cursor.wait"); central <-= (f, "new"); setfilename(f, filename); if(filename != "") if(loadfile(f, filename) < 0) wmlib->dialog(t, "error -fg red", "Open file", sys->sprint("Can't read %s:\n%r", filename), 0, "Continue" :: nil); else showaddr(f, addr); for(;;) alt { menu := <-titlectl => case menu { "exit" => if(f.dirty){ action := confirm(ctxt.screen, t, nameof(f)+" is dirty", 1); case action { "cancel" => continue; "exitclean" => if(dumpfile(f, f.name, f.fontsused) < 0) continue; break; "exitdirty" => break; } } central <-= (f, "exiting"); # this one tears down temporaries holding references to f central <-= (nil, "exiting"); return; "task" => tkcmd(t, ". unmap"); * => wmlib->titlectl(t, menu); } ecmd := <-edit => editor(f, ecmd); tkcmd(t, FOCUS); command := <-cmd => (nil, c) := sys->tokenize(command, " "); case hd c { * => sys->print("unknown command %s\n", command); "File" => filemenu(t, 1, f.fontsok); "Ext" => extmenu(t); "new" => (name, ok, nil) := getfilename(ctxt.screen, t, "file for new window", f.name, 1, 0, 0); if(ok) spawn brutus(ctxt, name); "open" => if(f.dirty){ action := confirm(ctxt.screen, t, nameof(f)+" is dirty", 1); case action { "cancel" => continue; "exitclean" => if(dumpfile(f, f.name, f.fontsused) < 0) continue; break; "exitdirty" => break; } } (name, ok, nil) := getfilename(ctxt.screen, t, "file for this window", f.name, 1, 0, 0); if(ok && name!=""){ setfilename(f, name); if(loadfile(f, name) < 0){ tkcmd(t, ".ft.t delete 1.0 end"); wmlib->dialog(t, "error -fg red", "Open file", sys->sprint("Can't open %s:\n%r", name), 0, "Continue"::nil); } } "name" => (name, ok, nil) := getfilename(ctxt.screen, t, "remembered file name", f.name, 1, 0, 0); if(ok){ if(name != f.name){ setfilename(f, name); dirty(f, 1); } } "write" => (name, ok, sgml) := getfilename(ctxt.screen, t, "file to write", f.name, 1, 1, f.fontsused); if(ok && name!=""){ if(f.name == ""){ setfilename(f, name); dirty(f, 1); } dumpfile(f, name, sgml); } "fonts" => if(f.fontsok==0 && f.fontsused==0){ action := confirm(ctxt.screen, t, "Converting "+nameof(f)+" to SGML", 0); case action { "cancel" => continue; "exitdirty" => usingfonts(f); dirty(f, 1); } } enablefonts(f, !f.fontsok); "language" => if(lang == "") lang = "Hebrew"; else lang = ""; "addext" => ext := hd tl c; (args, ok, nil) := getfilename(ctxt.screen, t, "parameters for "+ext, "", 0, 0, 0); if(ok){ tkcmd(t, "cursor -image waiting; update"); addextension(f, ext+" "+args, nil); usingfonts(f); dirty(f, 1); tkcmd(t, "cursor -default; update"); } "select" => central <-= (f, command); "tag" => tageditor(ctxt.screen, f); tkcmd(t, FOCUS); "font" => f.font = hd tl c; tkcmd(t, ".b.Font configure -text "+f.font+";"+UPDATE); f.fonttag = f.font+"."+string f.size; configfont(f, f.fonttag); if(changefont(f, f.font)) dirty(f, 1); "size" => sz := hd tl c; tkcmd(t, ".b.Size configure -text "+sz+"pt; update"); f.size = int sz; f.fonttag = f.font+"."+string f.size; configfont(f, f.fonttag); if(changesize(f, string f.size)) dirty(f, 1); "applyfont" => f.applyfont = int tkcmd(t, "variable Applyfont"); if(f.applyfont) configfont(f, f.fonttag); "applyfontnow" => if(changefont(f, f.font)) dirty(f, 1); "applysizenow" => if(changesize(f, string f.size)) dirty(f, 1); "applyfontsizenow" => if(changefontsize(f, f.fonttag)) dirty(f, 1); "put" => dumpfile(f, f.name, f.fontsused); "focus" => central <-= (f, "focus"); } c := <-keys => typing(f, c); c := <-but1 => mousebut1(f, c); c := <-but2 => mousebut2(f, c); c := <-but3 => mousebut3(f, c); c := <-drag => if(len c < 6 || c[0:5] != "path=") break; spawn brutus(ctxt, c[5:]); } } kbdremap(c: int) : (int, int) { tab: array of Remaptab; dir := 1; case lang{ "" => return (c, dir); "Hebrew" => tab = hebrewtab; dir = -1; * => sys->print("unknown language %s\n", lang); return (c, dir); } for(i:=0; i dir := 1; if(c[1] != '\\') # safe character; remap it (c[1], dir) = kbdremap(char); s := ".ft.t insert insert "+c; if(dir < 0) s += ";.ft.t mark set insert insert-1c"; if(f.applyfont){ usingfonts(f); s += f.fonttag; } tkcmd(t, s+update); if(f.fontsused && f.applyfont==0){ # nasty goo to make sure we don't insert text without a font tag; # must ask after the fact if default rules set a tag. names := tkcmd(t, ".ft.t tag names insert-1chars"); if(!somefont(names)) tkcmd(t, ".ft.t tag add "+DEFTAG+" insert-1chars"); } dirty(f, 1); ESC => if(nullsel(t)) tkcmd(t, ".ft.t tag add sel typingstart insert;"+ ".ft.t mark set typingstart insert"); else cut(f, 1); tkcmd(t, UPDATE); BS => bs(f, "c"); BSL => bs(f, "l"); BSW => bs(f, "w"); } return char; } bs(f: ref File, c: string) { if(!insat(f.tk, "1.0")){ tkcmd(f.tk, ".ft.t tkTextDelIns -"+c+";.ft.t see insert;"+UPDATE); dirty(f, 1); } } mousebut1(f: ref File, c: string) { f.button1 = (c == "pressed"); f.button3 = 0; # abort any pending button 3 action tkcmd(f.tk, ".ft.t mark set typingstart insert"); } mousebut2(f: ref File, c: string) { if(f.button1){ cut(f, 1); tk->cmd(f.tk, UPDATE); }else{ (nil, l) := sys->tokenize(c, " "); x := int hd l - 50; y := int hd tl l - int tk->cmd(f.tk, ".m yposition "+menuindex) - 10; # tkcmd(f.tk, "focus .ft.t"); tkcmd(f.tk, ".m activate "+menuindex+"; .m post "+string x+" "+string y+ "; update"); } } mousebut3(f: ref File, c: string) { t := f.tk; if(c == "pressed"){ f.button3 = 1; if(f.button1){ paste(f); tk->cmd(t, "update"); } return; } if(!plumbed || f.button3==0 || f.button1!=0) return; f.button3 = 0; # Plumb message triggered by release of button 3 (nil, l) := sys->tokenize(c, " "); x := int hd tl l; y := int hd tl tl l; index := tk->cmd(t, ".ft.t index @"+string x+","+string y); selindex := tk->cmd(t, ".ft.t tag ranges sel"); if(selindex != "") insel := tk->cmd(t, ".ft.t compare sel.first <= "+index)=="1" && tk->cmd(t, ".ft.t compare sel.last >= "+index)=="1"; else insel = 0; attr := ""; if(insel) text := tk->cmd(t, ".ft.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 := tk->cmd(t, ".ft.t index {"+index+" linestart}"); right := tk->cmd(t, ".ft.t index {"+index+" lineend}"); line := tk->cmd(t, ".ft.t get "+left+" "+right); for(i:=charno; i>0; --i) if(line[i-1]==' ' || line[i-1]=='\t') break; for(j:=charno; jfprint(sys->fildes(2), "brutus: plumbing write error: %r\n"); } directory(f: ref File): string { for(i:=len f.name; --i>=0;) if(f.name[i] == '/'){ if(i == 0) i++; return f.name[0:i]; } return curdir; } enablefonts(f: ref File, enable: int) { for(i:=0; iToplevel, buttons, fontsok: int) { tkcmd(t, "menu .b.Filemenu"); tkcmd(t, ".b.Filemenu add command -label New -command {send cmd new}"); if(buttons){ tkcmd(t, ".b.Filemenu add command -label Open -command {send cmd open}"); tkcmd(t, ".b.Filemenu add command -label Name -command {send cmd name}"); tkcmd(t, ".b.Filemenu add command -label Write -command {send cmd write}"); if(fontsok) pre := "Dis"; else pre = "En"; tkcmd(t, ".b.Filemenu add command -label {" +pre+"able Fonts} -command {send cmd fonts}"); if(lang == "") pre = "En"; else pre = "Dis"; tkcmd(t, ".b.Filemenu add command -label {" +pre+"able Hebrew} -command {send cmd language}"); } tkcmd(t, ".b.Filemenu add command -label {["+Name+"]} -command {send cmd select 0}"); if(files != nil) for(i:=1; i {destroy .b.Filemenu}"); x := tk->cmd(t, ".ft.scroll cget actx"); y := tk->cmd(t, ".ft.scroll cget acty"); tkcmd(t, ".b.Filemenu post "+x+" "+y+"; grab set .b.Filemenu; update"); } extmenu(t: ref tk->Toplevel) { fd := sys->open(EXTDIR, Sys->OREAD); dir := array[100] of Sys->Dir; if(fd == nil || (n:=sys->dirread(fd, dir))<=0){ sys->print("%s: can't find extension directory %s: %r\n", Name, EXTDIR); return; } tkcmd(t, "menu .b.Extmenu"); for(i:=0; i4 && name[len name-4:]==".dis"){ name = name[0:len name-4]; tkcmd(t, ".b.Extmenu add command -label {Add "+name+ "} -command {send cmd addext "+name+"}"); } } tkcmd(t, "bind .b.Extmenu {destroy .b.Extmenu}"); x := tk->cmd(t, ".ft.scroll cget actx"); y := tk->cmd(t, ".ft.scroll cget acty"); tkcmd(t, ".b.Extmenu post "+x+" "+y+"; grab set .b.Extmenu; update"); } basepath(file: string): (string, string) { for(i := len file-1; i >= 0; i--) { if(file[i] == '/') return (file[0:i], file[i+1:]); } return (".", file); } putbut(f: ref File) { state := enabled[f.dirty]; if(f.name != "") tkcmd(f.tk, ".b.Put configure -state "+state+"; update"); } dirty(f: ref File, nowdirty: int) { if(f.isctl) return; old := f.dirty; f.dirty = nowdirty; if(old != nowdirty){ setfilename(f, f.name); putbut(f); } } setfilename(f: ref File, name: string) { oldname := f.name; f.name = name; if(oldname=="" && name!="") putbut(f); name = Name + ": \"" +nameof(f)+ "\""; if(f.dirty) name += " (dirty)"; wmlib->taskbar(f.tk, name); tkcmd(f.tk, UPDATE); central <-= (f, "name"); } configfont(f: ref File, tag: string) { for(i:=0; iprint("Brutus: can't configure font %s\n", tag); } insat(t: ref Tk->Toplevel, mark: string): int { return tkcmd(t, ".ft.t compare insert == "+mark) == "1"; } isalnum(s: string): int { if(s == "") return 0; c := s[0]; if('a' <= c && c <= 'z') return 1; if('A' <= c && c <= 'Z') return 1; if('0' <= c && c <= '9') return 1; if(c == '_') return 1; if(c > 16rA0) return 1; return 0; } editor(f: ref File, ecmd: string) { case ecmd { "cut" => menuindex = "0"; cut(f, 1); "paste" => menuindex = "1"; paste(f); "snarf" => menuindex = "2"; if(nullsel(f.tk)) return; snarf(f); "look" => menuindex = "3"; look(f); } tkcmd(f.tk, UPDATE); } nullsel(t: ref Tk->Toplevel): int { return tkcmd(t, ".ft.t tag ranges sel") == ""; } cut(f: ref File, snarfit: int) { if(nullsel(f.tk)) return; dirty(f, 1); if(snarfit) snarf(f); # sometimes when clicking fast, selection and insert point can # separate. the only time this really matters is when typing into # a double-clicked selection. it's easy to fix here. tkcmd(f.tk, ".ft.t mark set insert sel.first;.ft.t delete sel.first sel.last"); } snarf(f: ref File) { # convert sel.first and sel.last to numeric forms because sgml() # must clear selection to avoid tags in result. (nil, sel) := sys->tokenize(tkcmd(f.tk, ".ft.t tag ranges sel"), " "); snarftext = tkcmd(f.tk, ".ft.t get "+hd sel+" "+hd tl sel); snarfsgml = sgml(f.tk, "-sgml", hd sel, hd tl sel); wmlib->snarfput(snarftext); } paste(f: ref File) { # good question snarftext = wmlib->snarfget(); if(snarftext == "" && (f.fontsused == 0 || snarfsgml == nil)) return; cut(f, 0); dirty(f, 1); t := f.tk; start := tkcmd(t, ".ft.t index insert"); if(f.fontsused == 0) tkcmd(t, ".ft.t insert insert '"+snarftext); else if(f.applyfont) tkcmd(t, ".ft.t insert insert "+wmlib->tkquote(snarftext)+" "+f.fonttag); else insert(f, snarfsgml); tkcmd(t, ".ft.t tag add sel "+start+" insert"); } look(f: ref File) { t := f.tk; (sel0, sel1) := word(t); if(sel0 == nil) return; text := tkcmd(t, ".ft.t get "+sel0+" "+sel1); if(text == nil) return; tkcmd(t, "cursor -image waiting; update"); search(nil, f, text, 0, 0); tkcmd(t, "cursor -default; update"); } # First time fonts are used explicitly, establish font tags for all extant text. usingfonts(f: ref File) { if(f.fontsused) return; tkcmd(f.tk, ".ft.t tag add "+DEFTAG+" 1.0 end"); f.fontsused = 1; } word(t: ref Tk->Toplevel): (string, string) { start := "sel.first"; end := "sel.last"; if(nullsel(t)){ insert := tkcmd(t, ".ft.t index insert"); start = tkcmd(t, ".ft.t index {insert wordstart}"); if(insert == start){ # tk's definition of 'wordstart' is bogus # if at beginning, tk->cmd will return !error and a0 will be false. a0 := isalnum(tk->cmd(t, ".ft.t get insert-1chars")); a1 := isalnum(tk->cmd(t, ".ft.t get insert")); if(a0==0 && a1==0) return (nil, nil); if(a1 == 0) start = tkcmd(t, ".ft.t index {insert-1chars wordstart}"); } end = tkcmd(t, ".ft.t index {"+start+" wordend}"); if(start == end) return (nil, nil); } return (start, end); } # Change the font associated with the selection changefont(f: ref File, font: string): int { t := f.tk; (sel0, sel1) := word(f.tk); mod := 0; if(sel0 == nil) return mod; usingfonts(f); for(i:=0; i 0 && range[0] == '!') break; (nil, tt) := sys->tokenize(range, " "); if(tt == nil) break; tkcmd(t, ".ft.t tag remove "+tag+" "+hd tt+" "+hd tl tt); fs := font+"."+sizename[j]; tkcmd(t, ".ft.t tag add "+fs+" "+hd tt+" "+hd tl tt); configfont(f, fs); start = hd tl tt; mod = 1; } } } tkcmd(t, UPDATE); return mod; } # See if tag list includes a font name somefont(tag: string): int { (nil, tt) := sys->tokenize(tag, " "); for(; tt!=nil; tt=tl tt) for(i:=0; i 0 && range[0] == '!') break; (nil, tt) := sys->tokenize(range, " "); if(tt == nil) break; tkcmd(t, ".ft.t tag remove "+tag+" "+hd tt+" "+hd tl tt); fs := fontname[i]+"."+size; tkcmd(t, ".ft.t tag add "+fs+" "+hd tt+" "+hd tl tt); configfont(f, fs); start = hd tl tt; mod = 1; } } } tkcmd(t, UPDATE); return mod; } # Change the font and size associated with the selection changefontsize(f: ref File, newfontsize: string): int { t := f.tk; (sel0, sel1) := word(f.tk); if(sel0 == nil) return 0; usingfonts(f); (nil, names) := sys->tokenize(tkcmd(t, ".ft.t tag names"), " "); # clear old tags tags := tagname[0:NFONT*NSIZE]; for(l:=names; l!=nil; l=tl l) for(i:=0; i=0; k--) if(c == pat[k]) return i; i++; } return i; } # splitstrl based on indices rather than slices. this version returns char # position of the beginning of the matching string. splitstrl(str: string, i, j: int, pat: string): int { l := len pat; if(l == 0) # shouldn't happen, but be safe return j; first := pat[0]; while(i <= j-l){ # check first char for speed if(str[i] == first){ for(k:=1; k i) tkcmd(t, ".ft.t insert insert "+wmlib->tkquote(sgml[i:j])+" "+tt); if(j < end) case sgml[j] { '&' => if(j+4<=end && sgml[j:j+4]=="<"){ tkcmd(t, ".ft.t insert insert "+"{<} "+tt); j += 4; }else{ tkcmd(t, ".ft.t insert insert {&} "+tt); j += 1; } '<' => (nc, newtag, on) := tagstring(sgml, j, end); if(nc < 0){ tkcmd(t, ".ft.t insert insert "+"{<} "+tt); j += 1; }else if(len newtag>9 && newtag[0:10]=="Extension "){ addextension(f, newtag[10:], taglist); j += nc; }else if(len newtag>9 && newtag[0:7]=="Window "){ repostextension(f, newtag[7:], taglist); j += nc; }else{ if(on){ taglist = newtag :: taglist; configfont(f, newtag); }else{ taglist = drop(taglist, newtag); if(f.applyfont && hasfonts(taglist)==0) taglist = f.fonttag :: taglist; } j += nc; tag = listtostring(taglist); } } } } drop(l: list of string, s: string): list of string { n: list of string; while(l != nil){ if(s != hd l) n = hd l :: n; l = tl l; } return n; } extid := 0; addextension(f: ref File, s: string, taglist: list of string) { for(i:=0; iprint("Brutus: badly formed extension %s\n", s); return; } modname := s[0:i]; s = s[i+1:]; mod: Brutusext; for(el:=f.extensions; el!=nil; el=tl el) if(modname == (hd el).modname){ mod = (hd el).mod; break; } if(mod == nil){ file := modname; if(i < 4 || file[i-4:i] != ".dis") file += ".dis"; if(file[0] != '/') file = "/dis/wm/brutus/" + file; mod = load Brutusext file; if(mod == nil){ sys->print("%s: can't load module %s: %r\n", Name, file); return; } } mkextension(f, mod, modname, s, taglist); } repostextension(f: ref File, tkname: string, taglist: list of string) { mod: Brutusext; for(el:=f.extensions; el!=nil; el=tl el) if(tkname == (hd el).tkname){ mod = (hd el).mod; break; } if(mod == nil){ sys->print("Brutus: can't find extension widget %s: %r\n", tkname); return; } mkextension(f, mod, (hd el).modname, (hd el).args, taglist); } mkextension(f: ref File, mod: Brutusext, modname, args: string, taglist: list of string) { t := f.tk; name := ".ext"+string extid++; mod->init(sys, draw, bufio, tk, wmlib); err := mod->create(f.name, t, name, args); if(err != ""){ sys->print("%s: can't create extension widget %s: %s\n", Name, modname, err); return; } tkcmd(t, ".ft.t window create insert -window "+name); while(taglist != nil){ tkcmd(t, ".ft.t tag add "+hd taglist+" "+name); taglist = tl taglist; } f.extensions = ref Ext(name, modname, mod, args) :: f.extensions; } # rewrite tags into extrewrite(f: ref File, sgml: string): string { if(f.extensions == nil) return sgml; new := ""; end := len sgml; j: int; for(i:=0; i i) new += sgml[i:j]; if(j < end){ j += 8; for(k:=j; sgml[k]!='>' && kprint("%s: unrecognized extension %s\n", Name, tkname); else{ e := hd el; new += ""; } j = k+1; # skip '>' } } return new; } hasfonts(l: list of string): int { for(i:=0; i"); if(j==end || s[j]!='>') return (-1, "", 0); nc := (j-i)+1; on := 1; if(s[i+1] == '/'){ on = 0; i++; } tag = s[i+1:j]; # NEED TO CHECK VALIDITY OF TAG return (nc, tag, on); } sgml(t: ref Tk->Toplevel, flag, start, end: string): string { # turn off selection, to avoid getting that in output sel := tkcmd(t, ".ft.t tag ranges sel"); if(sel != "") tkcmd(t, ".ft.t tag remove sel "+sel); s := tkcmd(t, ".ft.t dump "+flag+" "+start+" "+end); if(sel != "") tkcmd(t, ".ft.t tag add sel "+sel); return s; } loadfile(f: ref File, file: string): int { f.size = DEFSIZE; f.font = DEFFONTNAME; f.fonttag = DEFTAG; f.fontsused = 0; enablefonts(f, 0); t := f.tk; tkcmd(t, ".b.Font configure -text "+f.font); tkcmd(t, ".b.Size configure -text "+string f.size+"pt"); tkcmd(t, "cursor -image waiting; update"); r := loadfile1(f, file); tkcmd(t, "cursor -default"); return r; } loadfile1(f: ref File, file: string): int { fd := bufio->open(file, Sys->OREAD); if(fd == nil) return -1; (ok, dir) := sys->fstat(fd.fd); if(ok < 0){ fd.close(); return -1; } a := array[dir.length] of byte; n := fd.read(a, len a); fd.close(); if(n != len a) return -1; t := f.tk; tkcmd(t, ".ft.t delete 1.0 end"); if(len a>=7 && string a[0:7]=="\n") insert(f, string a[7:n]); else tkcmd(t, ".ft.t insert 1.0 '"+string a[0:n]); dirty(f, 0); tkcmd(t, ".ft.t mark set insert 1.0; update"); return 1; } dumpfile(f: ref File, file: string, sgml: int): int { tkcmd(f.tk, "cursor -image waiting"); r := dumpfile1(f, file, sgml); tkcmd(f.tk, "cursor -default"); return r; } dumpfile1(f: ref File, file: string, sgml: int): int { if(writefile(f, file, sgml) < 0){ wmlib->dialog(f.tk, "error -fg red", "Write file", sys->sprint("Can't write %s:\n%r", file), 0, "Continue"::nil); tkcmd(f.tk, FOCUS); return -1; } return 1; } writefile(f: ref File, file: string, sgmlfmt: int): int { if(file == "") return -1; fd := bufio->create(file, Sys->OWRITE, 8r666); if(fd == nil) return -1; t := f.tk; flag := ""; if(sgmlfmt){ flag = "-sgml"; prefix := "\n"; if(f.fontsused == 0) prefix += "<"+DEFTAG+">"; x := array of byte prefix; if(fd.write(x, len x) != len x){ fd.close(); return -1; } } sgmltext := sgml(t, flag, "1.0", "end"); if(sgmlfmt) sgmltext = extrewrite(f, sgmltext); a := array of byte sgmltext; if(fd.write(a, len a) != len a){ fd.close(); return -1; } if(sgmlfmt && f.fontsused==0){ suffix := array of byte (""); if(fd.write(suffix, len suffix) != len suffix){ fd.close(); return -1; } } if(fd.flush() < 0){ fd.close(); return -1; } fd.close(); if(file == f.name){ dirty(f, sgmlfmt!=f.fontsused); tkcmd(t, UPDATE); } return 1; } shutdown(s: ref Draw->Screen, t: ref Tk->Toplevel): int { for(i:=1; i return 0; "exitclean" => if(dumpfile(f, f.name, f.fontsused) < 0) return 0; "exitdirty" => break; } } } return 1; } nameof(f: ref File): string { s := f.name; if(s == "") s = "(unnamed)"; return s; } tkcmd(t: ref Tk->Toplevel, s: string): string { res := tk->cmd(t, s); if(len res > 0 && res[0] == '!') sys->print("%s: tk error executing '%s': %s\n", Name, s, res); return res; } confirm_cfg := array[] of { "frame .f -borderwidth 2 -relief groove -padx 3 -pady 3", "frame .f.f", # "label .f.f.l -bitmap error -foreground red", "label .f.f.l -text Warning:", "label .f.f.m", "button .f.exitclean -text { Write and Proceed } -width 17w -command {send cmd exitclean}", "button .f.exitdirty -text { Proceed } -width 17w -command {send cmd exitdirty}", "button .f.cancel -text { Cancel } -width 17w -command {send cmd cancel}", "pack .f.f.l .f.f.m -side left", "pack .f.f .f.exitclean .f.exitdirty .f.cancel -padx 10 -pady 10", "pack .f", }; widget(parent: ref Tk->Toplevel, screen: ref Draw->Screen, cfg: array of string): ref Tk->Toplevel { x := int tk->cmd(parent, ". cget -x"); y := int tk->cmd(parent, ". cget -y"); where := sys->sprint("-x %d -y %d", x+45, y+25); t := tk->toplevel(screen, where+SETFONT+" -borderwidth 2 -relief raised"); tkcmds(t, cfg); return t; } tkcmds(top: ref Tk->Toplevel, a: array of string) { n := len a; for(i := 0; i < n; i++) v := tk->cmd(top, a[i]); } confirm(screen: ref Draw->Screen, parent: ref Tk->Toplevel, message: string, write: int): string { s := confirm1(screen, parent, message, write); tkcmd(parent, FOCUS); return s; } confirm1(screen: ref Draw->Screen, parent: ref Tk->Toplevel, message: string, write: int): string { t := widget(parent, screen, confirm_cfg); tkcmd(t, ".f.f.m configure -text '"+message); if(write == 0) tkcmd(t, "destroy .f.exitclean"); tkcmd(t, UPDATE); cmd := chan of string; tk->namechan(t, cmd, "cmd"); return <-cmd; } getfilename_cfg := array[] of { "frame .f", "label .f.Message", "entry .f.Name -width 25w", "checkbutton .f.SGML -text { Write SGML } -variable SGML", "button .f.Ok -text { OK } -width 14w -command {send cmd ok}", "button .f.Browse -text { Browse } -width 14w -command {send cmd browse}", "button .f.Cancel -text { Cancel } -width 14w -command {send cmd cancel}", "bind .f.Name {send cmd ok}", "pack .f.Message .f.Name .f.SGML .f.Ok .f.Browse .f.Cancel -padx 10 -pady 10", "pack .f", "focus .f.Name", }; getfilename(screen: ref Draw->Screen, parent: ref Tk->Toplevel, message, name: string, browse, sgml, nowsgml: int): (string, int, int) { (s, i, issgml) := getfilename1(screen, parent, message, name, browse, sgml, nowsgml); tkcmd(parent, FOCUS); return (s, i, issgml); } getfilename1(screen: ref Draw->Screen, parent: ref Tk->Toplevel, message, name: string, browse, sgml, nowsgml: int): (string, int, int) { t := widget(parent, screen, getfilename_cfg); tkcmd(t, ".f.Message configure -text '"+message); tk->cmd(t, ".f.Name insert 0 "+name); if(browse == 0) tkcmd(t, "destroy .f.Browse"); if(sgml == 0) tkcmd(t, "destroy .f.SGML"); else if(nowsgml) tkcmd(t, ".f.SGML select"); tkcmd(t, UPDATE); cmd := chan of string; tk->namechan(t, cmd, "cmd"); for(;;){ case <-cmd { "ok" => return (tkcmd(t, ".f.Name get"), 1, int tkcmd(t, "variable SGML")); "cancel" => return ("", 0, 0); "browse" => name = tkcmd(t, ".f.Name get"); (dir, path) := basepath(name); pat := list of { "* (All files)", "*.sgml (SGML dump files)", "*.html (Web source files)", "*.tex (Latex source files)", "*.[bm] (Limbo source files)" }; path = wmlib->filename(screen, parent, message, pat, dir); if(path != "") name = path; tk->cmd(t, ".f.Name delete 0 end; .f.Name insert 0 "+name+";focus .f.Name; update"); if(path != "") return (name, 1, int tkcmd(t, "variable SGML")); } } } tageditor(screen: ref Draw->Screen, f: ref File) { (start, end) := word(f.tk); if(start == nil) return; cfg := array[100] of string; i := 0; cfg[i++] = "frame .f"; (nil, names) := sys->tokenize(tkcmd(f.tk, ".ft.t tag names "+start), " "); pack := "pack"; set := array[NEXTRA] of int; for(j:=0; jnamechan(t, cmd, "cmd"); loop: for(;;){ case c := <-cmd { "ok" => break loop; "cancel" => return; * => j = int c; set[j] = (tkcmd(t, "variable c"+c) == "1"); } } for(j=0; jpctl(0, nil); for(;;){ msg := Msg.recv(); if(msg == nil){ sys->print("Brutus: can't read /chan/plumb.edit: %r\n"); plumbpid = 0; return; } if(msg.kind != "text"){ sys->print("Brutus: can't interpret '%s' kind of message\n", msg.kind); continue; } text := string msg.data; n := len text; addr := ""; for(j:=0; j0 && file[0]!='/' && len msg.dir>0){ if(msg.dir[len msg.dir-1] == '/') file = msg.dir+file; else file = msg.dir+"/"+file; } plumbc <-= (file, addr); } } killplumb() { if(plumbed == 0) return; plumbmsg->shutdown(); if(plumbpid <= 0) return; fname := sys->sprint("#p/%d/ctl", plumbpid); fd := sys->open(fname, sys->OWRITE); if(fd != nil) sys->write(fd, array of byte "kill\n", 8); } lastpat: string; execute(cmdwin: ref Tk->Toplevel, f: ref File, cmd: string) { if(len cmd>1 && cmd[len cmd-1]=='\n') cmd = cmd[0:len cmd-1]; if(cmd == "") return; if(cmd[0] == '/' || cmd[0]=='?'){ search(cmdwin, f, cmd[1:], cmd[0]=='?', 1); return; } for(i:=0; iprint("bad command %s\n", cmd); return; } t := f.tk; line := int cmd; if(!nullsel(t)) tkcmd(t, NOSEL); tkcmd(t, ".ft.t tag add sel "+string line+".0 {"+string line+".0 lineend+1char}"); tkcmd(t, ".ft.t mark set insert "+string line+".0; .ft.t see insert;update"); } search(cmdwin: ref Tk->Toplevel, f: ref File, pat: string, backwards, uselast: int) { t := f.tk; if(pat == nil) pat = lastpat; else if(uselast) lastpat = pat; if(pat == nil){ error(cmdwin, "no pattern"); return; } cmd := ".ft.t search "; if(backwards) cmd += "-backwards "; p := ""; for(i:=0; icmd(t, cmd); if(s == "") error(cmdwin, "not found"); else{ if(!null) tkcmd(t, NOSEL); tkcmd(t, ".ft.t tag add sel "+s+" "+s+"+"+string len pat+"chars"); tkcmd(t, ".ft.t mark set insert "+s+";.ft.t see insert; update"); } } showaddr(f: ref File, addr: string) { if(addr=="") return; t := f.tk; if(addr[0]=='#' || ('0'<=addr[0] && addr[0]<='9')){ # UGLY! just do line and character numbers until we get a # decent command/address interface set up. if(!nullsel(t)) tkcmd(t, NOSEL); if(addr[0] == '#'){ addr = addr[1:]; tkcmd(t, ".ft.t mark set insert {1.0+"+addr+"char}; .ft.t see insert;update"); }else{ tkcmd(t, ".ft.t tag add sel "+addr+".0 {"+addr+".0 lineend+1char}"); tkcmd(t, ".ft.t mark set insert "+addr+".0; .ft.t see insert;update"); } } } error(cmdwin: ref Tk->Toplevel, err: string) { if(cmdwin == nil) return; tkcmd(cmdwin, ".ft.t insert end '?"+err+"\n"); if(!nullsel(cmdwin)) tkcmd(cmdwin, NOSEL); tkcmd(cmdwin, ".ft.t mark set insert end"); tkcmd(cmdwin, ".ft.t mark set typingstart end; update"); }