From 697b999a0f6360e4b797d580fa74f4aba63f99b4 Mon Sep 17 00:00:00 2001 From: Xavier Delaruelle Date: Mon, 18 Oct 2021 07:24:26 +0200 Subject: [PATCH] Introduce 'state' sub-command Add the state sub-command to get all states or one state specified as argument. Code that was previously reporting state for config sub-command has been moved to a dedicated cmdModuleState procedure. state sub-command can only be called from top level and accepts 0 or 1 argument. Closes #426 --- tcl/main.tcl.in | 9 +++-- tcl/report.tcl.in | 1 + tcl/subcmd.tcl.in | 94 +++++++++++++++++++++++++++++++---------------- 3 files changed, 70 insertions(+), 34 deletions(-) diff --git a/tcl/main.tcl.in b/tcl/main.tcl.in index 2a2d0f99..b1c3ce70 100644 --- a/tcl/main.tcl.in +++ b/tcl/main.tcl.in @@ -149,7 +149,7 @@ proc parseModuleCommandName {command defaultcmd} { restore saverm saveshow savelist initadd initprepend initswitch initrm\ initlist initclear autoinit clear config help test prepend-path\ append-path remove-path is-loaded is-saved is-used is-avail info-loaded\ - sh-to-mod edit try-load refresh]}] + sh-to-mod edit try-load refresh state]}] return [list $command $cmdvalid $cmdempty] } @@ -376,7 +376,7 @@ proc module {command args} { switch -- $command { path - paths - autoinit - help - prepend-path - append-path -\ remove-path - is-loaded - is-saved - is-used - is-avail -\ - info-loaded - clear - sh-to-mod - edit - refresh - source { + info-loaded - clear - sh-to-mod - edit - refresh - source - state { knerror "${msgprefix}Command '$command' not supported$tryhelpmsg" } } @@ -416,7 +416,7 @@ proc module {command args} { set argnberr 1 } } - search - save - restore - saverm - saveshow - clear { + search - save - restore - saverm - saveshow - clear - state { if {[llength $args] > 1} { set argnberr 1 } @@ -697,6 +697,9 @@ proc module {command args} { config { cmdModuleConfig $dump_state {*}$args } + state { + cmdModuleState {*}$args + } sh-to-mod { cmdModuleShToMod {*}$args } diff --git a/tcl/report.tcl.in b/tcl/report.tcl.in index 199a3255..99edbb4c 100644 --- a/tcl/report.tcl.in +++ b/tcl/report.tcl.in @@ -1654,6 +1654,7 @@ Other commands: clear [-f] Reset Modules-specific runtime information source scriptfile [...] Execute scriptfile(s) config [--dump-state|name [val]] Display or set Modules configuration + state [name] Display Modules state sh-to-mod shell shellscript [arg ...] Make modulefile from script env changes edit modulefile Open modulefile in editor diff --git a/tcl/subcmd.tcl.in b/tcl/subcmd.tcl.in index ac7b612b..19cadd8b 100644 --- a/tcl/subcmd.tcl.in +++ b/tcl/subcmd.tcl.in @@ -1983,6 +1983,68 @@ proc cmdModuleClear {doit doitset} { } } +proc cmdModuleState {args} { + if {[llength $args] > 0} { + set name [lindex $args 0] + } + + if {[info exists name] && $name ni [concat [array names ::g_state_defs]\ + [array names ::g_states]]} { + knerror "State '$name' does not exist" + } + + # report module version unless if called by cmdModuleConfig + if {[lindex [info level -1] 0] ne {cmdModuleConfig}} { + reportVersion + reportSeparateNextContent + } + + displayTableHeader hi {State name} 24 {Value} 54 + + # fetch specified state or all states + if {[info exists name]} { + if {$name in [array names ::g_state_defs]} { + set stateval($name) [getState $name 1] + } else { + set stateval($name) [getState $name] + } + } else { + # define each attribute/fetched state value pair + foreach state [array names ::g_state_defs] { + set stateval($state) [getState $state 1] + } + # also get dynamic states (with no prior definition) + foreach state [array names ::g_states] { + if {![info exists stateval($state)]} { + set stateval($state) [getState $state] + } + } + } + + foreach state [lsort [array names stateval]] { + append displist [format {%-25s %s} $state $stateval($state)] \n + } + report $displist 1 + reportSeparateNextContent + + # only report specified state if any + if {[info exists name]} { + return + } + + # report environment variable set related to Modules + displayTableHeader hi {Env. variable} 24 {Value} 54 + set envvar_list {} + foreach var [list LOADEDMODULES _LMFILES_ MODULE* __MODULES_* *_module*] { + lappend envvar_list {*}[array names ::env -glob $var] + } + unset displist + foreach var [lsort -unique $envvar_list] { + append displist [format {%-25s %s} $var $::env($var)] \n + } + report $displist 1 +} + proc cmdModuleConfig {dump_state args} { # parse arguments set nameunset 0 @@ -2113,37 +2175,7 @@ proc cmdModuleConfig {dump_state args} { reportSeparateNextContent if {$dump_state} { - displayTableHeader hi {State name} 24 {Value} 54 - # define each attribute/fetched state value pair - foreach state [array names ::g_state_defs] { - set stateval($state) [getState $state 1] - } - # also get dynamic states (with no prior definition) - foreach state [array names ::g_states] { - if {![info exists stateval($state)]} { - set stateval($state) [getState $state] - } - } - - unset displist - foreach state [lsort [array names stateval]] { - append displist [format {%-25s %s} $state $stateval($state)] \n - } - report $displist 1 - reportSeparateNextContent - - # report environment variable set related to Modules - displayTableHeader hi {Env. variable} 24 {Value} 54 - set envvar_list {} - foreach var [list LOADEDMODULES _LMFILES_ MODULE* __MODULES_*\ - *_module*] { - lappend envvar_list {*}[array names ::env -glob $var] - } - unset displist - foreach var [lsort -unique $envvar_list] { - append displist [format {%-25s %s} $var $::env($var)] \n - } - report $displist 1 + cmdModuleState } } }