Posted to tcl by aspect at Sat May 10 12:06:36 GMT 2008view pretty
namespace eval shell { variable fd [open ~/.tkcon/pipe [list RDONLY NONBLOCK]] variable dir $::env(HOME)/.tkcon fconfigure $fd -blocking 0 -buffering none fileevent $fd readable eval_from_pipe } proc eval_from_pipe {} { variable ::shell::fd if {"" == $fd} { return {} } if [eof $fd] { close $fd set fd [open ~/.tkcon/pipe [list RDONLY NONBLOCK]] fconfigure $fd -blocking 0 -buffering none fileevent $fd readable eval_from_pipe return {} } set text [read $fd] if {"" == $text} { return {} } set text [string trim $text] puts "source {$text} #[info level]" # uplevel #0 [list source $text] namespace eval :: [list source $text] } proc tofile {{fn {}} text} { if {{} == $fn} { set fn [exec mktemp] } set fd [open $fn w] puts -nonewline $fd $text close $fd return $fn } proc fromfile {fn} { set fd [open $fn r] set text [read $fd] close $fd file delete $fn return $text } proc old_ed {text} { variable ::shell::dir exec echo "$text" | gvim --remote "~/.tkcon/pipe" -S vimrc & } proc edfile {fn} { exec gvim --remote $fn & } proc edtclfile {fn} { variable ::shell::dir exec gvim --remote "+autocmd BufWrite ${dir}/* !echo % > ~/.tkcon/pipe" $fn & } proc edftp {fn text} { variable ::shell::dir set fn ${dir}/${fn}.tcl tofile $fn $text exec gvim --remote {+call NetUserPass("ftp", "passwd")} {+e $fn} & } proc edvar {name} { variable ::shell::dir upvar $name var set fn [file join $dir var-${name}.tcl] set def "set $name {$var}" tofile $fn $def uplevel 1 [list edtclfile $fn] } proc edarray {name} { variable ::shell::dir upvar $name var set fn [file join $dir var-${name}.tcl] set fd [open $fn w] puts $fd array unset foo foreach pair [array get $name] { set k [lindex $pair 0] set v [lindex $pair 1] puts $fd "set ${name}($k) {$v}" } close $fd uplevel 1 [list edtclfile $fn] } proc edproc {name} { variable ::shell::dir set fn [file join $dir var-${name}.tcl] set def [list proc $name] set args {} foreach arg [uplevel 1 "info args $name"] { if {[uplevel 1 "info default $name $arg def"]} { lappend args [list $arg $def] } else { lappend args [list $arg] } } lappend def $args [uplevel 1 "info body $name"] tofile $fn $def uplevel 1 [list edtclfile $fn] } proc ed {name} { # set procs [uplevel 1 {info procs}] if {"" != [uplevel 1 "info proc $name"]} { edproc $name } elseif {1 == [uplevel 1 "array exists $name"]} { edarray $name } elseif {1 == [uplevel 1 "info exists $name"]} { edvar $name } else { edfile $name } } #namespace export ed package provide shell 0.2