wiki:MacPortsShell

In order to do explorative programming in Tcl shell using macports extensions a self contained script is provided here, the script merges script.tcl from tcl.tk wiki and instructions from committers' tips and tricks.

The script also uses rlwrap and tcl from macports itself, save it with a name like mpsh somewhere in your path, for instance $prefix/bin, and make it executable.

#!/usr/bin/env rlwrap port-tclsh

namespace eval prompt {}

proc prompt::_init {} {
    variable buffer ""
    variable continue 0
    variable prompt1 "% "
    variable prompt2 ""
    return
}

proc prompt::_getline {line} {    
    variable buffer
    variable continue   
    set n1 [string length $line]
    set line2 [string trimright $line \\]
    set n2 [string length $line2]
    set cont [expr {($n1 - $n2) % 2 == 1}]
    if { $cont } {
      set line [string range $line 0 end-1]
    }
    if { $continue } {
      append buffer " [string trimleft $line]"
    } elseif { [string length $buffer] } {
      append buffer \n$line
    } else {
      set buffer $line
    }
    set continue $cont
    if { $continue } {
      set complete 0
    } else {
      set complete [info complete $buffer]
    }
    if { !$continue && [info complete $buffer] } {
      set code [catch {uplevel #0 $buffer} result]
      set std [expr {$code > 0 ? "stderr" : "stdout"}]
      if { [string length $result] } {
        puts $std "$result"
      }
      set buffer ""
      _prompt 1
    } else {
      _prompt 2
    }    
    return
}

proc prompt::_readable {chan} {    
    variable status
    set code [catch {gets $chan line} chars]    
    if { $code > 0 } {
      puts stderr "error reading $chan: $chars"
      set status "error"
    } elseif { $chars > -1 } {
      _getline $line
    } elseif { [eof $chan] } {
      set status "eof"
    } elseif { [fblocked $chan] } {
      return
    } else {
      set status "unknown"
    }    
    return
}

proc prompt::_prompt {n} {
    global tcl_prompt$n
    variable prompt$n
    if { [info exists tcl_prompt$n] } {
      if { [catch {uplevel #0 [set tcl_prompt$n]} result] } {
        puts stderr $result
        flush stderr
      }
    } else {
      puts -nonewline stdout [set prompt$n]
    }
    flush stdout
    return
}

proc prompt::prompt {} {
    _prompt 1
    fileevent stdin readable [list [namespace current]::_readable stdin]
    vwait [namespace current]::status
    return
}

package require macports
mportinit
package require Pextlib

prompt::_init
if { [info exists argv0] && [string equal $argv0 [info script]] } {
    #   set tcl_prompt2 {puts -nonewline "> "}
      set prompt::prompt2 "> "
      prompt::prompt
}

Last modified 22 months ago Last modified on Feb 18, 2016, 11:50:17 AM