cmdr
Check-in [7104561dd4]
Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Pulled some stackato-cli utility packages into cmdr, incomplete work (tty, color, simple interaction)
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 7104561dd4b259535d63c531966d87f9a2d19be3
User & Date: andreask 2014-05-23 00:30:03
References
2014-05-23
22:19 Closed ticket [a80ac87036]: Add facilities for user interaction plus 4 other changes artifact: 7ab7393038 user: aku
22:17 Ticket [8502a858bd] Add facility for colorization status still Closed with 3 other changes artifact: 2239702142 user: aku
22:17 Closed ticket [8502a858bd]. artifact: 26dcf622de user: aku
Context
2014-05-23
06:17
cmdr::actor - Better error message for "set" check-in: abd6c63e65 user: aku tags: trunk
00:30
Pulled some stackato-cli utility packages into cmdr, incomplete work (tty, color, simple interaction) check-in: 7104561dd4 user: andreask tags: trunk
2014-05-21
06:44
cmdr::parameter - Fix use of wrong variable in ValueRelease, use argument, not instance variable. check-in: 623a3ff06b user: aku tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Added ask.tcl.

            1  +## -*- tcl -*-
            2  +# # ## ### ##### ######## ############# #####################
            3  +## CMDR - Convenience commands for terminal-based user interaction.
            4  +
            5  +# @@ Meta Begin
            6  +# Package cmdr::ask 0
            7  +# Meta author   {Andreas Kupries}
            8  +# Meta location https://core.tcl.tk/akupries/cmdr
            9  +# Meta platform tcl
           10  +# Meta summary     Terminal-based user interaction commands.
           11  +# Meta description Commands to interact with the user in various
           12  +# Meta description simple ways, for a terminal.
           13  +# Meta subject {command line} tty interaction terminal
           14  +# Meta require {Tcl 8.5-}
           15  +# Meta require debug
           16  +# Meta require debug::caller
           17  +# Meta require cmdr::color
           18  +# Meta require try
           19  +# Meta require linenoise
           20  +# Meta require struct::matrix
           21  +# Meta require textutil::adjust
           22  +# @@ Meta End
           23  +
           24  +# # ## ### ##### ######## ############# #####################
           25  +## Requisites
           26  +
           27  +package require Tcl 8.5
           28  +#package require cmdr::color
           29  +package require debug
           30  +package require debug::caller
           31  +package require linenoise
           32  +package require try
           33  +package require struct::matrix
           34  +package require textutil::adjust
           35  +
           36  +namespace eval ::cmdr {
           37  +    namespace export ask
           38  +}
           39  +namespace eval ::cmdr::ask {
           40  +    #namespace import ::stackato::color
           41  +    namespace export string string/extended string* yn choose menu
           42  +    namespace create ensemble
           43  +}
           44  +
           45  +# # ## ### ##### ######## ############# #####################
           46  +
           47  +debug define cmdr/ask
           48  +debug level  cmdr/ask
           49  +debug prefix cmdr/ask {[debug caller] | }
           50  +
           51  +# # ## ### ##### ######## ############# #####################
           52  +
           53  +proc ::cmdr::ask::string {query {default {}}} {
           54  +    debug.cmdr/ask {}
           55  +    try {
           56  +	set response [Interact {*}[Fit $query 10]]
           57  +    } on error {e o} {
           58  +	if {$e eq "aborted"} {
           59  +	    error Interrupted error SIGTERM
           60  +	}
           61  +	return {*}${o} $e
           62  +    }
           63  +    if {($response eq {}) && ($default ne {})} {
           64  +	set response $default
           65  +    }
           66  +    return $response
           67  +}
           68  +
           69  +proc ::cmdr::ask::string/extended {query args} {
           70  +    debug.cmdr/ask {}
           71  +    # accept  -history, -hidden, -complete
           72  +    # plus    -default
           73  +    # but not -prompt
           74  +
           75  +    # for history ... integrate history load/save from file here?
           76  +    # -history is then not boolean, but path to history file.
           77  +
           78  +    set default {}
           79  +    set config {}
           80  +    foreach {o v} $args {
           81  +	switch -exact -- $o {
           82  +	    -history -
           83  +	    -hidden -
           84  +	    -complete {
           85  +		lappend config $o $v
           86  +	    }
           87  +	    -default {
           88  +		set default $v
           89  +	    }
           90  +	    default {
           91  +		return -code error "Bad option \"$o\", expected one of -history, -hidden, -prompt, or -default"
           92  +	    }
           93  +	}
           94  +    }
           95  +    try {
           96  +	set response [Interact {*}[Fit $query 10] {*}$config]
           97  +    } on error {e o} {
           98  +	if {$e eq "aborted"} {
           99  +	    error Interrupted error SIGTERM
          100  +	}
          101  +	return {*}${o} $e
          102  +    }
          103  +    if {($response eq {}) && ($default ne {})} {
          104  +	set response $default
          105  +    }
          106  +    return $response
          107  +}
          108  +
          109  +proc ::cmdr::ask::string* {query} {
          110  +    debug.cmdr/ask {}
          111  +    try {
          112  +	set response [Interact {*}[Fit $query 10] -hidden 1]
          113  +    } on error {e o} {
          114  +	if {$e eq "aborted"} {
          115  +	    error Interrupted error SIGTERM
          116  +	}
          117  +	return {*}${o} $e
          118  +    }
          119  +    return $response
          120  +}
          121  +
          122  +proc ::cmdr::ask::yn {query {default yes}} {
          123  +    debug.cmdr/ask {}
          124  +    set dinfo [expr {$default
          125  +		     ? " \[Yn\]: "
          126  +		     : " \[yN\]: "}]
          127  +    # Reactivate with color support.
          128  +    if 0 {set dinfo [expr {$default
          129  +			   ? " \[[color green Y]n\]: "
          130  +			   : " \[y[color green N]\]: "}]}
          131  +    append query $dinfo
          132  +
          133  +    lassign [Fit $query 5] header prompt
          134  +    while {1} {
          135  +	try {
          136  +	    set response \
          137  +		[Interact $header $prompt \
          138  +		     -complete [namespace code {Complete {yes no false true on off 0 1} 1}]]
          139  +		     
          140  +	} on error {e o} {
          141  +	    if {$e eq "aborted"} {
          142  +		error Interrupted error SIGTERM
          143  +	    }
          144  +	    return {*}${o} $e
          145  +	}
          146  +	if {$response eq {}} { set response $default }
          147  +	if {[string is bool $response]} break
          148  +	puts stdout [Wrap "You must choose \"yes\" or \"no\""]
          149  +    }
          150  +
          151  +    return $response
          152  +}
          153  +
          154  +proc ::cmdr::ask::choose {query choices {default {}}} {
          155  +    debug.cmdr/ask {}
          156  +
          157  +    set hasdefault [expr {$default in $choices}]
          158  +
          159  +    set lc [linsert [join $choices {, }] end-1 or]
          160  +    if {$hasdefault} {
          161  +	# when we have color support, reactivate
          162  +	#lappend map $default [color green $default]
          163  +	#set lc [string map $map $lc]
          164  +    }
          165  +
          166  +    append query " ($lc): "
          167  +
          168  +    lassign [Fit $query 5] header prompt
          169  +
          170  +    while {1} {
          171  +	try {
          172  +	    set response \
          173  +		[Interact $header $prompt \
          174  +		     -complete [namespace code [list Complete $choices 0]]]
          175  +	} on error {e o} {
          176  +	    if {$e eq "aborted"} {
          177  +		error Interrupted error SIGTERM
          178  +	    }
          179  +	    return {*}${o} $e
          180  +	}
          181  +	if {($response eq {}) && $hasdefault} {
          182  +	    set response $default
          183  +	}
          184  +	if {$response in $choices} break
          185  +	puts stdout [Wrap "You must choose one of $lc"]
          186  +    }
          187  +
          188  +    return $response
          189  +}
          190  +
          191  +proc ::cmdr::ask::menu {header prompt choices {default {}}} {
          192  +    debug.cmdr/ask {}
          193  +
          194  +    set hasdefault [expr {$default in $choices}]
          195  +
          196  +    # Full list of choices is the choices themselves, plus the numeric
          197  +    # indices we can address them by. This is for the prompt
          198  +    # completion callback below.
          199  +    set fullchoices $choices
          200  +
          201  +    # Build table (2-column matrix)
          202  +    struct::matrix [self namespace]::M
          203  +    M add columns 2
          204  +    set n 1
          205  +    foreach c $choices {
          206  +	if 0 {if {$default eq $c} {
          207  +	    M add row [list ${n}. [color green $c]]
          208  +	} else {
          209  +	    M add row [list ${n}. $c]
          210  +	}}
          211  +
          212  +	M add row [list ${n}. $c]
          213  +	lappend fullchoices $n
          214  +	incr n
          215  +    }
          216  +    set Mstr [M format 2string]
          217  +    M destroy
          218  +
          219  +    # Format the prompt
          220  +    lassign [Fit $prompt 5] pheader prompt
          221  +
          222  +    # Interaction loop
          223  +    while {1} {
          224  +	if {$header ne {}} {puts stdout $header}
          225  +	puts stdout $Mstr
          226  +
          227  +	try {
          228  +	    set response \
          229  +		[Interact $pheader $prompt \
          230  +		     -complete [namespace code [list Complete $fullchoices 0]]]
          231  +	} on error {e o} {
          232  +	    if {$e eq "aborted"} {
          233  +		error Interrupted error SIGTERM
          234  +	    }
          235  +	    return {*}${o} $e
          236  +	}
          237  +	if {($response eq {}) && $hasdefault} {
          238  +	    set response $default
          239  +	}
          240  +
          241  +	if {$response in $choices} break
          242  +
          243  +	if {[string is int $response]} {
          244  +	    # Inserting a dummy to handle indexing from 1...
          245  +	    set response [lindex [linsert $choices 0 {}] $response]
          246  +	    if {$response in $choices} break
          247  +	}
          248  +
          249  +	puts stdout [Wrap "You must choose one of the above"]
          250  +    }
          251  +
          252  +    return $response
          253  +}
          254  +
          255  +# # ## ### ##### ######## ############# #####################
          256  +
          257  +proc ::cmdr::ask::Complete {choices nocase buffer} {
          258  +    debug.cmdr/ask {}
          259  +
          260  +    if {$buffer eq {}} {
          261  +	return $choices
          262  +    }
          263  +
          264  +    if {$nocase} {
          265  +	set buffer [string tolower $buffer]
          266  +    }
          267  +
          268  +    set candidates {}
          269  +    foreach c $choices {
          270  +	if {![string match ${buffer}* $c]} continue
          271  +	lappend candidates $c
          272  +    }
          273  +    return $candidates
          274  +}
          275  +
          276  +proc ::cmdr::ask::Interact {header prompt args} {
          277  +    debug.cmdr/ask {}
          278  +    if {$header ne {}} { puts $header }
          279  +    return [linenoise prompt {*}$args -prompt $prompt]
          280  +}
          281  +
          282  +proc ::cmdr::ask::Wrap {text {down 0}} {
          283  +    debug.cmdr/ask {}
          284  +    global env
          285  +    if {[info exists env(CMDR_NO_WRAP)]} {
          286  +	return $text
          287  +    }
          288  +    set c [expr {[linenoise columns]-$down}]
          289  +    return [textutil::adjust::adjust $text -length $c -strictlength 1]
          290  +}
          291  +
          292  +proc ::cmdr::ask::Fit {prompt space} {
          293  +    debug.cmdr/ask {}
          294  +    # Similar to Wrap, except with a split following.
          295  +    global env
          296  +    if {[info exists env(CMDR_NO_WRAP)]} {
          297  +	return [list {} $prompt]
          298  +    }
          299  +
          300  +    set w [expr {[linenoise columns] - $space }]
          301  +    # we leave space for some characters to be entered.
          302  +
          303  +    if {[string length $prompt] < $w} {
          304  +	return [list {} $prompt]
          305  +    }
          306  +
          307  +    set prompt [textutil::adjust::adjust $prompt -length $w -strictlength 1]
          308  +    set prompt [split $prompt \n]
          309  +    set header [join [lrange $prompt 0 end-1] \n]
          310  +    set prompt [lindex $prompt end]
          311  +    # alt code for the same.
          312  +    #set header [join [lreverse [lassign [lreverse [split $prompt \n]] prompt]] \n]
          313  +    append prompt { }
          314  +
          315  +    return [list $header $prompt]
          316  +}
          317  +
          318  +# # ## ### ##### ######## ############# #####################
          319  +## Ready
          320  +package provide cmdr::ask 0

Added color.tcl.

            1  +## -*- tcl -*-
            2  +# # ## ### ##### ######## ############# #####################
            3  +## CMDR - Convenience commands for colored text in terminals.
            4  +
            5  +# @@ Meta Begin
            6  +# Package cmdr::color 0
            7  +# Meta author   {Andreas Kupries}
            8  +# Meta location https://core.tcl.tk/akupries/cmdr
            9  +# Meta platform tcl
           10  +# Meta summary     Text colorization for terminal output
           11  +# Meta description Commands to manage colored text in terminal
           12  +# Meta description output
           13  +# Meta subject {command line} terminal color {text colors}
           14  +# Meta require {Tcl 8.5-}
           15  +# Meta require debug
           16  +# Meta require debug::caller
           17  +# Meta require cmdr::tty
           18  +# @@ Meta End
           19  +
           20  +# # ## ### ##### ######## ############# #####################
           21  +## Requisites
           22  +
           23  +package require Tcl 8.5
           24  +package require debug
           25  +package require debug::caller
           26  +package require cmdr::tty
           27  +
           28  +# # ## ### ##### ######## ############# #####################
           29  +
           30  +namespace eval ::cmdr::color {
           31  +    namespace export activate active define
           32  +    namespace ensemble create \
           33  +	-unknown [namespace current]::Unknown
           34  +    # Note, the option ensures that all unknown methods are treated as
           35  +    # (list of) color codes to apply to some text, effectively
           36  +    # creating the virtual command
           37  +    #
           38  +    #    ::cmdr::color <codelist> <text>
           39  +    ##
           40  +
           41  +    namespace import ::cmdr::tty
           42  +}
           43  +
           44  +# # ## ### ##### ######## ############# #####################
           45  +
           46  +debug define cmdr/color
           47  +debug level  cmdr/color
           48  +debug prefix cmdr/color {[debug caller] | }
           49  +
           50  +# # ## ### ##### ######## ############# #####################
           51  +## TODO undef?
           52  +## TODO multi-def (load)
           53  +## TODO get (display)
           54  +## officer and private for std commands (show, define).
           55  +
           56  +proc ::cmdr::color::activate {{flag 1}} {
           57  +    debug.cmdr/color {}
           58  +    variable active $flag
           59  +    return
           60  +}
           61  +
           62  +proc ::cmdr::color::active {} {
           63  +    debug.cmdr/color {}
           64  +    variable active
           65  +    return  $active
           66  +}
           67  +
           68  +proc ::cmdr::color::define {name spec} {
           69  +    debug.cmdr/color {}
           70  +    variable def
           71  +    variable char
           72  +    # TODO: spec may be
           73  +    # => reference to other color name, or
           74  +    # => raw control sequence, or
           75  +    # => RGB spec.
           76  +
           77  +    # Syntax:
           78  +    # ref = anything already found as key in the database.
           79  +    # rgb = 
           80  +    # raw = 
           81  +
           82  +    if {[dict exists $def $spec]} {
           83  +	if {$spec eq $name} {
           84  +	    return -code error \
           85  +		-errorcode [list CMDR COLOR CIRCLE $name] \
           86  +		"Rejected self-referential definition of \"$name\""
           87  +	}
           88  +	debug.cmdr/color {reference, resolved => [S [dict get $char $spec]]}
           89  +	dict set def  $name $spec
           90  +	dict set char $name [dict get $char $spec]
           91  +	return
           92  +    }
           93  +
           94  +    if {[regexp {^%(\d+),(\d+),(\d+)$} $spec -> r g b]} {
           95  +	# R, G, B all in range 0..5
           96  +	set r [Clamp $r]
           97  +	set g [Clamp $g]
           98  +	set b [Clamp $b]
           99  +	# 256 mapping
          100  +	# code = 16 + 36R + 6G + B --> [16..236]
          101  +	set code [expr {16 + 36*$r + 6*$g + $b}]
          102  +	debug.cmdr/color {RGB encoded => [S [C $code]]}
          103  +	dict set def  $name $spec
          104  +	dict set char $name [C $code]
          105  +	return
          106  +
          107  +	# Legacy mapping
          108  +	# R,G,B mapping 0,1 --> 0, 2,3 --> 1, 4,5 --> 2
          109  +	# bold mapping: 0,1,2 --> 0,1,1 (set if any of R, G, B)
          110  +	# code = 8bold + R + 2G + 4B
          111  +	#      = 8, for R==G==B != 0, special case.
          112  +    }
          113  +
          114  +    # Raw control sequence, simply save
          115  +    dict set def  $name $spec
          116  +    dict set char $name $spec
          117  +    return
          118  +}
          119  +
          120  +# # ## ### ##### ######## ############# #####################
          121  +
          122  +proc ::cmdr::color::Unknown {cmd codes text} {
          123  +    list [namespace current]::Apply $codes
          124  +}
          125  +
          126  +proc ::cmdr::color::Apply {codes text} {
          127  +    debug.cmdr/color {}
          128  +
          129  +    variable active
          130  +    if {!$active} {
          131  +	debug.cmdr/color {not active}
          132  +	return $text
          133  +    }
          134  +
          135  +    variable char
          136  +    foreach c $codes {
          137  +	if {[dict exists $char $c]} {
          138  +	    return -code error \
          139  +		-errorcode [list CMDR COLOR UNKNOWN $c] \
          140  +		"Expected a color name, got \"$c\""
          141  +	}
          142  +	append r [dict get $char $c]
          143  +    }
          144  +    append r $text
          145  +    append r [dict get $char reset]
          146  +
          147  +    debug.cmdr/color {/done}
          148  +    return $r
          149  +}
          150  +
          151  +proc ::cmdr::color::S {text} {
          152  +    # quote all non-printable characters (< space, > ~)
          153  +    variable smap
          154  +    return [string map $smap $text]
          155  +}
          156  +
          157  +proc ::cmdr::color::C {args} {
          158  +    return \033\[[join $args \;]m
          159  +}
          160  +
          161  +proc ::cmdr::color::Clamp {x} {
          162  +    if {$x < 0} { return 0 }
          163  +    if {$x > 5} { return 5 }
          164  +    return $x
          165  +}
          166  +
          167  +# # ## ### ##### ######## ############# #####################
          168  +
          169  +namespace eval ::cmdr::color {
          170  +    # Boolean flag controlling use of color sequences.
          171  +    # Default based on tty-ness of stdout. Active if yes.
          172  +    variable active [tty stdout]
          173  +
          174  +    # Database (dictionary) of standard colors and associated codes.
          175  +    # Based on the standard ANSI colors (16-color terminal). The two
          176  +    # dictionaries hold the user-level specification and the
          177  +    # full-resolved character sequence.
          178  +
          179  +    variable def  {}
          180  +    variable char {}
          181  +
          182  +    # Colors. Foreground/Text.
          183  +    define  black        [C 30]  ; # Black  
          184  +    define  red          [C 31]  ; # Red    
          185  +    define  green        [C 32]  ; # Green  
          186  +    define  yellow       [C 33]  ; # Yellow 
          187  +    define  blue         [C 34]  ; # Blue   
          188  +    define  magenta      [C 35]  ; # Magenta
          189  +    define  cyan         [C 36]  ; # Cyan   
          190  +    define  white        [C 37]  ; # White  
          191  +    define  default      [C 39]  ; # Default (Black)
          192  +
          193  +    # Colors. Background.
          194  +    define  bg-black     [C 40]  ; # Black  
          195  +    define  bg-red       [C 41]  ; # Red    
          196  +    define  bg-green     [C 42]  ; # Green  
          197  +    define  bg-yellow    [C 43]  ; # Yellow 
          198  +    define  bg-blue      [C 44]  ; # Blue   
          199  +    define  bg-magenta   [C 45]  ; # Magenta
          200  +    define  bg-cyan      [C 46]  ; # Cyan   
          201  +    define  bg-white     [C 47]  ; # White  
          202  +    define  bg-default   [C 49]  ; # Default (Transparent)
          203  +
          204  +    # Non-color attributes. Activation.
          205  +    define  bold         [C  1]  ; # Bold  
          206  +    define  dim          [C  2]  ; # Dim
          207  +    define  italic       [C  3]  ; # Italics      
          208  +    define  underline    [C  4]  ; # Underscore   
          209  +    define  blink        [C  5]  ; # Blink
          210  +    define  revers       [C  7]  ; # Reverse      
          211  +    define  hidden       [C  8]  ; # Hidden
          212  +    define  strike       [C  9]  ; # StrikeThrough
          213  +
          214  +    # Non-color attributes. Deactivation.
          215  +    define  no-bold      [C 22]  ; # Bold  
          216  +    define  no-dim       [C __]  ; # Dim
          217  +    define  no-italic    [C 23]  ; # Italics      
          218  +    define  no-underline [C 24]  ; # Underscore   
          219  +    define  no-blink     [C 25]  ; # Blink
          220  +    define  no-revers    [C 27]  ; # Reverse      
          221  +    define  no-hidden    [C 28]  ; # Hidden
          222  +    define  no-strike    [C 29]  ; # StrikeThrough
          223  +
          224  +    # Remainder
          225  +    define  reset        [C  0]  ; # Reset
          226  +
          227  +    # And now the standard symbolic names
          228  +
          229  +    define  confirm red
          230  +    define  error   red
          231  +    define  warning yellow
          232  +    define  note    blue
          233  +    define  good    green
          234  +    define  name    blue
          235  +
          236  +    # header command stopped advisory crashed failure success name prompt table warning
          237  +    # bl/whi bl/yel  bl/grey bl/yel   bl/red  bl/red  bl/gre  bl/cy bl/cy bl/cy bl/mag
          238  +    # stdout - white, stderr - red
          239  +    # app-header sys-header
          240  +    # bl/yel     bl/cy
          241  +
          242  +    # others ...
          243  +    # name	<>	blue,
          244  +    # neutral	<>	blue,
          245  +    # good	<>	green,
          246  +    # bad	<>	red,
          247  +    # error	<>	magenta,
          248  +    # unknown	<>	cyan,
          249  +    # warning	<>	yellow,
          250  +    # instance<>	yellow,
          251  +    # number	<>	green,
          252  +    # prompt	<>	blue,
          253  +    # yes	<>	green,
          254  +    # no	<>	red
          255  +
          256  +    variable smap {}
          257  +}
          258  +
          259  +apply {{} {
          260  +    variable smap
          261  +    for {set i 0} {$i < 32} {incr i} {
          262  +	set c [format %c $i]
          263  +	set o \\[format %03o $i] 
          264  +	lappend smap $c $o
          265  +    }
          266  +    lappend smap \127 \\127
          267  +}} ::cmdr::color
          268  +
          269  +# # ## ### ##### ######## ############# #####################
          270  +## Ready
          271  +package provide cmdr::color 0

Added tty.tcl.

            1  +## -*- tcl -*-
            2  +# # ## ### ##### ######## ############# #####################
            3  +## CMDR - TTY. Convenience command for checking if stdout is a tty.
            4  +
            5  +# @@ Meta Begin
            6  +# Package cmdr::tty 0
            7  +# Meta author   {Andreas Kupries}
            8  +# Meta location https://core.tcl.tk/akupries/cmdr
            9  +# Meta platform tcl
           10  +# Meta summary     Check if stdout is a TTY.
           11  +# Meta description 
           12  +# Meta subject {command line} tty
           13  +# Meta require {Tcl 8.5-}
           14  +# Meta require Tclx
           15  +# Meta require debug
           16  +# Meta require debug::caller
           17  +# @@ Meta End
           18  +
           19  +# # ## ### ##### ######## ############# #####################
           20  +## Requisites
           21  +
           22  +package require Tcl 8.5
           23  +package require Tclx
           24  +package require debug
           25  +package require debug::caller
           26  +
           27  +# # ## ### ##### ######## #############
           28  +
           29  +namespace eval ::cmdr {
           30  +    namespace export tty
           31  +    namespace ensemble create
           32  +}
           33  +
           34  +namespace eval ::cmdr::tty {
           35  +    namespace export stdout
           36  +    namespace ensemble create
           37  +}
           38  +
           39  +# # ## ### ##### ######## ############# #####################
           40  +
           41  +debug define cmdr/tty
           42  +debug level  cmdr/tty
           43  +debug prefix cmdr/tty {[debug caller] | }
           44  +
           45  +# # ## ### ##### ######## #############
           46  +
           47  +if {$::tcl_platform(platform) eq "windows"} {
           48  +    proc ::cmdr::tty::stdout {} {
           49  +	debug.cmdr/tty {-- windows --}
           50  +	return 0
           51  +    }
           52  +} else {
           53  +    proc ::cmdr::tty::stdout {} {
           54  +	debug.cmdr/tty {-- unix/osx --}
           55  +	fstat stdout tty
           56  +    }
           57  +}
           58  +
           59  +# # ## ### ##### ######## #############
           60  +package provide tty 0