| 1 | In order to do explorative programming in Tcl shell using macports extensions a self contained script is provided here, the script merges [http://wiki.tcl.tk/26248 script.tcl] from tcl.tk wiki and instructions from [http://trac.macports.org/wiki/CommittersTipsAndTricks#explore commiters' tips and tricks]. |
| 2 | |
| 3 | 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. |
| 4 | |
| 5 | {{{ |
| 6 | |
| 7 | #!/usr/bin/env rlwrap tclsh |
| 8 | |
| 9 | namespace eval prompt {} |
| 10 | |
| 11 | proc prompt::_init {} { |
| 12 | variable buffer "" |
| 13 | variable continue 0 |
| 14 | variable prompt1 "% " |
| 15 | variable prompt2 "" |
| 16 | return |
| 17 | } |
| 18 | |
| 19 | proc prompt::_getline {line} { |
| 20 | variable buffer |
| 21 | variable continue |
| 22 | set n1 [string length $line] |
| 23 | set line2 [string trimright $line \\] |
| 24 | set n2 [string length $line2] |
| 25 | set cont [expr {($n1 - $n2) % 2 == 1}] |
| 26 | if { $cont } { |
| 27 | set line [string range $line 0 end-1] |
| 28 | } |
| 29 | if { $continue } { |
| 30 | append buffer " [string trimleft $line]" |
| 31 | } elseif { [string length $buffer] } { |
| 32 | append buffer \n$line |
| 33 | } else { |
| 34 | set buffer $line |
| 35 | } |
| 36 | set continue $cont |
| 37 | if { $continue } { |
| 38 | set complete 0 |
| 39 | } else { |
| 40 | set complete [info complete $buffer] |
| 41 | } |
| 42 | if { !$continue && [info complete $buffer] } { |
| 43 | set code [catch {uplevel #0 $buffer} result] |
| 44 | set std [expr {$code > 0 ? "stderr" : "stdout"}] |
| 45 | if { [string length $result] } { |
| 46 | puts $std "$result" |
| 47 | } |
| 48 | set buffer "" |
| 49 | _prompt 1 |
| 50 | } else { |
| 51 | _prompt 2 |
| 52 | } |
| 53 | return |
| 54 | } |
| 55 | |
| 56 | proc prompt::_readable {chan} { |
| 57 | variable status |
| 58 | set code [catch {gets $chan line} chars] |
| 59 | if { $code > 0 } { |
| 60 | puts stderr "error reading $chan: $chars" |
| 61 | set status "error" |
| 62 | } elseif { $chars > -1 } { |
| 63 | _getline $line |
| 64 | } elseif { [eof $chan] } { |
| 65 | set status "eof" |
| 66 | } elseif { [fblocked $chan] } { |
| 67 | return |
| 68 | } else { |
| 69 | set status "unknown" |
| 70 | } |
| 71 | return |
| 72 | } |
| 73 | |
| 74 | proc prompt::_prompt {n} { |
| 75 | global tcl_prompt$n |
| 76 | variable prompt$n |
| 77 | if { [info exists tcl_prompt$n] } { |
| 78 | if { [catch {uplevel #0 [set tcl_prompt$n]} result] } { |
| 79 | puts stderr $result |
| 80 | flush stderr |
| 81 | } |
| 82 | } else { |
| 83 | puts -nonewline stdout [set prompt$n] |
| 84 | } |
| 85 | flush stdout |
| 86 | return |
| 87 | } |
| 88 | |
| 89 | proc prompt::prompt {} { |
| 90 | _prompt 1 |
| 91 | fileevent stdin readable [list [namespace current]::_readable stdin] |
| 92 | vwait [namespace current]::status |
| 93 | return |
| 94 | } |
| 95 | |
| 96 | lappend auto_path /opt/local/share/macports/Tcl |
| 97 | source /opt/local/share/macports/Tcl/macports1.0/macports_fastload.tcl |
| 98 | package require macports 1.0 |
| 99 | set portarchivemode no |
| 100 | #package require port 1.0 |
| 101 | package require Pextlib |
| 102 | set prefix /opt/local |
| 103 | |
| 104 | prompt::_init |
| 105 | if { [info exists argv0] && [string equal $argv0 [info script]] } { |
| 106 | # set tcl_prompt2 {puts -nonewline "> "} |
| 107 | set prompt::prompt2 "> " |
| 108 | prompt::prompt |
| 109 | } |
| 110 | |
| 111 | }}} |