## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## CMDR - Convenience commands for terminal-based user interaction.

# @@ Meta Begin
# Package cmdr::ask 0
# Meta author   {Andreas Kupries}
# Meta location https://core.tcl.tk/akupries/cmdr
# Meta platform tcl
# Meta summary     Terminal-based user interaction commands.
# Meta description Commands to interact with the user in various
# Meta description simple ways, for a terminal.
# Meta subject {command line} tty interaction terminal
# Meta require {Tcl 8.5-}
# Meta require debug
# Meta require debug::caller
# Meta require cmdr::color
# Meta require try
# Meta require linenoise
# Meta require struct::matrix
# Meta require textutil::adjust
# @@ Meta End

# # ## ### ##### ######## ############# #####################
## Requisites

package require Tcl 8.5
#package require cmdr::color
package require debug
package require debug::caller
package require linenoise
package require try
package require struct::matrix
package require textutil::adjust

namespace eval ::cmdr {
    namespace export ask
}
namespace eval ::cmdr::ask {
    #namespace import ::stackato::color
    namespace export string string/extended string* yn choose menu
    namespace create ensemble
}

# # ## ### ##### ######## ############# #####################

debug define cmdr/ask
debug level  cmdr/ask
debug prefix cmdr/ask {[debug caller] | }

# # ## ### ##### ######## ############# #####################

proc ::cmdr::ask::string {query {default {}}} {
    debug.cmdr/ask {}
    try {
	set response [Interact {*}[Fit $query 10]]
    } on error {e o} {
	if {$e eq "aborted"} {
	    error Interrupted error SIGTERM
	}
	return {*}${o} $e
    }
    if {($response eq {}) && ($default ne {})} {
	set response $default
    }
    return $response
}

proc ::cmdr::ask::string/extended {query args} {
    debug.cmdr/ask {}
    # accept  -history, -hidden, -complete
    # plus    -default
    # but not -prompt

    # for history ... integrate history load/save from file here?
    # -history is then not boolean, but path to history file.

    set default {}
    set config {}
    foreach {o v} $args {
	switch -exact -- $o {
	    -history -
	    -hidden -
	    -complete {
		lappend config $o $v
	    }
	    -default {
		set default $v
	    }
	    default {
		return -code error "Bad option \"$o\", expected one of -history, -hidden, -prompt, or -default"
	    }
	}
    }
    try {
	set response [Interact {*}[Fit $query 10] {*}$config]
    } on error {e o} {
	if {$e eq "aborted"} {
	    error Interrupted error SIGTERM
	}
	return {*}${o} $e
    }
    if {($response eq {}) && ($default ne {})} {
	set response $default
    }
    return $response
}

proc ::cmdr::ask::string* {query} {
    debug.cmdr/ask {}
    try {
	set response [Interact {*}[Fit $query 10] -hidden 1]
    } on error {e o} {
	if {$e eq "aborted"} {
	    error Interrupted error SIGTERM
	}
	return {*}${o} $e
    }
    return $response
}

proc ::cmdr::ask::yn {query {default yes}} {
    debug.cmdr/ask {}
    set dinfo [expr {$default
		     ? " \[Yn\]: "
		     : " \[yN\]: "}]
    # Reactivate with color support.
    if 0 {set dinfo [expr {$default
			   ? " \[[color green Y]n\]: "
			   : " \[y[color green N]\]: "}]}
    append query $dinfo

    lassign [Fit $query 5] header prompt
    while {1} {
	try {
	    set response \
		[Interact $header $prompt \
		     -complete [namespace code {Complete {yes no false true on off 0 1} 1}]]
		     
	} on error {e o} {
	    if {$e eq "aborted"} {
		error Interrupted error SIGTERM
	    }
	    return {*}${o} $e
	}
	if {$response eq {}} { set response $default }
	if {[string is bool $response]} break
	puts stdout [Wrap "You must choose \"yes\" or \"no\""]
    }

    return $response
}

proc ::cmdr::ask::choose {query choices {default {}}} {
    debug.cmdr/ask {}

    set hasdefault [expr {$default in $choices}]

    set lc [linsert [join $choices {, }] end-1 or]
    if {$hasdefault} {
	# when we have color support, reactivate
	#lappend map $default [color green $default]
	#set lc [string map $map $lc]
    }

    append query " ($lc): "

    lassign [Fit $query 5] header prompt

    while {1} {
	try {
	    set response \
		[Interact $header $prompt \
		     -complete [namespace code [list Complete $choices 0]]]
	} on error {e o} {
	    if {$e eq "aborted"} {
		error Interrupted error SIGTERM
	    }
	    return {*}${o} $e
	}
	if {($response eq {}) && $hasdefault} {
	    set response $default
	}
	if {$response in $choices} break
	puts stdout [Wrap "You must choose one of $lc"]
    }

    return $response
}

proc ::cmdr::ask::menu {header prompt choices {default {}}} {
    debug.cmdr/ask {}

    set hasdefault [expr {$default in $choices}]

    # Full list of choices is the choices themselves, plus the numeric
    # indices we can address them by. This is for the prompt
    # completion callback below.
    set fullchoices $choices

    # Build table (2-column matrix)
    struct::matrix [self namespace]::M
    M add columns 2
    set n 1
    foreach c $choices {
	if 0 {if {$default eq $c} {
	    M add row [list ${n}. [color green $c]]
	} else {
	    M add row [list ${n}. $c]
	}}

	M add row [list ${n}. $c]
	lappend fullchoices $n
	incr n
    }
    set Mstr [M format 2string]
    M destroy

    # Format the prompt
    lassign [Fit $prompt 5] pheader prompt

    # Interaction loop
    while {1} {
	if {$header ne {}} {puts stdout $header}
	puts stdout $Mstr

	try {
	    set response \
		[Interact $pheader $prompt \
		     -complete [namespace code [list Complete $fullchoices 0]]]
	} on error {e o} {
	    if {$e eq "aborted"} {
		error Interrupted error SIGTERM
	    }
	    return {*}${o} $e
	}
	if {($response eq {}) && $hasdefault} {
	    set response $default
	}

	if {$response in $choices} break

	if {[string is int $response]} {
	    # Inserting a dummy to handle indexing from 1...
	    set response [lindex [linsert $choices 0 {}] $response]
	    if {$response in $choices} break
	}

	puts stdout [Wrap "You must choose one of the above"]
    }

    return $response
}

# # ## ### ##### ######## ############# #####################

proc ::cmdr::ask::Complete {choices nocase buffer} {
    debug.cmdr/ask {}

    if {$buffer eq {}} {
	return $choices
    }

    if {$nocase} {
	set buffer [string tolower $buffer]
    }

    set candidates {}
    foreach c $choices {
	if {![string match ${buffer}* $c]} continue
	lappend candidates $c
    }
    return $candidates
}

proc ::cmdr::ask::Interact {header prompt args} {
    debug.cmdr/ask {}
    if {$header ne {}} { puts $header }
    return [linenoise prompt {*}$args -prompt $prompt]
}

proc ::cmdr::ask::Wrap {text {down 0}} {
    debug.cmdr/ask {}
    global env
    if {[info exists env(CMDR_NO_WRAP)]} {
	return $text
    }
    set c [expr {[linenoise columns]-$down}]
    return [textutil::adjust::adjust $text -length $c -strictlength 1]
}

proc ::cmdr::ask::Fit {prompt space} {
    debug.cmdr/ask {}
    # Similar to Wrap, except with a split following.
    global env
    if {[info exists env(CMDR_NO_WRAP)]} {
	return [list {} $prompt]
    }

    set w [expr {[linenoise columns] - $space }]
    # we leave space for some characters to be entered.

    if {[string length $prompt] < $w} {
	return [list {} $prompt]
    }

    set prompt [textutil::adjust::adjust $prompt -length $w -strictlength 1]
    set prompt [split $prompt \n]
    set header [join [lrange $prompt 0 end-1] \n]
    set prompt [lindex $prompt end]
    # alt code for the same.
    #set header [join [lreverse [lassign [lreverse [split $prompt \n]] prompt]] \n]
    append prompt { }

    return [list $header $prompt]
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::ask 0

## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## CMDR - Convenience commands for colored text in terminals.

# @@ Meta Begin
# Package cmdr::color 0
# Meta author   {Andreas Kupries}
# Meta location https://core.tcl.tk/akupries/cmdr
# Meta platform tcl
# Meta summary     Text colorization for terminal output
# Meta description Commands to manage colored text in terminal
# Meta description output
# Meta subject {command line} terminal color {text colors}
# Meta require {Tcl 8.5-}
# Meta require debug
# Meta require debug::caller
# Meta require cmdr::tty
# @@ Meta End

# # ## ### ##### ######## ############# #####################
## Requisites

package require Tcl 8.5
package require debug
package require debug::caller
package require cmdr::tty

# # ## ### ##### ######## ############# #####################

namespace eval ::cmdr::color {
    namespace export activate active define
    namespace ensemble create \
	-unknown [namespace current]::Unknown
    # Note, the option ensures that all unknown methods are treated as
    # (list of) color codes to apply to some text, effectively
    # creating the virtual command
    #
    #    ::cmdr::color <codelist> <text>
    ##

    namespace import ::cmdr::tty
}

# # ## ### ##### ######## ############# #####################

debug define cmdr/color
debug level  cmdr/color
debug prefix cmdr/color {[debug caller] | }

# # ## ### ##### ######## ############# #####################
## TODO undef?
## TODO multi-def (load)
## TODO get (display)
## officer and private for std commands (show, define).

proc ::cmdr::color::activate {{flag 1}} {
    debug.cmdr/color {}
    variable active $flag
    return
}

proc ::cmdr::color::active {} {
    debug.cmdr/color {}
    variable active
    return  $active
}

proc ::cmdr::color::define {name spec} {
    debug.cmdr/color {}
    variable def
    variable char
    # TODO: spec may be
    # => reference to other color name, or
    # => raw control sequence, or
    # => RGB spec.

    # Syntax:
    # ref = anything already found as key in the database.
    # rgb = 
    # raw = 

    if {[dict exists $def $spec]} {
	if {$spec eq $name} {
	    return -code error \
		-errorcode [list CMDR COLOR CIRCLE $name] \
		"Rejected self-referential definition of \"$name\""
	}
	debug.cmdr/color {reference, resolved => [S [dict get $char $spec]]}
	dict set def  $name $spec
	dict set char $name [dict get $char $spec]
	return
    }

    if {[regexp {^%(\d+),(\d+),(\d+)$} $spec -> r g b]} {
	# R, G, B all in range 0..5
	set r [Clamp $r]
	set g [Clamp $g]
	set b [Clamp $b]
	# 256 mapping
	# code = 16 + 36R + 6G + B --> [16..236]
	set code [expr {16 + 36*$r + 6*$g + $b}]
	debug.cmdr/color {RGB encoded => [S [C $code]]}
	dict set def  $name $spec
	dict set char $name [C $code]
	return

	# Legacy mapping
	# R,G,B mapping 0,1 --> 0, 2,3 --> 1, 4,5 --> 2
	# bold mapping: 0,1,2 --> 0,1,1 (set if any of R, G, B)
	# code = 8bold + R + 2G + 4B
	#      = 8, for R==G==B != 0, special case.
    }

    # Raw control sequence, simply save
    dict set def  $name $spec
    dict set char $name $spec
    return
}

# # ## ### ##### ######## ############# #####################

proc ::cmdr::color::Unknown {cmd codes text} {
    list [namespace current]::Apply $codes
}

proc ::cmdr::color::Apply {codes text} {
    debug.cmdr/color {}

    variable active
    if {!$active} {
	debug.cmdr/color {not active}
	return $text
    }

    variable char
    foreach c $codes {
	if {[dict exists $char $c]} {
	    return -code error \
		-errorcode [list CMDR COLOR UNKNOWN $c] \
		"Expected a color name, got \"$c\""
	}
	append r [dict get $char $c]
    }
    append r $text
    append r [dict get $char reset]

    debug.cmdr/color {/done}
    return $r
}

proc ::cmdr::color::S {text} {
    # quote all non-printable characters (< space, > ~)
    variable smap
    return [string map $smap $text]
}

proc ::cmdr::color::C {args} {
    return \033\[[join $args \;]m
}

proc ::cmdr::color::Clamp {x} {
    if {$x < 0} { return 0 }
    if {$x > 5} { return 5 }
    return $x
}

# # ## ### ##### ######## ############# #####################

namespace eval ::cmdr::color {
    # Boolean flag controlling use of color sequences.
    # Default based on tty-ness of stdout. Active if yes.
    variable active [tty stdout]

    # Database (dictionary) of standard colors and associated codes.
    # Based on the standard ANSI colors (16-color terminal). The two
    # dictionaries hold the user-level specification and the
    # full-resolved character sequence.

    variable def  {}
    variable char {}

    # Colors. Foreground/Text.
    define  black        [C 30]  ; # Black  
    define  red          [C 31]  ; # Red    
    define  green        [C 32]  ; # Green  
    define  yellow       [C 33]  ; # Yellow 
    define  blue         [C 34]  ; # Blue   
    define  magenta      [C 35]  ; # Magenta
    define  cyan         [C 36]  ; # Cyan   
    define  white        [C 37]  ; # White  
    define  default      [C 39]  ; # Default (Black)

    # Colors. Background.
    define  bg-black     [C 40]  ; # Black  
    define  bg-red       [C 41]  ; # Red    
    define  bg-green     [C 42]  ; # Green  
    define  bg-yellow    [C 43]  ; # Yellow 
    define  bg-blue      [C 44]  ; # Blue   
    define  bg-magenta   [C 45]  ; # Magenta
    define  bg-cyan      [C 46]  ; # Cyan   
    define  bg-white     [C 47]  ; # White  
    define  bg-default   [C 49]  ; # Default (Transparent)

    # Non-color attributes. Activation.
    define  bold         [C  1]  ; # Bold  
    define  dim          [C  2]  ; # Dim
    define  italic       [C  3]  ; # Italics      
    define  underline    [C  4]  ; # Underscore   
    define  blink        [C  5]  ; # Blink
    define  revers       [C  7]  ; # Reverse      
    define  hidden       [C  8]  ; # Hidden
    define  strike       [C  9]  ; # StrikeThrough

    # Non-color attributes. Deactivation.
    define  no-bold      [C 22]  ; # Bold  
    define  no-dim       [C __]  ; # Dim
    define  no-italic    [C 23]  ; # Italics      
    define  no-underline [C 24]  ; # Underscore   
    define  no-blink     [C 25]  ; # Blink
    define  no-revers    [C 27]  ; # Reverse      
    define  no-hidden    [C 28]  ; # Hidden
    define  no-strike    [C 29]  ; # StrikeThrough

    # Remainder
    define  reset        [C  0]  ; # Reset

    # And now the standard symbolic names

    define  confirm red
    define  error   red
    define  warning yellow
    define  note    blue
    define  good    green
    define  name    blue

    # header command stopped advisory crashed failure success name prompt table warning
    # bl/whi bl/yel  bl/grey bl/yel   bl/red  bl/red  bl/gre  bl/cy bl/cy bl/cy bl/mag
    # stdout - white, stderr - red
    # app-header sys-header
    # bl/yel     bl/cy

    # others ...
    # name	<>	blue,
    # neutral	<>	blue,
    # good	<>	green,
    # bad	<>	red,
    # error	<>	magenta,
    # unknown	<>	cyan,
    # warning	<>	yellow,
    # instance<>	yellow,
    # number	<>	green,
    # prompt	<>	blue,
    # yes	<>	green,
    # no	<>	red

    variable smap {}
}

apply {{} {
    variable smap
    for {set i 0} {$i < 32} {incr i} {
	set c [format %c $i]
	set o \\[format %03o $i] 
	lappend smap $c $o
    }
    lappend smap \127 \\127
}} ::cmdr::color

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::color 0

## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## CMDR - TTY. Convenience command for checking if stdout is a tty.

# @@ Meta Begin
# Package cmdr::tty 0
# Meta author   {Andreas Kupries}
# Meta location https://core.tcl.tk/akupries/cmdr
# Meta platform tcl
# Meta summary     Check if stdout is a TTY.
# Meta description 
# Meta subject {command line} tty
# Meta require {Tcl 8.5-}
# Meta require Tclx
# Meta require debug
# Meta require debug::caller
# @@ Meta End

# # ## ### ##### ######## ############# #####################
## Requisites

package require Tcl 8.5
package require Tclx
package require debug
package require debug::caller

# # ## ### ##### ######## #############

namespace eval ::cmdr {
    namespace export tty
    namespace ensemble create
}

namespace eval ::cmdr::tty {
    namespace export stdout
    namespace ensemble create
}

# # ## ### ##### ######## ############# #####################

debug define cmdr/tty
debug level  cmdr/tty
debug prefix cmdr/tty {[debug caller] | }

# # ## ### ##### ######## #############

if {$::tcl_platform(platform) eq "windows"} {
    proc ::cmdr::tty::stdout {} {
	debug.cmdr/tty {-- windows --}
	return 0
    }
} else {
    proc ::cmdr::tty::stdout {} {
	debug.cmdr/tty {-- unix/osx --}
	fstat stdout tty
    }
}

# # ## ### ##### ######## #############
package provide tty 0