#!/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