ref: 1018d7a7091fd5e0433f501a3474cdc3fec322cc
dir: /appl/wm/edit.b/
# # Copyright © 1996-1999 Lucent Technologies Inc. All rights reserved. # Modified version of edit # D.B.Knudsen # Revisions Copyright © 2000-2002 Vita Nuova Holdings Limited. All rights reserved. # implement WmEdit; include "sys.m"; sys: Sys; include "draw.m"; draw: Draw; Rect, Screen: import draw; include "tk.m"; tk: Tk; include "tkclient.m"; tkclient: Tkclient; include "dialog.m"; dialog: Dialog; include "selectfile.m"; selectfile: Selectfile; WmEdit: module { init: fn(ctxt: ref Draw->Context, argv: list of string); }; ErrIco: con "error -fg red"; ed: ref Tk->Toplevel; dirty := 0; BLUE : con "#0000ff"; GREEN : con "#008800"; SEARCH, SEARCHFOR, REPLACE, REPLACEWITH, REPLACEALL, NOSEE : con iota; ed_config := array[] of { "frame .m -relief raised", "frame .b", "menubutton .m.file -text File -menu .m.file.menu", "menubutton .m.edit -text Edit -menu .m.edit.menu", "menubutton .m.search -text Search -menu .m.search.menu", "menubutton .m.options -text Options -menu .m.options.menu", # "label .m.filename", "pack .m.file .m.edit .m.search .m.options -side left", # "pack .m.filename -padx 10 -side left", "menu .m.file.menu", ".m.file.menu add command -label New -command {send c new}", ".m.file.menu add command -label Open... -command {send c open}", ".m.file.menu add separator", ".m.file.menu add command -label Save -command {send c save}", ".m.file.menu add command -label {Save As...} -command {send c saveas}", ".m.file.menu add separator", ".m.file.menu add command -label {Exit} -command {send c exit}", "menu .m.edit.menu", ".m.edit.menu add command -label Cut -command {send c cut}", ".m.edit.menu add command -label Copy -command {send c copy}", ".m.edit.menu add command -label Paste -command {send c paste}", "menu .m.search.menu", ".m.search.menu add command -label {Find ...} " + "-command {send c searchf}", ".m.search.menu add command -label {Replace with...} " + "-command {send c replacew}", ".m.search.menu add command -label {Find Again} -command {send c search}", ".m.search.menu add command -label {Find and Replace} " + "-command {send c replace}", ".m.search.menu add command -label {Find and Replace All} " + "-command {send c replaceall}", "menu .m.options.menu", ".m.options.menu add checkbutton -text Limbo -command {send c limbo}", ".m.options.menu add command -label Indent -command {send c indent}", "text .b.t -yscrollcommand {.b.s set} -bg white", "bind .b.t <Button-2> {.m.edit.menu post %X %Y}", "bind .b.t <Key> +{send c dirtied {%A}}", "bind .b.t <ButtonRelease-1> +{send c reindent}", "scrollbar .b.s -command {.b.t yview}", "pack .m -fill x", "pack .b.s -fill y -side left", "pack .b.t -fill both -expand 1", "pack .b -fill both -expand 1", "focus .b.t", "pack propagate . 0", ".b.t tag configure keyword -fg " + BLUE, ".b.t tag configure comment -fg " + GREEN, "update", }; context : ref Draw->Context; curfile := "(New)"; snarf := ""; searchfor := ""; replacewith := ""; path := "."; init(ctxt: ref Draw->Context, argv: list of string) { wmctl: chan of string; sys = load Sys Sys->PATH; draw = load Draw Draw->PATH; tk = load Tk Tk->PATH; tkclient = load Tkclient Tkclient->PATH; selectfile = load Selectfile Selectfile->PATH; dialog = load Dialog Dialog->PATH; sys->pctl(Sys->NEWPGRP, nil); tkclient->init(); selectfile->init(); dialog->init(); context = ctxt; (ed, wmctl) = tkclient->toplevel(context, "", "Edit", Tkclient->Appl); argv = tl argv; c := chan of string; tk->namechan(ed, c, "c"); for (i := 0; i < len ed_config; i++) cmd(ed, ed_config[i]); if (argv != nil) { e := loadtfile(hd argv); if(e != nil) dialog->prompt(ctxt, ed.image, ErrIco, "Open file", e, 0, "Ok"::nil); } tkclient->settitle(ed, "Edit " + curfile); tkclient->onscreen(ed, nil); tkclient->startinput(ed, "ptr" :: "kbd" :: nil); cmd(ed, "update"); e := cmd(ed, "variable lasterror"); if(e != "") { sys->print("edit error: %s\n", e); return; } cmdloop: for(;;) { alt { key := <-ed.ctxt.kbd => tk->keyboard(ed, key); m := <-ed.ctxt.ptr => tk->pointer(ed, *m); s := <-ed.ctxt.ctl or s = <-ed.wreq or s = <-wmctl => if(s == "exit") { if (check_dirty()) break cmdloop; else break; } task_title: string; if (s == "task") { if (curfile == "(New)") task_title = tkclient->settitle(ed, "Edit"); else task_title = tkclient->settitle(ed, "Edit " + curfile); cmd(ed, "update"); } tkclient->wmctl(ed, s); if (s == "task") tkclient->settitle(ed, task_title); s := <-c => if ( len s > 7 && s[:7] == "dirtied" ) { set_dirty(); do_limbo_check(s); } else case s { "exit" => if ( check_dirty() ){ set_clean(); break cmdloop; } "dirtied" => set_dirty(); do_limbo_check(s); "new" => if ( check_dirty()) {set_clean(); do_new();} "open" => if ( check_dirty() && do_open()) set_clean(); "save" => do_save(0); "saveas" => do_save(1); "cut" => do_snarf(1); set_dirty(); "copy" => do_snarf(0); "paste" => do_paste(); set_dirty(); "search" => do_search(SEARCH); "searchf" => do_search(SEARCHFOR); "replace" => do_replace(REPLACE); "replacew" => do_replace(REPLACEWITH); "replaceall" => do_replaceall(); "limbo" => do_limbo(); "indent" => do_indent(); "reindent" => re_indent(); } cmd(ed, "focus .b.t"); } cmd(ed, "update"); e = cmd(ed, "variable lasterror"); if(e != "") { sys->print("edit error: %s\n", e); break cmdloop; } } } check_dirty() : int { if ( dirty == 0 ) return 1; if (dialog->prompt(context, ed.image, ErrIco, "Confirm", "File was changed.\nDiscard changes?", 0, "Yes" :: "No" :: nil) == 0 ) { return 1; } return 0; } set_dirty() { if(!dirty){ dirty = 1; tkclient->settitle(ed, "Edit " + curfile + " (dirty)"); cmd(ed, "update"); } # We want to just remove the binding, but Inferno's tk does not # recognize the - in front of the command. To make it do so would # require changes to utils.c and ebind.c in /tk # cmd(ed, "bind .b.t <Key> -{send c dirtied}"); } set_clean() { if(dirty){ dirty = 0; tkclient->settitle(ed, "Edit " + curfile); cmd(ed, "update"); #cmd(ed, "bind .b.t <Key> +{send c dirtied}"); } } BLOCK, TEMP : con iota; is_limbo := 0; # initially not limbo this_word := ""; last_keyword := ""; in_comment := 0; first_char := 1; indent : list of int; last_kw_is_block := 0; tab := "\t"; tabs := array[] of { "", "\t", "\t\t", "\t\t\t", "\t\t\t\t", "\t\t\t\t\t", "\t\t\t\t\t\t", "\t\t\t\t\t\t\t", "\t\t\t\t\t\t\t\t" }; keywords := array[] of { "adt", "alt", "array", "big", "break", "byte", "case", "chan", "con", "continue", "cyclic", "do", "else", "exit", "fn", "for", "hd", "if", "implement", "import", "include", "int", "len", "list", "load", "module", "nil", "of", "or", "pick", "real", "ref", "return", "self", "spawn", "string", "tagof", "tl", "to", "type", "while" }; block_keyword := (big 1 << 40 ) | big (1 << 17) | big (1 << 15) | big (1 << 12) | big (1 << 11); do_limbo() { is_limbo = !is_limbo; if ( is_limbo ) mark_keyw_comm(); else { cmd(ed, ".b.t tag remove comment 1.0 end"); cmd(ed, ".b.t tag remove keyword 1.0 end"); } } do_limbo_check(s : string) { if ( ! is_limbo ) return; if ( len s < 11 ) return; # # Maybe we should actually remember where the insert point is. # In general we can get it via .b.t index insert, but for most # characters, we could maintain the position with simple arithmetic. # # Also, we need to insert code in cut and paste operations to keep # track of various things when in limbo mode. Also need to catch # text deletions via typeover of selection. # char := s[9]; if ( char == '\\' && len s > 10 ) char = s[10]; case char { ' ' or '\t' => if ( ! in_comment ) look_keyword(this_word); this_word = "" ; '\n' => if ( in_comment ) { # terminate current tag cmd(ed, ".b.t tag remove comment insert-1chars"); in_comment = 0; } else look_keyword(this_word); this_word = "" ; if ( last_kw_is_block ) indent = TEMP :: indent; else while ( indent != nil && hd indent == TEMP ) indent = tl indent; last_kw_is_block = 0; add_indent(); first_char = 1; return; '{' => indent = BLOCK :: indent; last_kw_is_block = 0; '}' => if ( indent != nil ) indent = tl indent; last_kw_is_block = 0; # If the line is just indentation plus '}', rewrite it # to have one less indent. if ( first_char ) { current := int cmd(ed, ".b.t index insert"); cmd(ed, ".b.t delete " + string current + ".0 insert"); add_indent(); cmd(ed, ".b.t insert insert '}"); } # ';' => # last_kw_is_block = 0; # '\b' => # By the time we see this, the character has # # already been wiped out, probably. # # To know what it was we'd need a lastchar, # # reset for each mouse button up and \b # '\u007f' => # Here, we have to know what used to be ahead of the # # insert point. '#' => # if ( ! in_quote ) { # cmd(ed, ".b.t tag add comment insert-1chars"); in_comment = 1; # } 'A' to 'Z' or 'a' to 'z' or '0' to '9' or '_' => if ( ! in_comment ) this_word[len this_word] = char; * => if ( ! in_comment ) look_keyword(this_word); this_word = ""; } if ( in_comment ) cmd(ed, ".b.t tag add comment insert-1chars"); first_char = 0; } look_keyword(word : string) { # compare this_word to all keywords if ( is_keyword(word) ) { cmd(ed, ".b.t tag add keyword insert-" + string (len this_word + 1) + "chars insert-1chars"); } } is_keyword(word : string) : int { l := len keywords; for ( i := 0; i < l; i++ ) if ( word == keywords[i] ) { if ( i != 26 ) # don't set for 'nil' last_kw_is_block = int (block_keyword >> i) & 1; return 1; } return 0; } do_new() { cmd(ed, ".b.t delete 1.0 end"); curfile = "(New)"; tkclient->settitle(ed, "Edit " + curfile); } do_open(): int { for(;;) { fname := selectfile->filename(context, ed.image, "", nil, path); if(fname == "") break; cmd(ed, ".b.t delete 1.0 end"); e := loadtfile(fname); if(e == nil) { basepath(fname); return 1; } options := list of { "Cancel", "Open another file" }; if(dialog->prompt(context, ed.image, ErrIco, "Open file", e, 0, options) == 0) break; } return 0; } basepath(file: string) { for(i := len file-1; i >= 0; i--) if(file[i] == '/') { path = file[0:i]; break; } } do_save(prompt: int) { fname := curfile; contents := tk->cmd(ed, ".b.t get 1.0 end"); for(;;) { if(prompt || curfile == "(New)") { fname = dialog->getstring(context, ed.image, "File"); if ( len fname > 0 && fname[0] != '/' && path != "" ) fname = path + "/" + fname; } if(savetfile(fname, contents)) { set_clean(); break; } options := list of { "Cancel", "Try another file" }; msg := sys->sprint("Trying to write file \"%s\"\n%r", fname); if(dialog->prompt(context, ed.image, ErrIco, "Save file", msg, 0, options) == 0) break; prompt = 1; } } do_snarf(del: int) { range := cmd(ed, ".b.t tag nextrange sel 1.0"); if(range == "" || (len range > 0 && range[0] == '!')) return; snarf = tk->cmd(ed, ".b.t get " + range); if(del) cmd(ed, ".b.t delete " + range); tkclient->snarfput(snarf); } do_paste() { snarf = tkclient->snarfget(); if(snarf == "") return; cmd(ed, ".b.t insert insert '" + snarf); } do_search(prompt: int) : int { if(prompt == SEARCHFOR) searchfor = dialog->getstring(context, ed.image, "Search For"); if(searchfor == "") return 0; cmd(ed, "cursor -bitmap cursor.wait"); ix := cmd(ed, ".b.t search -- " + tk->quote(searchfor) + " insert+1c"); if(ix != "" && len ix > 1 && ix[0] != '!') { cmd(ed, ".b.t tag remove sel 0.0 end"); cmd(ed, ".b.t mark set anchor " + ix); cmd(ed, ".b.t mark set insert " + ix); cmd(ed, ".b.t tag add sel " + ix + " " + ix + "+" + string(len searchfor) + "c"); if ( prompt != NOSEE ) cmd(ed, ".b.t see " + ix); cmd(ed, "cursor -default"); return 1; } cmd(ed, "cursor -default"); return 0; } do_replace(prompt : int) { range := ""; if ( prompt == REPLACEWITH ) { replacewith = dialog->getstring(context, ed.image, "Replacement String"); range = cmd(ed, ".b.t tag nextrange sel 1.0"); if(range == "" || (len range > 0 && range[0] == '!')) return; # nothing currently selected } if ( range != "" ) { # there's something selected cmd(ed, ".b.t mark set insert sel.first"); } else { # have to find a string if ( searchfor == "" ) { # no search string! if ( do_search(SEARCHFOR) == 0 ) return; } else if ( do_search(SEARCH) == 0 ) return; } cmd(ed, ".b.t delete sel.first sel.last"); cmd(ed, ".b.t insert insert " + tk->quote(replacewith)); } do_replaceall() { cur := cmd(ed, ".b.t index insert"); if ( cur == "" || cur[0] == '!' ) return; dirt := 0; if ( searchfor == "" ) # no search string searchfor = dialog->getstring(context, ed.image, "Search For"); if ( searchfor == "" ) # still no search string return; srch := tk->quote(searchfor); repl := tk->quote(replacewith); for ( ix := "1.0"; len ix > 0 && ix[0] != '!'; ) { ix = cmd(ed, ".b.t search -- " + srch + " " + ix + " end"); if ( ix == "" || len ix <= 1 || ix[0] == '!') break; cmd(ed, ".b.t delete " + ix + " " + ix + "+" + string(len searchfor) + "c"); if ( replacewith != "" ) { cmd(ed, ".b.t insert " + ix + " " + repl); ix = cmd(ed, ".b.t index " + ix + "+" + string(len replacewith) + "c"); } dirt++; } cmd(ed, ".b.t mark set insert " + cur); if ( dirt > 0 ) set_dirty(); } loadtfile(path: string): string { if ( path != nil && path[0] == '/' ) basepath(path); fd := sys->open(path, sys->OREAD); if(fd == nil) return "Can't open "+path+", the error was:\n"+sys->sprint("%r"); (ok, d) := sys->fstat(fd); if(ok < 0) return "Can't stat "+path+", the error was:\n"+sys->sprint("%r"); if(d.mode & Sys->DMDIR) return path+" is a directory"; cmd(ed, "cursor -bitmap cursor.wait"); BLEN: con 8192; buf := array[BLEN+Sys->UTFmax] of byte; inset := 0; for(;;) { n := sys->read(fd, buf[inset:], BLEN); if(n <= 0) break; n += inset; nutf := sys->utfbytes(buf, n); s := string buf[0:nutf]; # move any partial rune to beginning of buffer inset = n-nutf; buf[0:] = buf[nutf:n]; cmd(ed, ".b.t insert end '" + s); } if ( is_limbo ) mark_keyw_comm(); curfile = path; tkclient->settitle(ed, "Edit " + curfile); cmd(ed, "cursor -default"); cmd(ed, "update"); return ""; } savetfile(path: string, contents: string): int { buf := array of byte contents; n := len buf; fd := sys->create(path, sys->OWRITE, 8r664); if(fd == nil) return 0; i := sys->write(fd, buf, n); if(i != n) { sys->print("savetfile only wrote %d of %d: %r\n", i, n); return 0; } curfile = path; # cmd(ed, ".m.filename configure -text '" + curfile); tkclient->settitle(ed, "Edit " + curfile); return 1; } mark_keyw_comm() { quote := 0; start : int; notkey := 0; word : string; last := int cmd(ed, ".b.t index end"); for ( i := 1; i <= last; i++ ) { quote = 0; word = ""; line := tk->cmd(ed, ".b.t get " + string i + ".0 " + string (i+1) + ".0"); l := len line; ll : for ( j := 0; j < l; j++ ) { c := line[j]; if ( quote && (c = line[j]) != quote ) continue; case c { '#' => cmd(ed, sys->sprint(".b.t tag add comment" + " %d.%d %d.%d", i, j, i, l)); break ll; '\'' or '\"' => if ( j != 0 && line[j-1] == '\\' ) break; if ( c == quote ) quote = 0; else quote = line[j]; word = ""; 'a' to 'z' => if ( word == "" ) start = j; word[len word] = c; 'A' to 'Z' or '_' => notkey = 1; continue; * => if ( ! notkey && is_keyword(word) ) cmd(ed, ".b.t tag add keyword " + sys->sprint("%d.%d %d.%d", i, start, i, j)); word = ""; notkey = 0; } } } } do_indent() { for ( ; ; ) { tab = dialog->getstring(context, ed.image, "single indent"); break; } for ( i := 1; i <= 8; i++ ) { s := ""; for ( j := i; j > 0; j-- ) s += tab; tabs[i] = collapse(s); } } collapse(s : string) : string { if ( len s >= 8 && s[0:8] == " " ) return "\t" + collapse(s[8:]); return s; } add_indent() { for ( i := len indent; i >= 8; i -= 8 ) cmd(ed, ".b.t insert insert '" + tabs[8]); cmd(ed, ".b.t insert insert '" + tabs[i]); } # # We should also look at the previous line, maybe. # And the line after. That may be too much. # # This is also the logical place to check if we are in a keyword, # reinitialize this_word (which presents problems if we are in the # middle of a word, etc.) Also check if we are in a comment or not. # re_indent() { pos := cmd(ed, ".b.t index insert"); (n, lc) := sys->tokenize(pos, "."); if ( n < 2 ) return; init := tk->cmd(ed, ".b.t get " + hd lc + ".0 insert"); l := len init; for ( i := 8; i > 0; i-- ) { lt := len tabs[i]; if ( l >= lt && init[:lt] == tabs[i] ) break; } for ( indent = nil; len indent < i; indent = 0 :: indent) ; in_comment = 0; # Are we in a comment? for ( i = len tabs[i]; i < l; i++ ) if ( init[i] == '#' ) { in_comment = 1; break; } } cmd(win: ref Tk->Toplevel, s: string): string { # sys->print("%s\n", s); r := tk->cmd(win, s); if (r != nil && r[0] == '!') { sys->print("wm/edit: error executing '%s': %s\n", s, r); } return r; }