code: 9ferno

ref: 6d69f6fba35087686f79adb2ea0d67944a62ca7b
dir: /appl/wm/edit.b/

View raw version
#
# 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;
}