#!/bin/sh
# the next line restarts using wish \
exec wish /usr/local/bin/B -- $*

#  (c) 2011, written by Gerard J. Holzmann to emulate a subset of the
#  capabilities of the sam screen editor, implemented in Tcl/Tk.
#  For general usage information, see the Help item in the File menu.
#  bug reports: gholzmann@acm.org
#  First released Feb. 21, 2017.
# 
#  This program is free software: you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation, either version 3 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program.  If not, see <http://www.gnu.org/licenses/>.

set Version "B 0.1 -- August 26, 2011"

set iscmd     ivory		;# background for command window
set isactive  ivory		;# background for active window
set notactive white		;# background for all other windows, if visible
set fg_text   black		;# text foreground in all windows
set mbg       lightblue
set mfg       darkblue
set mtx       gold		;# text foreground in menus

set search_lno 1.0	;# default startpoint of search
set lastpat ""		;# searched for
set silent 0		;# when executing background commands
set w_nr 0		;# highest window number
set a_nr 0		;# active window
set fnames(0) ""
set present(0) 0	;# 0 if panel was deleted
set origin_x 0
set origin_y 0
set last_i 1
set psize(1) 100		;# relative size of a panel in percent of default
set hidden_panels(0) ""		;# contents of the hidden
set hidden_fnames(0) ""		;# filename of the panel
set hidden_modified(0) 0	;# was the contents modified
set hidden_present(0) 0		;# is the slot in use?
set hidden_w(0) 0       	;# former window number
set hidden_y(0) 0		;# former yview
set hidden_nr 0			;# nr of hidden panels
set clip_start	0.0		;# set by line_command, and save_selection, used by x_command
set nonew 0

frame .menu -bg $mfg
	menubutton .menu.file -text "File.." \
		-relief sunken \
		-bg $mfg -fg $mtx \
		-activebackground $mtx -activeforeground $mfg \
		-relief raised -menu .menu.file.m

	set fe -1
	catch { set fe [open "|date" r] } errmsg
	if {$fe == -1} {
		set vn "-B-"
	} else {
		gets $fe vn
		catch { close $fe }
	}
	
	label .menu.title -text "$vn" -bg $mfg -fg $mbg
	pack append .menu \
		.menu.file {left frame w} \
		.menu.title {left frame c expand}

menu .menu.file.m -bg $mbg -fg $mfg
	.menu.file.m add command -label "New" -command "zap_panel"
	.menu.file.m add command -label "Open.." -command "open_spec"
	.menu.file.m add command -label "Save As.." -command "save_spec 0"
	.menu.file.m add command -label "Save" -command "save_spec 1"
	.menu.file.m add command -label "Close" -command "close_panel"
	.menu.file.m add separator
	.menu.file.m add command -label "Help" -command "print_help"
	.menu.file.m add command -label "Print" -command "send2printer"
	.menu.file.m add command -label "Exit" -command "trytoquit"

frame .cmd
	scrollbar .cmd.s -command ".cmd.t yview"
	text .cmd.t -bd 2 -height 8 -bg $iscmd -fg $fg_text \
		-font "-*-Courier-Bold-R-Normal--*-120-*" \
		-yscrollcommand ".cmd.s set" -wrap word
	pack .cmd.s -side left -fill y
	pack append .cmd .cmd.t {left expand fill}
	bind .cmd.t <ButtonPress-3> { popup_menu %W .cmd.t }
	bind .cmd.t <ButtonPress-1> { save_selection }

frame .inp
	canvas .inp.c -width 600 -height 720
	pack append .inp .inp.c {left fill expand}

	bind .cmd.t <Control-s> {	;# in both windows
		save_spec 1
		addlog "\n"
	}
	bind .cmd.t <Return> {
		# execute the command on this line
		set eol [.cmd.t index insert]
		set x [split $eol .]
		set ln [lindex $x 0]
		set cs [lindex $x 1]
		set command [.cmd.t get $ln.0 $ln.$cs]

		set lnc [expr $ln + 1]
		set enc [.cmd.t index end]
		set y [split $enc .]
		if {$lnc != [lindex $y 0]} {
			if {[lindex $y 1] != 0} {
				addlog "\n"
			} else {
			#	addlog "<<$enc [lindex $y 1]>>"
			}
			addlog "$command"	;# put it at the end
			.cmd.t mark set insert end
		}

		if {[string length $command] > 0} {
			set cmd [string range $command 0 0]
			switch -regexp $cmd {
			c	{ change_dir $command }
			e	{ do_open [string range $command 1 end] }
			B	{ sel_window [string range $command 1 end]; hide_all_other }
			D	{ del_window [string range $command 1 end] }
			f	{ change_filename [string range $command 1 end] }
			L	{ set psize($a_nr) [expr $psize($a_nr) * 2 ]; do_resize }
			S	{ set psize($a_nr) [expr $psize($a_nr) / 2 ]; do_resize }
			H	{ hide_window [string range $command 1 end] }
			U	{ unhide_window [string range $command 1 end] }
			X	{ hide_all_other }
			q	{ trytoquit }
			s	{ sed_command "|" $command }
			x	{ x_command   ":" $command }
			u	{ .inp.c.t$a_nr edit undo }
			w	{ do_save [string range $command 1 end] }
			[1-9]	{ line_command $command }
			\\#	{ }
			!	{ shell_command 0 [string range $command 1 end] }
			"<"	{ shell_command 1 [string range $command 1 end] }
			","	{ utransform [string range $command 1 end] }
			/	{ findmatch 1 "[string range $command 1 end]" }
			\\?	{ findmatch 0 "[string range $command 1 end]" }
			\\|	{ stransform "|" [string range $command 1 end] }
			\\=	{ whatislastline [string range $command 1 end] }
			\\$	{ whatislastline [string range $command 1 end] }
			\\.	{ whatiscurrentline [string range $command 1 end] }
			default	{ addlog "\n? $command" }
	}	}	}

pack append . \
	.menu {top fillx} \
	.cmd  {top frame w fillx} \
	.inp  {top frame w expand fill}

	bind .inp.c <Configure> { do_resize }

proc popup_menu {w f} {
	global a_nr w_nr present fnames
	global hidden_present hidden_fnames hidden_nr hidden_modified

	set m .edit
	catch { destroy $m }

	menu .edit -tearoff 0
		.edit add command -label "cut" \
			-command "tk_textCopy $f; tk_textCut $f"
		.edit add command -label "paste" -command "tk_textPaste $f"
		.edit add command -label "copy" -command "tk_textCopy $f"
		.edit add separator
		.edit add command -label "refresh" -command "hot_link .inp.c.t$a_nr"
		.edit add separator

		for {set i 1} {$i <= $w_nr} {incr i} {
			if {$present($i)} {
				if [.inp.c.t$i edit modified] {
					set tn "'+"
				} else {
					set tn " +"
				}
				if {$i == $a_nr} {
					set tn "$tn."
				} else {
					set tn "$tn "
				}
				.edit add command -label "$tn $fnames($i)" \
					-command "sel_window $fnames($i)"
		}	}
		for {set i 0} {$i < $hidden_nr} {incr i} {
			if {$hidden_present($i)} {
				if {$hidden_modified($i)} {
					set tn "'+"
				} else {
					set tn " +"
				}
				.edit add command -label "$tn $hidden_fnames($i)" \
					-command "unhide_window $hidden_fnames($i)"
		}	}
	set xy [winfo pointerxy $w]
	set x [lindex $xy 0]
	set y [lindex $xy 1]
	# lassign [winfo pointerxy $w] x y
	tk_popup $m $x $y
}

proc zap_panel {} {
	global fnames a_nr
	catch {
		.inp.c.t$a_nr delete 0.0 end
		set fnames($a_nr) ""
	}
}

proc close_panel {} {
	global fnames a_nr
	catch { del_window $fnames($a_nr) }
}

proc print_help {} {

	catch { destroy .help }
	toplevel .help
	text .help.t
	pack append .help .help.t { top expand fill }
	set t .help.t
	$t insert end  "General:

Use the File.. menu to browse/open/close files, or to print.

In text panels:

Button-1        selects window
Button-1        click on a filename.c:linenr to open that file
DoubleButton-1  click on {,\[, or \" finds closing },\], or \"
Button-2        scroll/paste (windows)
Button-3        cut/snarf/paste/file menu
Control-s       saves the file
Control-c       copy selection
Control-x       cut the selection
Control-v       paste
Control-w       erase last word

Commands (typed in command window on top):

cd \[dirname]    change directory
e \[file]        read in file
B \[file]        switch to window on file (or create one)
D \[file]        close the window on file, or the current window if no name is given
f \[file]        change filename, or list open files
H \[file]        hide window on file
U \[file]        unhide window on file
X               hide all windows except the current one
L               make window larger  relative to other windows
S               make window smaller relative to other windows
q               quit
u               undo
w \[file]        write file
123             move to linenr 123
123,456         select lines 123 through 456
123,456x/.../\[aci]/.../  apply x command to lines 123 thru 456
123,456|command apply unix background command to lines 123 thru 456
!command        execute command in a background shell,
		e.g., !pwd
<command        read output from background command into current window
		e.g., < cal 2010
/pattern        find next match for pattern
?pattern        find previous match for pattern
=               print size of file in lines and move to last line
$=              print size of file in lines, but don't move
$               print size and move to last line
.=              print current line number

Shorthands:
s/x/y/g         sed command applied to selection
,s/x/y/g        sed command applied to whole file
x/src/\[aci]/tgt/ x command applied to selection
,x/../\[aci]/.../ x command applied to file
,command        pipe all lines through unix background command,
		e.g.,  ,awk ' { print ++ln, \$0 }'
|command        pipe only selection through background command,
		e.g.,  |tr 'A-Z' 'a-z'
"
}

proc send2printer {} {
	global fnames a_nr silent tcl_platform

	set CMD ""
	if [info exists tcl_platform] {
		## addlog "\n$tcl_platform(platform)"
		if {[string match windows $tcl_platform(platform)]} {
			addlog "\n$tcl_platform(os)"
			if {$tcl_platform(os) == "Windows 95"} {
				set CMD  "command.com"
			} else {
				set CMD  "cmd.exe"
	}	}	}

	if {$CMD == ""} {
		addlog "\nprint: unsupported OS"
		return
	}

	set f "c:/cygwin/tmp/$fnames($a_nr)"

	set silent 1
	if [writeoutfile $f] {
		exec $CMD /c start /min notepad /p $f
		catch {eval exec "rm -f $f"}
		addlog "\nfile sent to printer"
	}
	set silent 0
}

proc dopaste {} {
	global a_nr
	set from [.inp.c.t$a_nr index insert]
	tk_textPaste .inp.c.t$a_nr
	set upto [.inp.c.t$a_nr index insert]
	.inp.c.t$a_nr tag add sel $from $upto
}

proc do_resize {} {
	global w_nr

	set w 0; set h 0
	set ws [wm geometry .]
	catch {
		scan $ws "%dx%d+%d+%d" w h xo yo
		if {$w_nr > 0} {
			incr w -18
			incr h -160	;# approx pixel size of cmd window
			w_resize $w $h
	}	}
}

proc change_dir {d} {

	if {[string range $d 0 1] != "cd" \
	||  ([string length $d] != 2 \
	&&   [string range $d 2 2] != " ")} {
		addlog "\n? $d"
		return
	}
	catch { eval $d } err
	if {$err != ""} { addlog "\n$err" }
	addlog "\n[pwd]"
}

proc sed_command {s c} {
	# styles recognized: s/x/y/ and s;x;y;
	if {[string range $c 1 1] != "/" \
	&&  [string range $c 1 1] != ";"} {
		addlog "\n? $c"
		return
	}
	switch -regexp $s {
	","	{ utransform "sed \"$c\"" }
	\\|	{ stransform "|" "sed \"$c\"" }
	default { addlog "\n? $s $c" }
	}
}

proc shell_command {w c} {
	global a_nr

	if {$c == "sh"} {
		set out "sorry: no interactive shell"
	} else {
		catch { eval exec "$c" 2> tmp_err } out
		catch { eval exec "rm -f tmp_err }
		
	}
	if {$out != ""} {
		if {$w} {
			.inp.c.t$a_nr insert end "\n$out"
			hot_link .inp.c.t$a_nr
		} else {
			addlog "\n$out"
			hot_link .cmd.t
	}	}
}

proc size_canvas {w h} {
	.inp.c configure -width  [expr $w - 18 ]
	.inp.c configure -height [expr $h - 160 ]
}

proc w_resize {w ah} {
	global w_nr present psize

	set cnt 0
	set tsize 0
	for {set i 1} {$i <= $w_nr} {incr i} {
		if {$present($i)} {
			incr cnt
			incr tsize $psize($i)
	}	}
	set absent [expr $w_nr - $cnt]

	set y 0		;# where the first window starts
	set cnt 0
	for {set i 1} {$i <= $w_nr} {incr i} {
		if {$present($i)} {
			set h [expr ( $psize($i) * $ah )/ $tsize ]		;# relative height
			.inp.c itemconfigure s$i -height $h		;# scrollbar
			.inp.c itemconfigure t$i -width $w -height $h	;# text
			.inp.c coords s$i  0 $y
			.inp.c coords t$i 18 $y
			incr y $h
		} else {
			incr cnt
	}	}
	update
}

proc save_selection {} {
	global a_nr clip_start
	catch {
		set cont [.inp.c.t$a_nr get sel.first sel.last]
		# aborts if there's no selection, so we wont clear clipboard
		clipboard clear
		clipboard append $cont
		set clip_start sel.first
	}
}

proc move_focus {a} {
	global fnames

	focus .inp.c.t$a
	catch { .inp.c.t$a tag remove hilite 0.0 end }
	save_selection
	sel_window $fnames($a)
}

proc erase_word {} {
	global a_nr

	set t .inp.c.t$a_nr
	set mark [$t index insert]
	scan $mark "%d.%d" ln och
	set ch $och
	if {$ch > 0} {
 		set w [$t get $ln.[expr $ch - 1] $ln.$ch]
 		while {$ch > 0 && ($w == " " || $w == "\t")} {
 			incr ch -1; set w [$t get $ln.[expr $ch - 1] $ln.$ch]
 		}
 		if {$ch > 0} {
 			set w [$t get $ln.[expr $ch - 1] $ln.$ch]
 			while {$ch > 0 && $w != " " && $w != "\t"} {
 				incr ch -1; set w [$t get $ln.[expr $ch - 1] $ln.$ch]
 			}
 			if {$ch < $och} {
 				$t delete $ln.$ch $mark
 	}	}	}
}

proc pos_comp {a b} {

	if {[scan $a "%d.%d" ln1 cn1] != 2 || [scan $b "%d.%d" ln2 cn2] != 2} {
		return -1		;# not comparable
	}

	if {$ln1 < $ln2 || ($ln1 == $ln2 && $cn1 < $cn2)} {
		return 0		;# a < b
	} else {
		return 1		;# a >= b
	}
 }

proc find_close {s x e} { 	;# find matching e for s, starting at position x
	global a_nr

	set cnt 1
	set t .inp.c.t$a_nr
	set ub 0
	while {$ub < 1000} {	;# upperbound
		incr ub
		set em [$t search $e $x]
		if {$em == ""} { break  }
		set sm [$t search $s $x]
		set pc [pos_comp $sm $em]
		if {$sm == "" || $pc != 0 || [pos_comp $sm $x] == 0} {
 			incr cnt -1
 			if {$cnt == 0} {
 				return $em
 			}
 			set x $em+1chars
 		} else {	;#  sm < em
 			incr cnt
 			set x $sm+1chars
	}	}
	return 1.0		;# no match
}

proc set_selection {} {
	global a_nr
	set w .inp.c.t$a_nr

 	set mark [$w index insert-1chars]
	set s [$w get $mark]

	switch $s \
	\{	{ set e \} }\
	\"	{ set e \" }\
	\[	{ set e \] }\
	\(	{ set e \) }\
	\<	{ set e \> }\
	default { return }

	set target [find_close $s [$w index insert] $e ]
	if {[pos_comp $mark $target] == 0} {	;# target > mark
		$w tag remove hilite 0.0 end
		$w tag add hilite $mark+1chars $target
	}
}

proc new_window {f} {
	global a_nr w_nr origin_x origin_y present fnames psize mfg mbg mfg nonew mtx

	incr w_nr
	set s_width 18	;# approx width of scrollbar
	set psize($w_nr) 100		;# default size

	scan [wm geometry .] "%dx%d+%d+%d" w h xo yo

	incr w -$s_width
	incr h -160	;# approx pixel size of cmd window

	scrollbar .inp.c.s$w_nr -command ".inp.c.t$w_nr yview"

	text .inp.c.t$w_nr -bd 1 -width $w -undo true \
		-font "-*-Courier-Bold-R-Normal--*-120-*" \
		-exportselection true -wrap word \
		-yscrollcommand ".inp.c.s$w_nr set"

##		-inactiveselectbackground $mfg

	.inp.c.t$w_nr tag configure hilite -background blue -foreground white

	bind .inp.c.t$w_nr <Control-s> { save_spec 1; addlog "\n" }

	bind .inp.c.t$w_nr <ButtonPress-1> "move_focus $w_nr"
	bind .inp.c.t$w_nr <ButtonRelease-2> { }	;# fails to remove default binding
	bind .inp.c.t$w_nr <ButtonPress-3> { popup_menu %W .inp.c.t$w_nr }

	bind .inp.c.t$w_nr <Double-1>	{ set_selection }

	bind .inp.c.t$w_nr <Control-x> { tk_textCopy .inp.c.t$w_nr; tk_textCut .inp.c.t$w_nr }
	bind .inp.c.t$w_nr <Control-c> { tk_textCopy .inp.c.t$w_nr }
	bind .inp.c.t$w_nr <Control-v> { dopaste }
	bind .inp.c.t$w_nr <Control-w> { erase_word }

	.inp.c create window \
		$origin_x $origin_y \
		-height $h \
		-window .inp.c.s$w_nr \
		-anchor nw -tags s$w_nr

	incr origin_x $s_width	;# add width of scrollbar
	.inp.c create window \
		$origin_x $origin_y \
		-height $h \
		-width $w \
		-window .inp.c.t$w_nr \
		-anchor nw -tags t$w_nr \
		-state normal

	set origin_x [expr $origin_x + [expr $w / 3] ]
	incr origin_y 20

	set present($w_nr) 1
	w_resize $w $h	;# resize the old windows to accomodate the new one
	set_active $w_nr

	set f [string trimleft $f " "]

	if {$f != ""} { readinfile $f } else { set fnames($w_nr) "" }

	if {$nonew == 0} {
# addlog " <nw $w_nr>\n"
		button .menu.f$w_nr -textvariable fnames($w_nr) \
			-bg $mfg -fg $mtx \
			-activebackground $mtx -activeforeground $mfg \
			-command "open_window $w_nr"
		pack append .menu .menu.f$w_nr {right}
	}
}

proc set_active {x} {
	global a_nr w_nr present notactive isactive fg_text

	for {set i 1} {$i <= $w_nr} {incr i} {
		if {$present($i)} {
			.inp.c.t$i configure -bg $notactive -fg $fg_text ; # gray75
	}	}

	if {$present($x)} {
		set a_nr $x
		.inp.c.t$a_nr configure -bg $isactive -fg $fg_text
	}
}

proc drop_frame {j} {
	global present

  	if [.inp.c.t$j edit modified] {
  		set answer [tk_messageBox -type yesno -icon question \
  			-message "file was modified, really close?"]
  		if {$answer == "no"} { return }
  	}
  
  	.inp.c delete window .inp.c.s$j
  	.inp.c delete window .inp.c.t$j
  	destroy .inp.c.s$j
  	destroy .inp.c.t$j
	destroy .menu.f$j

  	set present($j) 0
  	do_resize
}

proc del_window {x} {
	global a_nr w_nr fnames last_i present

	set x [string trimleft $x " "]
	if {$x == ""} {	;# delete current frame
		drop_frame $a_nr
		return
	}
	set j $last_i
	for {set i 1} {$i <= $w_nr} {incr i} {
		if {$j > $w_nr} {
			set j 1
		}
		if {$present($j)} {
			if {$x == $fnames($j)} {
				drop_frame $j
  				set last_i [expr $j + 1 ]
				return
		}	}
		incr j
	}
	addlog "\n? $x"
}

proc hide_all_other {} {
	global a_nr w_nr fnames present

	for {set i 1} {$i <= $w_nr} {incr i} {
		if {$present($i) && $i != $a_nr} {
			hide_window $fnames($i)
	}	}
}

proc hide_window {x} {
	global a_nr w_nr fnames last_i present
	global hidden_panels
	global hidden_fnames
	global hidden_modified
	global hidden_present
	global hidden_nr
	global hidden_w
	global hidden_y

	set x [string trimleft $x " "]
	set j $last_i
	for {set i 1} {$i <= $w_nr} {incr i} {
		if {$j > $w_nr} { set j 1 }
		if {$present($j) && $x == $fnames($j)} {
			set hidden_panels($hidden_nr) [string trimright [.inp.c.t$j get 1.0 end]]
			set hidden_fnames($hidden_nr) $x
			set hidden_modified($hidden_nr) [.inp.c.t$j edit modified]
			set hidden_present($hidden_nr) 1
			set hidden_w($hidden_nr) $j
			set hidden_y($hidden_nr) [.inp.c.t$j yview]
			incr hidden_nr

			.inp.c delete window .inp.c.s$j
			.inp.c delete window .inp.c.t$j
			destroy .inp.c.s$j
			destroy .inp.c.t$j

			set present($j) 0
			do_resize

			set last_i [expr $j + 1 ]
			return
		}
		incr j
	}
	addlog "\n? $x"
}

proc unhide_window {x} {
	global a_nr w_nr fnames last_i present mbg mfg mtx
	global hidden_panels
	global hidden_fnames
	global hidden_modified
	global hidden_present
	global hidden_nr
	global hidden_w
	global hidden_y
	global nonew

	set x [string trimleft $x " "]
	for {set i 0} {$i < $hidden_nr} {incr i} {
		if {$hidden_present($i) && $x == $hidden_fnames($i)} {
			set nonew 1
			new_window ""
			set nonew 0
			.inp.c.t$a_nr insert end $hidden_panels($i)
			.inp.c.t$a_nr edit modified $hidden_modified($i)
			.inp.c.t$a_nr yview moveto [lindex $hidden_y($i) 0]
			set fnames($a_nr) $hidden_fnames($i)
			set hidden_present($i) 0
# addlog " <uw $x $a_nr> \n"
			destroy .menu.f$hidden_w($i)
			button .menu.f$a_nr -textvariable fnames($a_nr) \
				-bg $mfg -fg $mtx \
				-activebackground $mtx -activeforeground $mfg \
				-command "open_window $a_nr"
			pack append .menu .menu.f$a_nr {right}
			return
	}	}

	addlog "\n? $x"
}

proc open_window {w} {
	global fnames present hidden_present
# addlog " <ow w: $w> \n"

	if {$present($w)} {
		set_active $w
	} else {
		unhide_window $fnames($w)
	}
	hide_all_other
}

proc sel_window {x} {
	global a_nr w_nr fnames last_i present
	global hidden_present hidden_fnames hidden_nr

	set x [string trimleft $x " "]
	set j $last_i

	for {set i 1} {$i <= $w_nr} {incr i} {
		if {$j > $w_nr} { set j 1 }
		if {$present($j)} {
			if {$x == $fnames($j)} {
				set_active $j
				set last_i [expr $j + 1 ]
				return
		}	}
		incr j
	}
	for {set i 0} {$i < $hidden_nr} {incr i} {
		if {$hidden_present($i)} {
			if {$x == $hidden_fnames($i)} {
				unhide_window $hidden_fnames($i)
				return
	}	}	}

	new_window $x
}

proc addlog {s} {
	.cmd.t insert end "$s"
	.cmd.t yview -pickplace end
}

proc change_filename {f} {
	global a_nr w_nr fnames present psize
	global hidden_nr hidden_fnames hidden_present hidden_modified

	set ws [string range $f 0 0]
	if {$ws == " " || $ws == "\t"} {
		set f [string trimleft $f " \t"]
		set fnames($a_nr) $f
	} else {
		for {set i 1} {$i <= $w_nr} {incr i} {
			if {$present($i)} {
				if [.inp.c.t$i edit modified] {
					addlog "\n'+"
				} else {
					addlog "\n +"
				}
				if {$i == $a_nr} {
					addlog ". "
				} else {
					addlog "  "
				}
				addlog "$fnames($i)"
		}	}
		for {set i 0} {$i < $hidden_nr} {incr i} {
			if {$hidden_present($i)} {
				if {$hidden_modified($i)} {
					addlog "\n'"
				} else {
					addlog "\n "
				}
				addlog "+  $hidden_fnames($i)"
	}	}	}
}

proc do_save {f} {
	global a_nr fnames

	set orig $fnames($a_nr)
	set name_change 0

	set ws [string range $f 0 0]
	if {$ws == " " || $ws == "\t"} {
		change_filename $f
		set name_change 1
	} else {
		if {[string length $f] > 0} {
			addlog "\n? w$f"
			return
	}	}

	save_spec 1

	if {$name_change == 1} {
		set fnames($a_nr) $orig			;# restore original
	}
}

proc stransform {s c} {	;# applied just to the selection
	global a_nr clip_start

	# s is "|" for selection or ":" for clipboard

	catch {
		set fd [open "tmp_in" w]
		fconfigure $fd -translation lf
		if {$s == ":"} {
			if {[catch { clipboard get } what]} {
				addlog "\nno selection"
				return
			}
			puts -nonewline $fd $what
		} else {
			puts -nonewline $fd [.inp.c.t$a_nr get sel.first sel.last]
		}
		close $fd

		eval exec $c <tmp_in >tmp_out 2>tmp_err
		set fd [open "tmp_out" r]
		set n ""
		while {[gets $fd line] > -1} {
			set n "$n $line"
			if {[eof $fd] == 0} {
				set n "$n\n"
		}	}
		close $fd
		if {$s == ":"} {
			set a [string length $what]
			set y [.inp.c.t$a_nr index $clip_start]
			set z [.inp.c.t$a_nr index "$clip_start+$a any chars"]
			.inp.c.t$a_nr replace $y $z "$n"
		} else {
			set x [.inp.c.t$a_nr index sel.first]
			.inp.c.t$a_nr delete sel.first sel.last
			.inp.c.t$a_nr insert $x "$n"
		}
	} err

	if {$err != ""} {
		addlog "\n$err"
	}
	catch {exec rm -f tmp_in tmp_out tmp_err}
	return 0
}

proc x_command {s c} {
	global a_nr clip_start

	# s is ":" or ","
	# for selection, clipboard, or whole file
	# c is one of:
	#	x/pattern/c/string/
	#	x/pattern/a/string/
	#	x/pattern/i/string/
	#	not x/pattern/d but that's the same as x/pattern/c//
	# where both pattern and string can contain \n and \t symbols

	set a [split $c "/"]	;# x/apple/c/pear/  returns a list of 5 entries
	if {[llength $a] != 5} {
		addlog "\n? $c"
		return
	}
	set pattern [lindex $a 1]

	switch [lindex $a 2] {
	c	{ set mode 0 }
	a	{ set mode 1 }
	i	{ set mode 2 }
	default	{ addlog "\n? bad operator [lindex $a 2]"; return }
	}

	set new [lindex $a 3]
	set x [string first "\\n" $new]
	while {$x >= 0} {
		set new [string replace $new $x [expr $x + 1] "\n"]
		set x [string first "\\n" $new]
	}
	set x [string first "\\t" $new]
	while {$x >= 0} {
		set new [string replace $new $x [expr $x + 1] "\t"]
		set x [string first "\\t" $new]
	}
	# needed, for instance when we're inserting something in front of $
	# to maintain correct tracking
	set x [string first "$" $pattern]
	if {$x >= 0} {
		set y [string first "\\" $pattern]
		if {$y == -1 || $y != [expr $x - 1]} {
			set pattern [string replace $pattern $x [expr $x + 1] "\n"]
	}	}

	set t .inp.c.t$a_nr
	set cnt 0

	if {$s != ","} {
		if {[catch { clipboard get } what]} {
			addlog "\nnothing selected"
			return
	}	}

	set b 1
	set ub 0
	while {$ub < 10} {		;# upperbound
		incr ub
		set fn "0 0"
		set matched ""

		if {$s == ","} {
			set b [regexp -line -start $b -indices -- "$pattern" [$t get 1.0 end] fn matched]
			if {$b == 0} { break }
		} else {
			# back to front, to preserve validity of clip_start offsets
			# return last match in fn/matched
			set nr [regexp -line -all -start 1 -indices -- "$pattern" $what fn matched]
			if {$nr == 0} {	;# no more matches
				addlog "\n$cnt matches of $pattern"
				break
			}
			if {[scan "$fn" "%d %d" a b] != 2} {
				addlog "\n?fn: $fn\n"
				return
			}
			if {$a > $b} {		;# when matching ^ for instance
				set a [expr $b - 1]
			} else {
				incr a -1
			}
			set what [string range $what 0 $a]
		}

		incr cnt
		scan "$fn" "%d %d" a b
		incr b
		if {$s == ","} {
			set y [$t index "1.0+$a any chars"]
			set z [$t index "1.0+$b any chars"]
		} else {
			set y [$t index "$clip_start+$a any chars"]
			set z [$t index "$clip_start+$b any chars"]
		}
		switch $mode {
		0 { $t replace $y $z $new }
		1 { $t insert  $z $new; incr b [string length $new] }
		2 { $t insert  $y $new; incr b [string length $new] }
		}
	}
	addlog "\n$cnt matches of $pattern"
}

proc utransform {c} {	;# globally to whole file
	global silent a_nr fnames

	if {[string range $c 0 1] == "s;" \
	||  [string range $c 0 1] == "s/"} {	;# shorthand form
		set c "sed \"$c\""
	} else {
		if {[string range $c 0 1] == "x/"} {
			x_command "," $c
			return
	}	}

	set silent 1
	do_save " tmp_in"

	set x [.inp.c.t$a_nr yview]
	set orig $fnames($a_nr)

# need eval to separate command name from arguments
# user should hide {} and [] and $ symbols in arguments
# e.g. when calling awk, this, for instance, works:
#	,gawk ' \{ print cnt++, \$0 \}'

	catch {eval exec $c <tmp_in >tmp_out 2>tmp_err} errmsg

	if {$errmsg != ""} {
	#	addlog "\n$c"
		addlog "\n$errmsg"
	} else {
		do_open " tmp_out"
		set fnames($a_nr) $orig
	}
	set silent 0
	.inp.c.t$a_nr yview moveto [lindex $x 0]
#	catch {exec rm -f tmp_in tmp_out tmp_err}
}

proc do_open {f} {
	global a_nr fnames

	set ws [string range $f 0 0]
	if {$ws == " " || $ws == "\t"} {
		change_filename $f
	} else {
		if {$f != ""} {
			addlog "\n? e$f"
			return
	}	}
	readinfile $fnames($a_nr)
}

proc open_spec {} {
	set fileselect "tk_getOpenFile"
	set init_dir [pwd]
	switch -- [set file [eval $fileselect -initialdir { $init_dir } ]] "" return
	readinfile $file
}

proc color_code {} {
	global a_nr

	set t .inp.c.t$a_nr
	set in_comment 0

	set line [$t get 1.0 1.end]
	if {[string first "#!/bin/" $line] >= 0} {
		return
	}

	scan [$t index end] %d numLines
	catch { $t tag remove xx 0.0 end }
	for {set i 1} {$i <= $numLines} { incr i} {

		set line [$t get $i.0 $i.end]
		set sos [string first "\"" $line]
		set eos [string last  "\"" $line]
		if {$in_comment == 0} {	;# should not look inside strings
			set fn1 [string first "//" $line]
			set fn2 [string first "/\*" $line]

			if {$fn1 > $sos && $fn1 < $eos} { set fn1 -1 }
			if {$fn2 > $sos && $fn2 < $eos} { set fn2 -1 }

			if {$fn1 >= 0 && ($fn2 < 0 || $fn2 > $fn1)} {
				set fn0 [string first "://" $line]
				if {$fn0 != [expr $fn1- 1]} {
					$t tag add xx $i.$fn1 $i.end
				}
				continue
			}
			if {$fn2 >= 0} {
				set en [string first "\*/" [string range $line $fn2 end] ]
				if {$en >= 0} {		;# was: if {$en > $fn2}
					set upto [expr $en + $fn2 + 2]
					$t tag add xx $i.$fn2 $i.$upto
				} else {
					set in_comment 1
					$t tag add xx $i.$fn2 $i.end
			}	}
		} else {	;# in_comment
			set en [string first "\*/" $line]
			if {$en >= 0} {
				set upto [expr $en + 2]
				$t tag add xx $i.0 $i.$upto
				set in_comment 0
			} else {
				$t tag add xx $i.0 $i.end
	}	}	}

	$t tag configure xx -foreground darkgreen ;# lightgreen
}

set eb 0
proc show_curly { t ln pos } {
	global eb

	set eb [find_close "\{" $ln.[expr $pos + 1] "\}" ]

	catch { $t tag delete upto }

	$t tag add upto $ln.$pos $eb+1chars
	$t tag configure upto -foreground red
}

proc hide_curly { t ln pos } {
	global eb

#	catch { $t tag delete upto }

	catch { $t tag remove upto $ln.$pos $eb+1chars }
}

proc set_curlies {} {
	global a_nr
	# set or reset the bindings for opening curlies

	set t .inp.c.t$a_nr
	set cnt 0
	scan [$t index end] %d numLines
	for {set i 1} {$i < $numLines} {incr i} {

		set line [$t get $i.0 $i.end]
		set cb [string first "\{" $line]

		while {$cb >= 0} {
			incr cnt
			set cl "curinp$cnt"
			catch { $t tag delete $cl }

			$t tag add $cl $i.$cb $i.[expr $cb + 1]

			$t tag bin $cl <Enter> "show_curly $t $i $cb"
			$t tag bin $cl <Leave> "hide_curly $t $i $cb"

			set cb [string first "\{" $line [expr $cb + 1] ]
	}	}
}

proc hot_link {t} {

	set_curlies

	set cnt 0
	scan [$t index end] %d numLines
	for {set i 1} {$i < $numLines} {incr i} {

		set line [$t get $i.0 $i.end]

		## file references
		set matched ""
		regexp {[A-Za-z0-9_]+\.[chyltxm]+:[0-9]+\#[0-9]+} $line matched
		if {$matched == ""} {
			regexp {[A-Za-z0-9_]+\.[chyltxm]+:[0-9]+} $line matched
			if {$matched == ""} {
				continue
		}	}
		set fn [string first $matched $line]
		if {$fn < 0} { continue }	;# cannot happen

		set char  $fn
		set fn $i.$fn
		incr char [string length $matched]
		set splitx [split $matched ":"]
		set fnm [lindex $splitx 0]
		set lnr [lindex $splitx 1]
		set indend $i
		append indend "." $char

		set hl "hotlink$fnm$lnr"

		$t tag configure $hl -foreground brown
		$t tag add       $hl $fn $indend
		$t tag bind      $hl <ButtonPress-1> "
			sel_window $fnm	;# could fail to find file of course
			addlog \"\n\"
			line_command $lnr
		"
		$t tag bind $hl <Enter> "
			$t tag configure $hl -foreground orange
		"
		$t tag bind $hl <Leave> "
			$t tag configure $hl -foreground brown
		"
	}
}

proc readinfile {from} {
	global silent a_nr fnames

	set fnames($a_nr) $from
	if [catch {set fd [open $from r]} errmsg] {
		if {[string range $from 0 0] == "/"} {
			readinfile "c:/cygwin$from"
			return
		}
		addlog "\n$errmsg"
		return
	} else {
		.inp.c.t$a_nr delete 0.0 end
		set linenr 1
		while {[gets $fd line] > -1} {
			if {$linenr != 1} {
				.inp.c.t$a_nr insert end "\n"
			}
			.inp.c.t$a_nr insert end "$line"
			if {[eof $fd] == 0} {
				incr linenr
			} else {
				break
		}	}
		catch { close $fd }

		if {$silent == 0} {
			addlog "\n$from: $linenr lines"
			.inp.c.t$a_nr edit modified false
		}
		color_code
		hot_link .inp.c.t$a_nr
	}
}

proc writeoutfile {f} {
	global silent a_nr

	if {[file exists $f]} {
		if {![file isfile $f] || ![file writable $f]} {
		addlog "\nerror: $f not writable"
		return 0
	}	}

	if [catch {set fd [open $f w]} errmsg] {
		addlog "\n$errmsg"
		return 0
	}
	fconfigure $fd -translation lf

	scan [.inp.c.t$a_nr index end] %d numLines
	for {set i 1} {$i < $numLines} { incr i} {
		puts -nonewline $fd [.inp.c.t$a_nr get $i.0 $i.end]\n
	}
	catch { close $fd }
	if {$silent == 0} {
		addlog "\n$f: $numLines lines"
	}
	.inp.c.t$a_nr edit modified false
	return 1
}

proc save_spec {curr} {
	global a_nr fnames

	if {$curr == 0 || $fnames($a_nr) == ""} {
		switch -- [set file [eval tk_getSaveFile]] "" return
		set fnames($a_nr) $file
	}
	writeoutfile $fnames($a_nr)
}

proc line_command {ln} {
	global a_nr clip_start

	set from $ln
	set upto $ln
	set cpos 0
	set epos end

	if {[string first "," $ln] > 0} {
		if {[scan $ln "%d#%d,%d#%d" from cpos upto epos] != 4 \
		&&  [scan $ln "%d#%d,%d" from cpos upto] != 3 \
		&&  [scan $ln "%d,%d#%d" from upto epos] != 3 \
		&&  [scan $ln "%d,%d" from upto] != 2} {
			addlog "\n?syntax"
			return
		}
	} else {
 		if {[string first "#" $ln] > 0} {
 			if {[scan $ln "%d#%d" from cpos] != 2} {
 				addlog "\n?$ln"
 				return
 			} else {
 				set upto $from
 				set epos [expr $cpos + 1]
 	}	}	}

	scan [.inp.c.t$a_nr index end] %d numLines
	if {$from > $upto || $upto >= $numLines} {
		addlog "\n?$ln"
		return
	}

	.inp.c.t$a_nr yview -pickplace [expr $from-5]
	.inp.c.t$a_nr tag remove hilite 0.0 end
	.inp.c.t$a_nr tag add hilite $from.$cpos $upto.$epos

	catch {	;# make available as selection 
		set clip_start $from.$cpos
		clipboard clear
		clipboard append [.inp.c.t$a_nr get $from.$cpos $upto.$epos]
	}

	# if an x or and stransform command follows the range
	# we can execute it now on the new selection

	set xc [string first "|" $ln]
	if {$xc > 0 && [string length $ln] > $xc} {
		# stransform from clipboard
		set c [string range $ln [expr $xc + 1] end]
		stransform ":" $c
		return
	}

	set xc [string first "x/" $ln]			;# check for an x command
	if {$xc > 0} {
		# x_command on selection
		set c [string range $ln $xc end]
		catch { x_command ":" $c } err	;# ":" means use clipboar
		if {$err != ""} { addlog "\nerr: $err" }
		return
	}

}

proc whatislastline {a} {
	global a_nr

	scan [.inp.c.t$a_nr index end] %d numLines
	addlog "\n$numLines"

	if {$a == ""} {
		line_command [expr $numLines - 1]
	}
}

proc whatiscurrentline {a} {
	global a_nr

	scan [.inp.c.t$a_nr index insert] "%d.%d" y x
	addlog "\n$y"
	if {$a == ""} {
		line_command $y
	}
}

proc findmatch {direction pattern} {
	global search_lno lastpat a_nr

	set w .inp.c.t$a_nr
	$w tag remove hilite 0.0 end
	$w tag remove sel 0.0 end

	if {$pattern == ""} {
		set pattern $lastpat
	} else {
		set lastpat $pattern
		set search_lno [$w index insert]
	}

	scan $search_lno "%d.%d" sy sx

	if {$direction} {
		incr sx
		set search_lno "$sy.$sx"
		set x [.inp.c.t$a_nr search -forwards  -regexp $pattern $search_lno]
	} else {
		incr sx -1
		set search_lno "$sy.$sx"
		set x [.inp.c.t$a_nr search -backwards -regexp $pattern $search_lno]
	}

	if {$x == ""} {
		addlog "\nno match"
	} else {
		set npat [string trimright $pattern "$"]
		set npat [string trimleft $npat "^" ]
		
		scan $x "%d.%d" y x
		$w yview -pickplace [expr $y - 5]
		set lx [expr $x + [string length $npat]]
		$w tag add hilite $y.$x $y.$lx

		$w mark set insert $y.$x
		set search_lno $y.$x
	}
}

proc trytoquit {} {
	global a_nr w_nr present fnames
	global hidden_nr hidden_present hidden_modified hidden_fnames

	for {set i 1} {$i <= $w_nr} {incr i} {
		if {$present($i)} {
 	 		if [.inp.c.t$i edit modified] {
 	 			set answer [tk_messageBox -type yesno -icon question \
 	 				-message "$fnames($i) was modified, really quit?"]
 	 			if {$answer == "no"} {
 	 				return
 	} 	}	}	}

	for {set i 0} {$i < $hidden_nr} {incr i} {
		if {$hidden_present($i)} {
			if {$hidden_modified($i)} {
 	 			set answer [tk_messageBox -type yesno -icon question \
 	 				-message "$hidden_fnames($i) was modified, really quit?"]
 	 			if {$answer == "no"} {
 	 				return
	}	}	}	}

	destroy .; exit 
}

wm iconname . "emin"
wm geometry . 800x800	;# +41+50
wm minsize  . 400 200

size_canvas 800 800

addlog $Version
update

if {$argc >= 1} {
	while {$argc >= 1} {
		incr argc -1
		new_window [lindex "$argv" $argc]
	}
} else {
	new_window ""
	wm title . "$Version"
}

addlog "\n"
update
focus .cmd.t