#!/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 .
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 { popup_menu %W .cmd.t }
bind .cmd.t { save_selection }
frame .inp
canvas .inp.c -width 600 -height 720
pack append .inp .inp.c {left fill expand}
bind .cmd.t { ;# in both windows
save_spec 1
addlog "\n"
}
bind .cmd.t {
# 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 { 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
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 { save_spec 1; addlog "\n" }
bind .inp.c.t$w_nr "move_focus $w_nr"
bind .inp.c.t$w_nr { } ;# fails to remove default binding
bind .inp.c.t$w_nr { popup_menu %W .inp.c.t$w_nr }
bind .inp.c.t$w_nr { set_selection }
bind .inp.c.t$w_nr { tk_textCopy .inp.c.t$w_nr; tk_textCut .inp.c.t$w_nr }
bind .inp.c.t$w_nr { tk_textCopy .inp.c.t$w_nr }
bind .inp.c.t$w_nr { dopaste }
bind .inp.c.t$w_nr { 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 " \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 " \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 " \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_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_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 "show_curly $t $i $cb"
$t tag bin $cl "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 "
sel_window $fnm ;# could fail to find file of course
addlog \"\n\"
line_command $lnr
"
$t tag bind $hl "
$t tag configure $hl -foreground orange
"
$t tag bind $hl "
$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