ref: 6042bb8adffe111049edfcb8b2eb1ad84814ed69
dir: /appl/wm/vixen/vixen.b/
implement Vixen; include "sys.m"; sys: Sys; sprint: import sys; include "draw.m"; draw: Draw; include "arg.m"; include "bufio.m"; bufio: Bufio; Iobuf: import bufio; include "string.m"; str: String; include "tk.m"; tk: Tk; include "tkclient.m"; tkclient: Tkclient; include "keyboard.m"; kb: Keyboard; include "regex.m"; regex: Regex; include "plumbmsg.m"; plumbmsg: Plumbmsg; Msg: import plumbmsg; include "names.m"; names: Names; include "sh.m"; sh: Sh; include "vixen/buffers.b"; include "vixen/change.b"; include "vixen/cmd.b"; include "vixen/ex.b"; include "vixen/filter.b"; include "vixen/interp.b"; include "vixen/misc.b"; include "vixen/subs.b"; Vixen: module { init: fn(ctxt: ref Draw->Context, argv: list of string); }; iflag: int; # 't' for tk events # 'k' for tk commands # 'e' for edit # 'x' for ex # 'i' for interp (insert/replace, command, visual, move) # 'd' for misc # 'c' for cursor # 'u' for change (undo) # 'm' for modifications (textdel, textinsert) debug := array[128] of {* => int 0}; startupmacro: string; # macro to interpret at startup after opening the file Insert, Replace, Command0, Visual, Visualline: con iota; # modes modes := array[] of {"insert", "replace", "command", "visual", "visual line"}; # parameter "rec" to textdel & textins. Cnone, Cmod, Cmodrepl, Cchange, Cchangerepl, # how to record as change, for undo Csetcursorlo, Csetcursorhi, # where (if) to set cursor Csetreg: con 1<<iota; # whether to set "last change" register Cchangemask: con Csetcursorlo-1; Csetcursormask: con Csetcursorlo|Csetcursorhi; mode: int; visualstart: ref Cursor; # start of visual select, non-nil when mode == Visual or Visualline visualend: ref Cursor; # end of visual select cmdcur: ref Cmd; # current command cmdprev: ref Cmd; # previous (completed) command, for '.' recordreg := -1; # register currently recording to, < 0 when not recording record: string; # chars typed while recording, set to register when done colsnap := -1; # column to snap vertical movements to. only valid >= 0 filename: string; # may be nil initially filefd: ref Sys->FD; # may be nil initially filestat: Sys->Dir; # stat after previous read or write, to check before writing. only valid if filefd not nil. modified: int; # whether text has unsaved changes text: ref Buf; # contents textgen: big; # generation of text, increased on each changed, restored on undo/redo. textgenlast: big; # last used gen cursor: ref Cursor; # current position in text statustext: string; # info/warning/error text to display in status bar searchregex: Regex->Re; # current search, set by [/?*#] searchreverse: int; # whether search is in reverse, for [nN] searchcache: array of (int, int); # cache of search results, only valid if textgen is searchcachegen. searchcachegen := big -1; lastfind: int; # last find command, one of tTfF, for ';' and ',' lastfindchar: int; # parameter to lastfind lastmacro: int; # last macro execution, for '@@' edithist: list of string; # history of edit commands, hd is last typed edithistcur := -1; # currently selected history item, -1 when none edithisttext: string; # text currently prefix-searching for (nil at start, after edit field changed, and esc) completecache: array of string; # matches with completetext. invalid when nil completetext: string; # text for which completecache is the completion completeindex: int; # current index in completecache results change: ref Change; # current change (with 1 modification) that is being created (while in insert mode) changes: array of ref Change; # change history, for undo. first elem is oldest change. changeindex: int; # points to next new/last undone change. may be one past end of 'changes'. # marks & registers are index by ascii char, not all are valid though marks := array[128] of ref Cursor; registers := array[128] of string; register := '"'; # register to write next text deletion to b3start: ref Pos; # start of button3 press b3prev: ref Pos; # previous position while button3 down statusvisible := 1; # whether tk frame with status label is visible (and edit entry is not) highlightstart, highlightend: ref Cursor; # range to highlight for search match, can be nil plumbvisible: int; # whether address or last inserted text is visible (cleared on interp) vpfd: ref Sys->FD; # fd to /chan/vixenplumb, for handling plumbing plumbed: int; top: ref Tk->Toplevel; wmctl: chan of string; drawcontext: ref Draw->Context; # text selection color scheme. Green for plumbing. Normal, Green: con iota; tkcmds0 := array[] of { "frame .t", "text .t.text -background black -foreground white -yscrollcommand {.t.vscroll set}", "scrollbar .t.vscroll -command {.t.text yview}", "frame .s", "label .s.status -text status", "frame .e", "entry .e.edit", "bind .e.edit <Key-\n> {send edit return}", "bind .e.edit {<Key-\t>} {send edit tab}", "bind .e.edit <KeyPress> +{send edit press %K}", "bind .t.text <KeyPress> {send key %K}", "bind .t.text <ButtonPress-1> {send text b1down @%x,%y}", "bind .t.text <ButtonRelease-1> {send text b1up @%x,%y}", "bind .t.text <ButtonPress-3> {send text b3down @%x,%y}", "bind .t.text <ButtonRelease-3> {send text b3up @%x,%y}", "bind .t.text <Configure> {send text resized}", ".t.text tag configure eof -foreground blue -background white", ".t.text tag configure search -background yellow -foreground black", ".t.text tag configure plumb -background blue -foreground white", ".t.text tag raise sel", "pack .t.vscroll -fill y -side left", "pack .t.text -fill both -expand 1 -side right", "pack .t -fill both -expand 1", "pack .s.status -fill x -side left", "pack .s -fill x -side bottom -after .t", "pack .e.edit -fill x -expand 1 -side left", #"pack .e -fill x -side bottom -after .t", "pack propagate . 0", ". configure -width 700 -height 500", "focus .t.text", }; tkaddeof() { tkcmd(".t.text insert end \u0003"); tkcmd(".t.text tag add eof {end -1c} end"); } tkbinds() { tkcmd(sprint("bind .e.edit <Key-%c> {send edit esc}", kb->Esc)); tkcmd(sprint("bind .e.edit <Key-%c> {send edit up}", kb->Up)); tkcmd(sprint("bind .e.edit <Key-%c> {send edit down}", kb->Down)); binds := array[] of {'a', '<', 'b', 'd', 'e','>', 'f', 'h', 'k', 'n', 'o', 'p', 'u', 'v', 'w'}; for(i := 0; i < len binds; i++) tkcmd(sprint("bind .t.text <Control-\\%c> {}", binds[i])); binds = array[] of { kb->Home, kb->Left, kb->End, kb->Right, kb->Del, kb->Down, kb->Up, kb->Pgdown, kb->Pgup }; for(i = 0; i < len binds; i++) tkcmd(sprint("bind .t.text <Key-\\%c> {send key %%K}", binds[i])); binds = array[] of {'h', 'w', 'u', 'f', 'b', 'd', 'y', 'e', 'l', 'g', 'r', 'n', 'p'}; for(i = 0; i < len binds; i++) tkcmd(sprint("bind .t.text <Control-\\%c> {send key %x}", binds[i], kb->APP|binds[i])); } init(ctxt: ref Draw->Context, args: list of string) { sys = load Sys Sys->PATH; if(ctxt == nil) fail("no window context"); drawcontext = ctxt; draw = load Draw Draw->PATH; arg := load Arg Arg->PATH; bufio = load Bufio Bufio->PATH; str = load String String->PATH; tk = load Tk Tk->PATH; tkclient = load Tkclient Tkclient->PATH; regex = load Regex Regex->PATH; plumbmsg = load Plumbmsg Plumbmsg->PATH; names = load Names Names->PATH; sh = load Sh Sh->PATH; sh->initialise(); sys->pctl(Sys->NEWPGRP|Sys->FORKNS, nil); arg->init(args); arg->setusage(arg->progname()+" [-d debug] [-c macro] [-i] path"); while((c := arg->opt()) != 0) case c { 'c' => startupmacro = arg->arg(); 'd' => s := arg->arg(); for(i := 0; i < len s; i++) case x := s[i] { '+' => debug = array[128] of {* => 1}; 'a' to 'z' => debug[x]++; * => fail(sprint("debug char %c a-z or +", x)); } 'i' => iflag++; * => arg->usage(); } args = arg->argv(); case len args { 0 => {} 1 => filename = hd args; * => arg->usage(); } plumbed = plumbmsg->init(1, nil, 0) >= 0; vpc := chan of (string, string); vpfd = sys->open("/chan/vixenplumb", Sys->ORDWR); if(vpfd != nil) spawn vixenplumbreader(vpfd, vpc); else warn(sprint("no plumbing, open /chan/vixenplumb: %r")); text = text.new(); cursor = text.pos(Pos(1, 0)); xmarkput('`', cursor); cmdcur = Cmd.new(); xregput('!', "mk"); openerr: string; if(filename != nil) { filefd = sys->open(filename, Sys->ORDWR); if(filefd == nil) openerr = sprint("%r"); else { ok: int; (ok, filestat) = sys->fstat(filefd); if(ok < 0) { openerr = sprint("stat: %r"); filefd = nil; } } # if filefd is nil, we warn that this is a new file when tk is initialized } tkclient->init(); (top, wmctl) = tkclient->toplevel(ctxt, "", "vixen", Tkclient->Appl); textc := chan of string; keyc := chan of string; editc := chan of string; tk->namechan(top, textc, "text"); tk->namechan(top, keyc, "key"); tk->namechan(top, editc, "edit"); tkcmds(tkcmds0); tkselcolor(Normal); tkbinds(); if(filename != nil) filenameset(filename); if(filename != nil && filefd == nil) { (ok, dir) := sys->stat(filename); if(ok < 0) statuswarn(sprint("new file %q", filename)); else if(dir.mode & Sys->DMDIR) statuswarn(sprint("%q is directory", filename)); else statuswarn(sprint("open: %s", openerr)); } if(iflag) oerr := textfill(sys->fildes(0)); else if(filefd != nil) oerr = textfill(filefd); if(oerr != nil) statuswarn("reading: "+oerr); tkaddeof(); up(); modeset(Command0); if(startupmacro != nil) { cmdcur = Cmd.mk(startupmacro); interpx(); } tkclient->onscreen(top, nil); tkclient->startinput(top, "kbd"::"ptr"::nil); for(;;) alt { s := <-top.ctxt.kbd => tk->keyboard(top, s); s := <-top.ctxt.ptr => tk->pointer(top, *s); s := <-top.ctxt.ctl or s = <-top.wreq => tkclient->wmctl(top, s); menu := <-wmctl => case menu { "exit" => quit(); * => tkclient->wmctl(top, menu); } txt := <-textc => # special keys/mouse from text widget say('t', sprint("text: %q", txt)); (nil, t) := sys->tokenize(txt, " "); case hd t { "b1down" => v := tkcmd(".t.text index "+hd tl t); if(str->prefix("!", v)) break; pos := Pos.parse(v); modeset(Command0); cursorset(text.pos(pos)); tkselectionset(cursor.pos, cursor.pos); tkselcolor(Normal); "b1up" => v := tkcmd(".t.text index "+hd tl t); if(str->prefix("!", v)) break; nc := text.pos(Pos.parse(v)); ranges := tkcmd(".t.text tag ranges sel"); if(ranges != nil) { (nil, l) := sys->tokenize(ranges, " "); if(len l != 2) { tkcmd(".t.text tag remove sel "+ranges); warn(sprint("bad selection range %q?", ranges)); continue; } modeset(Visual); visualstart = text.pos(Pos.parse(hd l)); cursor = text.pos(Pos.parse(hd tl l)); if(Cursor.cmp(nc, cursor) < 0) (cursor, visualstart) = (visualstart, cursor); visualend = cursor.clone(); cursorset(cursor); } "b3down" => v := tkcmd(".t.text index "+hd tl t); if(str->prefix("!", v)) break; pos := ref Pos.parse(v); if(b3start == nil) { tkselectionset(cursor.pos, cursor.pos); tkselcolor(Green); b3start = b3prev = pos; } else if(!Pos.eq(*pos, *b3prev)) { (a, b) := Pos.order(*pos, *b3start); tkselectionset(a, b); b3prev = pos; } say('t', sprint("b3down at char %s", (*pos).text())); "b3up" => v := tkcmd(".t.text index "+hd tl t); if(str->prefix("!", v)) break; pos := Pos.parse(v); say('t', sprint("b3up at char %s", pos.text())); if(Pos.eq(*b3start, pos)) { cx := text.pos(pos); (cs, ce) := cx.pathpattern(0); if(cs == nil) statuswarn("not a path"); else plumb(text.get(cs, ce), nil, plumbdir()); } else { cs := text.pos(*b3start); ce := text.pos(pos); (cs, ce) = Cursor.order(cs, ce); plumb(text.get(cs, ce), nil, plumbdir()); } b3start = b3prev = nil; case mode { Visual or Visualline => cursorset(cursor); visualset(); * => tkcmd(sprint(".t.text tag remove sel 1.0 end")); } tkselcolor(Normal); "resized" => tkcmd(".t.text see insert"); * => warn(sprint("text unhandled, %q", txt)); } up(); s := <-keyc => # keys from text widget say('t', sprint("cmd: %q", s)); (x, rem) := str->toint(s, 16); if(rem != nil) { warn(sprint("bogus char code %q, ignoring", s)); continue; } key(x); interpx(); e := <-editc => # special keys from edit widget say('t', sprint("edit: %q", e)); editinput(e); up(); (s, err) := <-vpc => say('d', sprint("vpc, s %q, err %q", s, err)); if(err != nil) { statuswarn("vixenplumb failed: "+err); continue; } if(iflag) { ps := text.end(); textins(Cchange, ps, s); tkplumbshow(ps.pos, text.end().pos); tkcmd(sprint(".t.text see %s", ps.pos.text())); } else { nc: ref Cursor; (nc, err) = address(Cmd.mk(s), cursor); if(err != nil) { statuswarn(sprint("bad address from vixenplumb: %q: %s", s, err)); } else { cursorset(nc); tkplumbshow(nc.mvcol(0).pos, nc.mvlineend(1).pos); statuswarn(sprint("new address from vixenplumb: %s", s)); } } tkclient->wmctl(top, "raise"); tkclient->wmctl(top, "kbdfocus 1"); tkclient->onscreen(top, "onscreen"); up(); } } filenameset(s: string) { filename = names->cleanname(names->rooted(workdir(), s)); if(isdir(filename) && (filename != nil && filename[len filename-1] != '/')) filename[len filename] = '/'; tkclient->settitle(top, "vixen "+filename); if(vpfd != nil) { f := filename; if(f[len f-1] == '/') f = f[:len f-1]; if(sys->fprint(vpfd, "%s", f) < 0) statuswarn(sprint("telling vixenplumb about filename: %r")); } } vixenplumbreader(fd: ref Sys->FD, vpc: chan of (string, string)) { buf := array[8*1024] of byte; # Iomax in vixenplumb for(;;) { n := sys->read(fd, buf, len buf); if(n <= 0) { err := "eof"; if(n < 0) err = sprint("%r"); vpc <-= (nil, err); break; } s := string buf[:n]; vpc <-= (s, nil); } } editinput(e: string) { case e { "return" => s := tkcmd(".e.edit get"); if(s == nil) raise "empty string from entry"; say('e', sprint("edit command: %q", s)); s = s[1:]; # first char has already been read tkcmd(".e.edit delete 0 end"); edithistput(s); for(i := 0; i < len s; i++) key(s[i]); key('\n'); interpx(); tkcmd("focus .t.text"); "tab" => Completebreak: con " \t!\"\'#$%&'()*+,:;<=>?@\\]^_`{|}~"; s := tkcmd(".e.edit get"); i := int tkcmd(".e.edit index insert"); while(i-1 >= 0 && !str->in(s[i-1], Completebreak)) --i; s = s[i:]; r: string; ++completeindex; if(completecache != nil && completeindex >= len completecache) { r = completetext; completecache = nil; } else { if(completecache == nil) { err: string; (completecache, err) = complete(s); if(err != nil) return statuswarn("complete: "+err); if(len completecache == 0) return statuswarn("no match"); completeindex = 0; completetext = s; } r = completecache[completeindex]; if(len completecache == 1) completecache = nil; } tkcmd(sprint(".e.edit delete %d end", i)); tkcmd(".e.edit insert end '"+r); "up" or "down" => # if up/down was down without esc or text editing afterwards, # we use the originally typed text to search, not what's currently in the edit field. a := l2a(rev(edithist)); say('e', sprint("edithist, edithistcur=%d:", edithistcur)); for(i := 0; i < len a; i++) say('e', sprint("%3d %s", i, a[i])); editnavigate(e == "up"); "esc" => editesc(); * => if(str->prefix("press ", e)) { (x, rem) := str->toint(e[len "press ":], 16); if(rem != nil) return warn(sprint("bad edit press %q", e)); # key presses are interpreted by tk widget first, then sent here. # on e.g. ^h of last char, we see an empty string in the entry, so we abort. if(x != '\n' && tkcmd(".e.edit get") == nil) editesc(); # we get up/down and other specials too, they don't change the text if((x & kb->Spec) != kb->Spec && x != '\t') { edithistcur = -1; edithisttext = nil; completecache = nil; } } else warn(sprint("unhandled edit command %q", e)); } } # key from text widget or from macro execute key(x: int) { if(recordreg >= 0) record[len record] = x; cmdcur.put(x); } editesc() { tkcmd(".e.edit delete 0 end"); edithistcur = -1; edithisttext = nil; tkcmd("focus .t.text"); key(kb->Esc); interpx(); } editset0(index: int, s: string) { edithistcur = index; tkcmd(sprint("focus .e.edit; .e.edit delete 0 end; .e.edit insert 0 '%s", s)); } editset(s: string) { editset0(-1, s); } xeditget(c: ref Cmd, pre: string): string { if(statusvisible) { tkcmd("pack forget .s; pack .e -fill x -side bottom -after .t"); statusvisible = 0; } if(!c.more()) raise "edit:"+pre; if(c.char() == kb->Esc) xabort(nil); s: string; Read: for(;;) case x := c.get() { -1 => # text from .e.entry has a newline, but don't require one from -c or '@' break Read; '\n' => say('e', sprint("xeditget, returning %q", s)); break Read; * => s[len s] = x; } r := pre[0]; if(r == '?') r = '/'; xregput(r, s); return s; } editnavigate(up: int) { if(edithisttext == nil) edithisttext = tkcmd(".e.edit get"); a := l2a(rev(edithist)); if(up) { for(i := edithistcur+1; i < len a; ++i) if(str->prefix(edithisttext, a[i])) return editset0(i, a[i]); } else { for(i := edithistcur-1; i >= 0; --i) if(str->prefix(edithisttext, a[i])) return editset0(i, a[i]); } statuswarn("no match"); } edithistput(s: string) { if(s != nil) { edithist = s::edithist; edithistcur = -1; } } complete(pre: string): (array of string, string) { (path, f) := str->splitstrr(pre, "/"); say('e', sprint("complete, pre %q, path %q, f %q", pre, path, f)); dir := path; if(path == nil) dir = "."; fd := sys->open(dir, Sys->OREAD); if(fd == nil) return (nil, sprint("open: %r")); l: list of string; for(;;) { (n, a) := sys->dirread(fd); if(n == 0) break; if(n < 0) return (nil, sprint("dirread: %r")); for(i := 0; i < n; i++) if(str->prefix(f, a[i].name)) { s := path+a[i].name; if(a[i].mode & Sys->DMDIR) s += "/"; l = s::l; } } return (l2a(rev(l)), nil); } # return directory to plumb from: dir where filename is in, or workdir if no filename is set plumbdir(): string { if(filename == nil) return workdir(); return names->dirname(filename); } plumb(s, kind, dir: string) { if(!plumbed) return statuswarn("cannot plumb"); if(kind == nil) kind = "text"; msg := ref Msg("vixen", "", dir, kind, "", array of byte s); say('d', sprint("plumbing %s", string msg.pack())); msg.send(); } changesave() { if(change == nil) return; changeadd(change); change = nil; } changeadd(c: ref Change) { if(changeindex < len changes) { changes = changes[:changeindex+1]; } else { n := array[len changes+1] of ref Change; n[:] = changes; changes = n; } if(c.ogen == c.ngen) raise "storing a change with same orig as new gen?"; c.ngen = textgen; say('u', "changeadd, storing:"); say('u', c.text()); changes[changeindex++] = c; } apply(c: ref Change): int { say('u', "apply:"); say('u', c.text()); for(l := c.l; l != nil; l = tl l) pick m := hd l { Ins => textins(Cnone, text.pos(m.p), m.s); Del => textdel(Cnone, text.pos(m.p), text.cursor(m.o+len m.s)); } textgen = c.ngen; cursorset(text.pos(c.beginpos())); return 1; } undo() { say('u', sprint("undo, changeindex=%d, len changes=%d", changeindex, len changes)); if(changeindex == 0) return statuswarn("already at oldest change"); if(apply(changes[changeindex-1].invert())) --changeindex; } redo() { say('u', "redo"); if(changeindex >= len changes) return statuswarn("already at newest change");; c := ref *changes[changeindex]; c.l = rev(c.l); if(apply(c)) ++changeindex; } searchset(s: string): int { searchcachegen = big -1; searchcache = nil; err: string; (searchregex, err) = regex->compile(s, 0); if(err != nil) { searchregex = nil; statuswarn("bad pattern"); return 0; } return 1; } searchall(re: Regex->Re): array of (int, int) { if(textgen == searchcachegen) return searchcache; l: list of (int, int); o := 0; s := text.str(); sol := 1; while(o < len s) { for(e := o; e < len s && s[e] != '\n'; ++e) {} r := regex->executese(re, s, (o, e), sol, 1); if(len r >= 1 && r[0].t0 >= 0) { l = r[0]::l; o = r[0].t1; sol = 0; } else { sol = 1; o = e+1; } } r := array[len l] of (int, int); for(i := len r-1; i >= 0; --i) { r[i] = hd l; l = tl l; } searchcache = r; searchcachegen = textgen; return r; } search(rev, srev: int, re: Regex->Re, cr: ref Cursor): (ref Cursor, ref Cursor) { if(re == nil) { statuswarn("no search pattern set"); return (nil, nil); } if(srev) rev = !rev; r := searchall(re); if(len r == 0 || r[0].t0 < 0) { statuswarn("pattern not found"); return (nil, nil); } i: int; if(rev) { for(i = len r-1; i >= 0; i--) if(r[i].t0 < cr.o) break; if(i < 0) { i = len r-1; statuswarn("search wrapped"); } } else { for(i = 0; i < len r; i++) if(r[i].t0 > cr.o) break; if(i >= len r) { i = 0; statuswarn("search wrapped"); } } return (text.cursor(r[i].t0), text.cursor(r[i].t1)); } xregset(c: int) { # we don't know if it will be for get or set yet, so % is valid if(c != '%') xregcanput(c); register = c; } xregget(c: int): string { (s, err) := regget(c); if(err == nil && s == nil) err = sprint("register %c empty", c); if(err != nil) xabort(err); return s; } xregcanput(c: int) { case c { 'a' to 'z' or '/' or ':' or '.' or '"' or 'A' to 'Z' or '*' or '!' => return; '%' => xabort("register % is read-only"); * => xabort(sprint("bad register %c", c)); } } xregput(x: int, s: string) { err := regput(x, s); if(err != nil) xabort(err); } regget(c: int): (string, string) { r: string; case c { 'a' to 'z' or '/' or ':' or '.' or '"' or '!' => r = registers[c]; 'A' to 'Z' => r = registers[c-'A'+'a']; '%' => r = filename; '*' => r = tkclient->snarfget(); * => return (nil, sprint("bad register %c", c)); } return (r, nil); } regput(c: int, s: string): string { case c { 'a' to 'z' or '/' or ':' or '.' or '"' or '!' => registers[c] = s; 'A' to 'Z' => registers[c-'A'+'a'] += s; '%' => return "register % is read-only"; '*' => tkclient->snarfput(s); return nil; * => return sprint("bad register %c", c); } return nil; } markget(c: int): (ref Cursor, string) { m: ref Cursor; case c { 'a' to 'z' or '`' or '\'' or '.' or '^' => m = marks[c]; '<' or '>' => if(mode != Visual && mode != Visualline) return (nil, "selection not set"); (vs, ve) := visualrange(); case c { '<' => m = vs; '>' => m = ve; } * => return (nil, sprint("bad mark %c", c)); } if(m == nil) return (nil, sprint("mark %c not set", c)); return (m, nil); } xmarkget(c: int): ref Cursor { (m, err) := markget(c); if(err != nil) xabort(err); return m; } xmarkput(c: int, m: ref Cursor) { m = m.clone(); case c { 'a' to 'z' or '.' or '^' => marks[c] = m; '`' or '\'' => marks['`'] = marks['\''] = m; # < and > cannot be set explicitly * => xabort(sprint("bad mark %c", c)); } } # fix marks, cs-ce have just been deleted (and their positions are no longer valid!) markfixdel(cs, ce: ref Cursor) { for(i := 0; i < len marks; i++) { m := marks[i]; if(m == nil || m.o < cs.o) continue; if(m.o < ce.o) marks[i] = nil; else marks[i] = text.cursor(m.o-Cursor.diff(cs, ce)); } } # fix marks, n bytes have just been inserted at cs markfixins(cs: ref Cursor, n: int) { for(i := 0; i < len marks; i++) { m := marks[i]; if(m == nil || m.o < cs.o) continue; marks[i] = text.cursor(m.o+n); } } # 'q' was received while in command or visual mode. recordq(c: ref Cmd) { say('d', sprint("recordq, recordreg %c, record %q, c %s", recordreg, record, c.text())); if(recordreg >= 0) { xregput(recordreg, record[:len record-1]); # strip last 'q' at end say('d', sprint("register %c now %q", recordreg, registers[recordreg])); record = nil; recordreg = -1; } else { y := c.xget(); xregcanput(y); recordreg = y; } } # whether text was inserted/replaced inserted(): int { if(change != nil) pick m := hd change.l { Ins => return m.o+len m.s == cursor.o; } return 0; } textrepl(rec: int, a, b: ref Cursor, s: string) { if(a == nil) a = cursor; if(b == nil) b = cursor; textdel(rec, a, b); textins(rec, a, s); } # delete from a to b. # rec indicates whether a Change must be recorded, # where the cursor should be, # and whether the last change register should be set. textdel(rec: int, a, b: ref Cursor) { tkhighlightclear(); if(a == nil) a = cursor; if(b == nil) b = cursor; setreg := rec & Csetreg; setcursor := rec & Csetcursormask; swap := Cursor.cmp(a, b) > 0; if(swap) (a, b) = (b, a); s := text.get(a, b); rec &= Cchangemask; Change: case rec { Cnone => {} Cmodrepl => say('m', sprint("textdel, Cmodrepl, s %q, a %s, b %s", s, a.text(), b.text())); if(change == nil) return statuswarn("beep!"); pick m := hd change.l { Ins => say('m', "textdel, last was insert"); if(m.o+len m.s != b.o) raise "delete during replace should be at end of previous insert"; if(len s > len m.s) { a = text.cursor(b.o-len m.s); s = text.get(a, b); } m.s = m.s[:len m.s-len s]; # we check below whether we have to remove this Mod.Ins Del => say('m', "textdel, last was del"); return statuswarn("beep!"); } Cmod or Cchange => if(change != nil) pick m := hd change.l { Ins => if(m.o+len m.s == b.o) { if(len s > len m.s) { a = text.cursor(b.o-len m.s); s = text.get(a, b); } m.s = m.s[:len m.s-len s]; if(m.s == nil) { change.l = tl change.l; if(change.l == nil) change = nil; } break Change; } Del => if(rec != Cmod && rec != Cmodrepl && m.o == a.o) { m.s += s; break Change; } } if(rec == Cmod) return statuswarn("beep!"); if(change == nil) change = ref Change (0, nil, textgen, ~big 0); change.l = ref Mod.Del (a.o, a.pos, s)::change.l; Cchangerepl => raise "should not happen"; * => raise "bad rec"; } if(setreg) xregput(register, s); tkcmd(sprint(".t.text delete %s %s", a.pos.text(), b.pos.text())); text.del(a, b); textgen = textgenlast++;; markfixdel(a, b); if(rec != Cnone) xmarkput('.', a); if(rec == Cmodrepl) { # Mod.Del may be absent, eg when replace was started at end of file if(tl change.l != nil) { pick m := hd tl change.l { Del => # if a is in this del, remove till end of it, and insert at the cursor if(a.o >= m.o && a.o < m.o+len m.s) { nn := a.o-m.o; os := m.s[nn:]; m.s = m.s[:nn]; text.ins(a, os); textgen = textgenlast++; markfixins(a, len os); tkcmd(sprint(".t.text insert %s '%s", a.pos.text(), os)); if(a.o+len os >= text.chars()) tkcmd(sprint(".t.text tag remove eof %s {%s +%dc}", a.pos.text(), a.pos.text(), len os)); } } } pick m := hd change.l { Ins => if(m.s == nil) change.l = tl change.l; } pick m := hd change.l { Del => if(m.s == nil) change.l = tl change.l; } if(change.l == nil) change = nil; } if(setcursor) { n: ref Cursor; case setcursor { 0 => {} Csetcursorlo => n = a; Csetcursorhi => n = b; * => raise "bad rec"; } cursorset(n); } } textins(rec: int, c: ref Cursor, s: string) { tkhighlightclear(); if(c == nil) c = cursor; setcursor := rec&Csetcursormask; rec &= Cchangemask; Change: case rec { Cnone => {} Cmod or Cmodrepl => raise "should not happen"; Cchange or Cchangerepl => ins := 0; if(change != nil) { pick m := hd change.l { Ins => if(m.o+len m.s == c.o) { m.s += s; ins = 1; } } } if(!ins) { if(change == nil) change = ref Change (0, nil, textgen, ~big 0); change.l = ref Mod.Ins (c.o, c.pos, s)::change.l; } if(rec == Cchangerepl) { n := min(len s, len text.str()-c.o); if(n > 0) { (a, b) := (text.cursor(c.o), text.cursor(c.o+n)); tkcmd(sprint(".t.text delete %s %s", a.pos.text(), b.pos.text())); os := text.del(a, b); textgen = textgenlast++; markfixdel(a, b); if(tl change.l != nil) { pick m := hd tl change.l { Del => if(c.o == m.o+len m.s) { m.s += os; break Change; } } } m := ref Mod.Del (c.o, c.pos, os); change.l = hd change.l::m::tl change.l; } } * => raise "bad rec"; } tkcmd(sprint(".t.text insert %s '%s", c.pos.text(), s)); if(c.o+len s >= text.chars()) tkcmd(sprint(".t.text tag remove eof %s {%s +%dc}", c.pos.text(), c.pos.text(), len s)); nc := text.ins(c, s); textgen = textgenlast++; markfixins(c, len s); case setcursor { 0 => {} Csetcursorlo => cursorset(c); Csetcursorhi => cursorset(nc); * => raise "bad rec"; } modified = 1; say('m', sprint("textins, inserted %q, cursor now %s", s, cursor.text())); } textfill(fd: ref Sys->FD): string { b := bufio->fopen(fd, Sys->OREAD); if(b == nil) return sprint("fopen: %r"); s: string; n := 0; for(;;) { case x := b.getc() { Bufio->EOF => tkcmd(".t.text insert end '"+s); text.set(s); return nil; bufio->ERROR => return sprint("read: %r"); * => s[n++] = x; } } } writemodifiedquit(force: int) { if(modified) { if(filename == nil) return statuswarn("no filename set"); err := textwrite(force, filename, nil, nil); if(err != nil) return statuswarn(err); modified = 0; } if(modified && !force) return statuswarn("unsaved changes"); quit(); } # write cs-ce to f (force makes it overwrite f when it exists or when cs/ce is not nil). textwrite(force: int, f: string, cs, ce: ref Cursor): string { fd: ref Sys->FD; if(f == nil) return "no filename set"; if(filefd == nil || f != filename) { fd = sys->open(f, Sys->ORDWR); if(fd != nil && !force) return "file already exists"; if(fd == nil) fd = sys->create(f, Sys->ORDWR, 8r666); if(fd == nil) return sprint("create: %r"); if(f == filename) filefd = fd; } else { (ok, st) := sys->fstat(filefd); if(ok < 0) return sprint("stat: %r"); if(!force) { if(st.qid.vers != filestat.qid.vers) return sprint("file's qid version has changed, not writing"); if(st.mtime != filestat.mtime || st.length != filestat.length) return sprint("file's length or mtime has changed, not writing"); } sys->seek(filefd, big 0, Sys->SEEKSTART); d := sys->nulldir; d.length = big 0; if(sys->fwstat(filefd, d) < 0) return sprint("truncate %q: %r", f); fd = filefd; } err := bufwritefd(text, cs, ce, fd); if(filefd != nil) { ok: int; (ok, filestat) = sys->fstat(filefd); if(ok < 0) return sprint("stat after write: %r"); } return err; } textappend(f: string, cs, ce: ref Cursor): string { if(cs == nil) s := text.str(); else s = text.get(cs, ce); b := bufio->open(f, Sys->OWRITE); if(b == nil) return sprint("open: %r"); b.seek(big 0, bufio->SEEKEND); if(b.puts(s) == Bufio->ERROR || b.flush() == Bufio->ERROR) return sprint("write: %r"); return nil; } readfile(f: string): (string, string) { b := bufio->open(f, Bufio->OREAD); if(b == nil) return (nil, sprint("open: %r")); s := ""; for(;;) case c := b.getc() { Bufio->EOF => return (s, nil); Bufio->ERROR => return (nil, sprint("read: %r")); * => s[len s] = c; } } statuswarn(s: string) { say('d', "statuswarn: "+s); statustext = s; statusset(); } statusset() { s := sprint("%9s ", "("+modes[mode]+")"); if(recordreg >= 0) s += "recording "; if(filename == nil) s += "(no filename)"; else s += sprint("%q", names->basename(filename, nil)); s += sprint(", %4d lines, %5d chars, pos %s", text.lines(), text.chars(), cursor.pos.text()); if(cmdcur.rem() != nil) s += ", "+cmdcur.rem(); if(statustext != nil) s += ", "+statustext; tkcmd(sprint(".s.status configure -text '%s", s)); if(!statusvisible) { tkcmd("pack forget .e; pack .s -fill x -side bottom -after .t"); statusvisible = 1; } } visualrange(): (ref Cursor, ref Cursor) { (a, b) := Cursor.order(visualstart.clone(), visualend.clone()); if(mode == Visualline) { a = a.mvcol(0); b = b.mvlineend(1); } return (a, b); } visualset() { (a, b) := visualrange(); tkselectionset(a.pos, b.pos); } tkselectionset(a, b: Pos) { say('t', sprint("selectionset, from %s to %s", a.text(), b.text())); tkcmd(".t.text tag remove sel 1.0 end"); tkcmd(sprint(".t.text tag add sel %s %s", a.text(), b.text())); } redraw() { (spos, nil) := tkvisible(); tkcmd(".t.text delete 1.0 end"); tkcmd(".t.text insert 1.0 '"+text.str()); tkaddeof(); case mode { Visual or Visualline => visualset(); } cursorset(cursor); if(highlightstart != nil) tkhighlight(highlightstart, highlightend); plumbvisible = 0; tkcmd(sprint(".t.text see %s", spos.text())); } tkhighlightclear() { if(highlightstart != nil) { tkcmd(".t.text tag remove search 1.0 end"); highlightstart = highlightend = nil; } } tkhighlight(s, e: ref Cursor) { tkhighlightclear(); tkcmd(sprint(".t.text tag add search %s %s", s.pos.text(), e.pos.text())); (highlightstart, highlightend) = (s, e); } tkplumbclear() { if(plumbvisible) { tkcmd(".t.text tag remove plumb 1.0 end"); plumbvisible = 0; } } tkplumbshow(s, e: Pos) { tkplumbclear(); tkcmd(sprint(".t.text tag add plumb %s %s", s.text(), e.text())); plumbvisible = 1; } tkinsertset(p: Pos) { tkcmd(sprint(".t.text mark set insert %s", p.text())); } cursorset0(c: ref Cursor, see: int) { say('c', sprint("new cursor: %s", c.text())); cursor = c; tkinsertset(c.pos); if(see) tkcmd(sprint(".t.text see %s", c.pos.text())); } cursorset(c: ref Cursor) { cursorset0(c, 1); } up() { tkcmd("update"); } tkvisibletop(): Pos { return Pos.parse(tkcmd(".t.text index @0,0")); } tkvisiblebottom(): Pos { height := tkcmd(".t.text cget -actheight"); s := tkcmd(sprint(".t.text index @0,%d", int height-1)); return Pos.parse(s); } tkvisible(): (Pos, Pos) { return (tkvisibletop(), tkvisiblebottom()); } tklinesvisible(): int { (a, b) := tkvisible(); return b.l+1-a.l; } tkselcolor(w: int) { case w { Normal => tkcmd(".t.text tag configure sel -background white -foreground black"); Green => tkcmd(".t.text tag configure sel -background green -foreground white"); } } tkcmd(s: string): string { say('k', s); r := tk->cmd(top, s); if(r != nil && r[0] == '!') warn(sprint("tkcmd: %q: %s", s, r)); if(r != nil) say('k', " -> "+r); return r; } tkcmds(a: array of string) { for(i := 0; i < len a; i++) tkcmd(a[i]); } quit() { killgrp(pid()); exit; } pid(): int { return sys->pctl(0, nil); } progctl(pid: int, s: string) { sys->fprint(sys->open(sprint("/prog/%d/ctl", pid), sys->OWRITE), "%s", s); } kill(pid: int) { progctl(pid, "kill"); } killgrp(pid: int) { progctl(pid, "killgrp"); } min(a, b: int): int { if(a < b) return a; return b; } max(a, b: int): int { if(a > b) return a; return b; } abs(a: int): int { if(a < 0) a = -a; return a; } l2a[T](l: list of T): array of T { a := array[len l] of T; i := 0; for(; l != nil; l = tl l) a[i++] = hd l; return a; } rev[T](l: list of T): list of T { r: list of T; for(; l != nil; l = tl l) r = hd l::r; return r; } warn(s: string) { sys->fprint(sys->fildes(2), "%s\n", s); } say(c: int, s: string) { if(debug[c]) warn(s); } fail(s: string) { warn(s); killgrp(pid()); raise "fail:"+s; }