Artifact Content

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.

Artifact b589780615452e4149dcb3c5fcf3c5189a7a4f66:


# -*- tcl -*- Copyright (c) 2012 Andreas Kupries
# # ## ### ##### ######## ############# #####################
## Support for the standard gui recipe.

# # ## ### ##### ######## ############# #####################
## Export (internals - recipe definitions, other utilities)

namespace eval ::kettle::gui {
    namespace export {[a-z]*}
    namespace ensemble create
}

# # ## ### ##### ######## ############# #####################
## State

namespace eval ::kettle::gui {
    variable actions     {}
    variable options     {}

    namespace import ::kettle::io
    namespace import ::kettle::ovalidate
    namespace import ::kettle::option
    namespace import ::kettle::recipe
    namespace import ::kettle::status
}

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

proc ::kettle::gui::make {} {
    package require Tk

    ttk::notebook .n
    ttk::frame  .options
    ttk::frame  .actions
    ttk::button .exit -command ::_exit -text Exit

    .n add .options -text Configuration -underline 0
    .n add .actions -text Action        -underline 0

    pack .n    -side top   -expand 1 -fill both
    pack .exit -side right -expand 0 -fill both

    Options     .options
    Actions     .actions

    .n select 0 ; # Configuration
    #.n select 1 ; # Actions

    # Disable uncontrolled exit. This may come out of deeper layers,
    # like, for example, critcl compilation.

    rename ::exit   ::_exit
    proc   ::exit {{status 0}} {
	apply {{} {
	    io ok { io puts DONE }
	} ::kettle}
	return
    }

    wm protocol . WM_DELETE_WINDOW ::_exit

    # And start to interact with the user.
    vwait forever
    return
}

proc ::kettle::gui::Options {win} {
    set top $win ; if {$top eq {}} { set top . }

    # TODO: Attach the 'ignore-by-gui-flag' to the option itself in
    # some way.
    set ignore {--state --config}

    foreach o [lsort -dict [option names]] {
	if {$o in $ignore} continue
	AddOption $win $o
    }
    return
}

proc ::kettle::gui::AddOption {win o} {
    variable options
    set row [llength $options]

    set top $win ; if {$top eq {}} { set top . }

    set type [option type $o]

    label                  ${win}.l$row -text $o -anchor w
    ovalidate {*}$type gui ${win}.e$row $o

    grid ${win}.l$row  -row $row -column 0 -sticky new
    grid ${win}.e$row  -row $row -column 1 -sticky new

    grid columnconfigure $top 0 -weight 0
    grid columnconfigure $top 1 -weight 1
    grid rowconfigure    $top $row -weight 0

    lappend options ${win}.i$row
    return
}

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

proc ::kettle::gui::Actions {win} {
    set top $win ; if {$top eq {}} { set top . }

    package require widget::scrolledwindow ; # Tklib

    # TODO: Extend recipe definitions to carry this information.
    set special {help help-recipes help-options show show-configuration show-state}
    set ignore  {gui null forever list list-recipes list-options help-dump}

    foreach r $special {
	# treat a few recipes out of order to have them at the top.
	AddActionForRecipe $win $r
    }
    foreach r [lsort -dict [recipe names]] {
	# ignore the standard recipes which are nonsensical for the
	# gui, and those which we treated out of order (see above).
	if {($r in $ignore) || ($r in $special)} continue
	AddActionForRecipe $win $r
    }

    widget::scrolledwindow ${win}.st -borderwidth 1 -relief sunken
    text                   ${win}.t

    ${win}.st setwidget ${win}.t

    set n [NumActions]

    grid ${win}.st -row 0 -column 0 -sticky swen -rowspan $n

    grid columnconfigure $top  0 -weight 1
    grid columnconfigure $top  1 -weight 0
    grid rowconfigure    $top $n -weight 1

    io setwidget ${win}.t
    return
}

# # ## ### ##### ######## ############# #####################
## Internal help.

proc ::kettle::gui::NumActions {} {
    variable actions
    llength $actions
}

proc ::kettle::gui::AddActionForRecipe {win r} {
    AddAction $win [list ::kettle::gui::Run $win $r] [Label $r] 0
}

proc ::kettle::gui::AddAction {win cmd label weight} {
    variable actions
    set row [llength $actions]

    set top $win ; if {$top eq {}} { set top . }

    # ttk::button -> no -anchor option, labels centered.
    button ${win}.i$row -command $cmd -text $label -anchor w
    grid   ${win}.i$row -row $row -column 1 -sticky new
    grid rowconfigure $top $row -weight $weight

    lappend actions ${win}.i$row
    return
}

proc ::kettle::gui::Label {recipe} {
    set result {}
    foreach e [split $recipe -] {
	lappend result [string totitle $e]
    }
    return [join $result { }]
}

proc ::kettle::gui::Run {win recipe} {
    Action disabled

    ${win}.t delete 0.1 end

    recipe run $recipe

    status clear
    Action normal
    return
}

proc ::kettle::gui::Action {e} {
    variable actions
    foreach b $actions {
	$b configure -state $e
    }
    return
}

# # ## ### ##### ######## ############# #####################
return