package provides for the dynamic modification of a user’s environment via modulefiles.
| mfinterp.tcl.in (modules-5.1.1.tar.bz2) | : | mfinterp.tcl.in (modules-5.2.0.tar.bz2) |
|---|
| | |
| skipping to change at line 36 | | skipping to change at line 36 |
|---|
| | |
| # dummy proc to disable modulefile commands on some evaluation modes | | # dummy proc to disable modulefile commands on some evaluation modes |
| proc nop {args} {} | | proc nop {args} {} |
| | |
| # dummy proc for commands available on other Modules flavor but not here | | # dummy proc for commands available on other Modules flavor but not here |
| proc nimp {cmd args} { | | proc nimp {cmd args} { |
| reportWarning "'$cmd' command not implemented" | | reportWarning "'$cmd' command not implemented" |
| } | | } |
| | |
| # Get identifier name of current Tcl modulefile interpreter. An interp is | | # Get identifier name of current Tcl modulefile interpreter. An interp is |
|
| # dedicated to each mode/depth level of modulefile interpretation | | # dedicated to each mode/auto_handling option value/depth level of modulefile |
| | # interpretation |
| proc getCurrentModfileInterpName {} { | | proc getCurrentModfileInterpName {} { |
|
| return __modfile_[currentState mode]_[depthState modulename] | | return __modfile_[currentState mode]_[getConf auto_handling]_[depthState\ |
| | modulename] |
| } | | } |
| | |
| # synchronize environment variable change over all started sub interpreters | | # synchronize environment variable change over all started sub interpreters |
| proc interp-sync-env {op var {val {}}} { | | proc interp-sync-env {op var {val {}}} { |
| set envvar ::env($var) | | set envvar ::env($var) |
|
| | ##nagelfar vartype envvar varName |
| | |
| # apply operation to main interpreter | | # apply operation to main interpreter |
| switch -- $op { | | switch -- $op { |
| set { set $envvar $val } | | set { set $envvar $val } |
| unset { unset $envvar } | | unset { unset $envvar } |
| } | | } |
| | |
| # apply operation to each sub-interpreters if not found autosynced | | # apply operation to each sub-interpreters if not found autosynced |
| if {[llength [interp slaves]] > 0} { | | if {[llength [interp slaves]] > 0} { |
| reportDebug "$op var='$envvar', val='$val' on interp(s) [interp slaves]" | | reportDebug "$op var='$envvar', val='$val' on interp(s) [interp slaves]" |
| | |
| skipping to change at line 77 | | skipping to change at line 80 |
|---|
| if {[interp eval $itrp [list info exists $envvar]]} { | | if {[interp eval $itrp [list info exists $envvar]]} { |
| interp eval $itrp [list unset $envvar] | | interp eval $itrp [list unset $envvar] |
| } | | } |
| } | | } |
| } | | } |
| } | | } |
| } | | } |
| } | | } |
| | |
| # Initialize list of interp alias commands to define for given evaluation mode | | # Initialize list of interp alias commands to define for given evaluation mode |
|
| proc initModfileModeAliases {mode aliasesVN aliasesPassArgVN tracesVN} { | | # and auto_handling enablement |
| | proc initModfileModeAliases {mode auto aliasesVN aliasesPassArgVN\ |
| | tracesVN} { |
| global g_modfilePerModeAliases | | global g_modfilePerModeAliases |
| upvar #0 $aliasesVN aliases | | upvar #0 $aliasesVN aliases |
| upvar #0 $aliasesPassArgVN aliasesPassArg | | upvar #0 $aliasesPassArgVN aliasesPassArg |
| upvar #0 $tracesVN traces | | upvar #0 $tracesVN traces |
| | |
| if {![info exists g_modfilePerModeAliases]} { | | if {![info exists g_modfilePerModeAliases]} { |
| set ::g_modfileBaseAliases [list versioncmp versioncmp getenv getenv\ | | set ::g_modfileBaseAliases [list versioncmp versioncmp getenv getenv\ |
| getvariant getvariant is-loaded is-loaded is-saved is-saved is-used\ | | getvariant getvariant is-loaded is-loaded is-saved is-saved is-used\ |
| is-used is-avail is-avail uname uname module-info module-info exit\ | | is-used is-avail is-avail uname uname module-info module-info exit\ |
| exitModfileCmd reportCmdTrace reportCmdTrace reportInternalBug\ | | exitModfileCmd reportCmdTrace reportCmdTrace reportInternalBug\ |
| reportInternalBug reportWarning reportWarning reportError\ | | reportInternalBug reportWarning reportWarning reportError\ |
| reportError raiseErrorCount raiseErrorCount report report\ | | reportError raiseErrorCount raiseErrorCount report report\ |
| isVerbosityLevel isVerbosityLevel isWin initStateIsWin puts\ | | isVerbosityLevel isVerbosityLevel isWin initStateIsWin puts\ |
| putsModfileCmd readModuleContent readModuleContent\ | | putsModfileCmd readModuleContent readModuleContent\ |
| formatErrStackTrace formatErrStackTrace] | | formatErrStackTrace formatErrStackTrace] |
| | |
| # list of alias commands whose target procedure is adapted according to | | # list of alias commands whose target procedure is adapted according to |
| # the evaluation mode | | # the evaluation mode |
| set ::g_modfileEvalModes {load unload display help test whatis refresh} | | set ::g_modfileEvalModes {load unload display help test whatis refresh} |
|
| | ##nagelfar ignore #41 Too long line |
| array set g_modfilePerModeAliases { | | array set g_modfilePerModeAliases { |
| add-property {nop nop nop nop nop
nop nop } | | add-property {nop nop nop nop nop
nop nop } |
| always-load {always-load nop reportCmd nop nop
nop nop } | | always-load {always-load nop reportCmd nop nop
nop nop } |
| append-path {append-path append-path-un append-path append-path appe
nd-path edit-path-wh nop } | | append-path {append-path append-path-un append-path append-path appe
nd-path edit-path-wh nop } |
| chdir {chdir nop reportCmd nop nop
nop nop } | | chdir {chdir nop reportCmd nop nop
nop nop } |
| complete {complete complete-un reportCmd nop nop
nop complete } | | complete {complete complete-un reportCmd nop nop
nop complete } |
| conflict {conflict nop reportCmd nop nop
nop nop } | | conflict {conflict nop reportCmd nop nop
nop nop } |
|
| depends-on {prereq-all nop reportCmd nop nop
nop nop } | | depends-on {prereqAllModfileCmd nop reportCmd nop nop
nop nop } |
| extensions {nop nop nop nop nop
nop nop } | | extensions {nop nop nop nop nop
nop nop } |
| family {family family-un reportCmd nop nop
nop nop } | | family {family family-un reportCmd nop nop
nop nop } |
| module {module module reportCmd nop nop
nop nop } | | module {module module reportCmd nop nop
nop nop } |
| module-alias {module-alias module-alias module-alias module-alias modu
le-alias module-alias nop } | | module-alias {module-alias module-alias module-alias module-alias modu
le-alias module-alias nop } |
| module-log {nimp nimp reportCmd nop nop
nop nop } | | module-log {nimp nimp reportCmd nop nop
nop nop } |
| module-trace {nimp nimp reportCmd nop nop
nop nop } | | module-trace {nimp nimp reportCmd nop nop
nop nop } |
| module-user {nimp nimp reportCmd nop nop
nop nop } | | module-user {nimp nimp reportCmd nop nop
nop nop } |
| module-verbosity {nimp nimp reportCmd nop nop
nop nop } | | module-verbosity {nimp nimp reportCmd nop nop
nop nop } |
| module-version {module-version module-version module-version module-version modu
le-version module-version nop } | | module-version {module-version module-version module-version module-version modu
le-version module-version nop } |
| module-virtual {module-virtual module-virtual module-virtual module-virtual modu
le-virtual module-virtual nop } | | module-virtual {module-virtual module-virtual module-virtual module-virtual modu
le-virtual module-virtual nop } |
| module-forbid {module-forbid module-forbid module-forbid module-forbid modu
le-forbid module-forbid nop } | | module-forbid {module-forbid module-forbid module-forbid module-forbid modu
le-forbid module-forbid nop } |
| module-hide {module-hide module-hide module-hide module-hide modu
le-hide module-hide nop } | | module-hide {module-hide module-hide module-hide module-hide modu
le-hide module-hide nop } |
| module-tag {module-tag module-tag module-tag module-tag modu
le-tag module-tag nop } | | module-tag {module-tag module-tag module-tag module-tag modu
le-tag module-tag nop } |
| module-whatis {nop nop reportCmd nop nop
module-whatis nop } | | module-whatis {nop nop reportCmd nop nop
module-whatis nop } |
| prepend-path {prepend-path prepend-path-un prepend-path prepend-path prep
end-path edit-path-wh nop } | | prepend-path {prepend-path prepend-path-un prepend-path prepend-path prep
end-path edit-path-wh nop } |
|
| prereq-all {prereq-all nop reportCmd nop nop | | prereq-all {prereqAllModfileCmd nop reportCmd nop nop |
| nop nop } | | nop nop } |
| prereq-any {prereq nop reportCmd nop nop | | prereq-any {prereqAnyModfileCmd nop reportCmd nop nop |
| nop nop } | | nop nop } |
| prereq {prereq nop reportCmd nop nop | | prereq {prereqAnyModfileCmd nop reportCmd nop nop |
| nop nop } | | nop nop } |
| pushenv {pushenv pushenv-un pushenv pushenv push
env pushenv-wh nop } | | pushenv {pushenv pushenv-un pushenv pushenv push
env pushenv-wh nop } |
| remove-path {remove-path remove-path-un remove-path remove-path remo
ve-path edit-path-wh nop } | | remove-path {remove-path remove-path-un remove-path remove-path remo
ve-path edit-path-wh nop } |
| remove-property {nop nop nop nop nop
nop nop } | | remove-property {nop nop nop nop nop
nop nop } |
| require-fullname {require-fullname nop reportCmd nop nop
nop nop } | | require-fullname {require-fullname nop reportCmd nop nop
nop nop } |
| set-alias {set-alias set-alias-un reportCmd nop nop
nop set-alias } | | set-alias {set-alias set-alias-un reportCmd nop nop
nop set-alias } |
| set-function {set-function set-function-un reportCmd nop nop
nop set-function} | | set-function {set-function set-function-un reportCmd nop nop
nop set-function} |
| setenv {setenv setenv-un setenv setenv sete
nv setenv-wh nop } | | setenv {setenv setenv-un setenv setenv sete
nv setenv-wh nop } |
| source-sh {source-sh source-sh-un source-sh-di nop nop
nop source-sh } | | source-sh {source-sh source-sh-un source-sh-di nop nop
nop source-sh } |
| system {system system reportCmd nop nop
nop nop } | | system {system system reportCmd nop nop
nop nop } |
| uncomplete {uncomplete nop reportCmd nop nop
nop nop } | | uncomplete {uncomplete nop reportCmd nop nop
nop nop } |
| unset-alias {unset-alias nop reportCmd nop nop
nop nop } | | unset-alias {unset-alias nop reportCmd nop nop
nop nop } |
| unset-function {unset-function nop reportCmd nop nop
nop nop } | | unset-function {unset-function nop reportCmd nop nop
nop nop } |
| unsetenv {unsetenv unsetenv-un unsetenv unsetenv unse
tenv unsetenv-wh nop } | | unsetenv {unsetenv unsetenv-un unsetenv unsetenv unse
tenv unsetenv-wh nop } |
| variant {variant variant variant variant vari
ant variant-wh variant } | | variant {variant variant variant variant vari
ant variant-wh variant } |
| x-resource {x-resource x-resource reportCmd nop nop
nop nop } | | x-resource {x-resource x-resource reportCmd nop nop
nop nop } |
| } | | } |
| } | | } |
| | |
| # alias commands where interpreter ref should be passed as argument | | # alias commands where interpreter ref should be passed as argument |
|
| array set aliasesPassArg [list getvariant __itrp__ puts __itrp__ variant\ | | array set aliasesPassArg [list getvariant [list __itrp__] puts [list\ |
| __itrp__] | | __itrp__] variant [list __itrp__]] |
| | |
| # initialize list with all commands not dependent of the evaluation mode | | # initialize list with all commands not dependent of the evaluation mode |
| array set aliases $::g_modfileBaseAliases | | array set aliases $::g_modfileBaseAliases |
| | |
|
| | # add site-specific command aliases for modulefile interp |
| | if {[info exists ::modulefile_extra_cmds]} { |
| | if {[catch {array set aliases $::modulefile_extra_cmds} errorMsg]} { |
| | knerror "Invalid value '$::modulefile_extra_cmds' ($errorMsg)\nfor\ |
| | siteconfig variable 'modulefile_extra_cmds'" |
| | } |
| | } |
| | |
| # add alias commands whose target command vary depending on the eval mode | | # add alias commands whose target command vary depending on the eval mode |
| set modeidx [lsearch -exact $::g_modfileEvalModes $mode] | | set modeidx [lsearch -exact $::g_modfileEvalModes $mode] |
| foreach alias [array names g_modfilePerModeAliases] { | | foreach alias [array names g_modfilePerModeAliases] { |
| set aliastarget [set aliases($alias) [lindex\ | | set aliastarget [set aliases($alias) [lindex\ |
| $g_modfilePerModeAliases($alias) $modeidx]] | | $g_modfilePerModeAliases($alias) $modeidx]] |
| # some target procedures need command name as first arg | | # some target procedures need command name as first arg |
| if {$aliastarget in {reportCmd nimp edit-path-wh}} { | | if {$aliastarget in {reportCmd nimp edit-path-wh}} { |
|
| set aliasesPassArg($alias) $alias | | set aliasesPassArg($alias) [list $alias] |
| | # prereq commands need auto_handling state as first arg |
| | } elseif {$mode eq {load} && $alias in {prereq prereq-any prereq-all\ |
| | depends-on}} { |
| | set aliasesPassArg($alias) [list 0 $auto] |
| # associate a trace command if per-mode alias command is not reportCmd | | # associate a trace command if per-mode alias command is not reportCmd |
| # in display mode (except for source-sh) | | # in display mode (except for source-sh) |
| } elseif {$mode eq {display} && $alias ne {source-sh}} { | | } elseif {$mode eq {display} && $alias ne {source-sh}} { |
| set traces($alias) reportCmdTrace | | set traces($alias) reportCmdTrace |
| } | | } |
| } | | } |
| } | | } |
| | |
| proc execute-modulefile {modfile modname modnamevrvar modspec {up_namevr 1}\ | | proc execute-modulefile {modfile modname modnamevrvar modspec {up_namevr 1}\ |
| {fetch_tags 1}} { | | {fetch_tags 1}} { |
| | |
| skipping to change at line 213 | | skipping to change at line 231 |
|---|
| if {[isModuleTagged $modname super-sticky 1] && [currentState\ | | if {[isModuleTagged $modname super-sticky 1] && [currentState\ |
| reloading_supersticky] ne $modname} { | | reloading_supersticky] ne $modname} { |
| # restore changed states prior raising error | | # restore changed states prior raising error |
| lpopState debug_msg_prefix | | lpopState debug_msg_prefix |
| lpopState specifiedname | | lpopState specifiedname |
| lpopState modulename | | lpopState modulename |
| lpopState modulenamevr | | lpopState modulenamevr |
| lpopState modulefile | | lpopState modulefile |
| knerror [getStickyUnloadMsg super-sticky] | | knerror [getStickyUnloadMsg super-sticky] |
| } elseif {[isModuleTagged $modname sticky 1] && [currentState\ | | } elseif {[isModuleTagged $modname sticky 1] && [currentState\ |
|
| reloading_sticky] ne $modname} { | | reloading_sticky] ne $modname && [currentState unloading_sticky] ne\ |
| | $modname} { |
| if {[getState force]} { | | if {[getState force]} { |
| reportWarning [getStickyForcedUnloadMsg] | | reportWarning [getStickyForcedUnloadMsg] |
| } else { | | } else { |
| # restore changed states prior raising error | | # restore changed states prior raising error |
| lpopState debug_msg_prefix | | lpopState debug_msg_prefix |
| lpopState specifiedname | | lpopState specifiedname |
| lpopState modulename | | lpopState modulename |
| lpopState modulenamevr | | lpopState modulenamevr |
| lpopState modulefile | | lpopState modulefile |
| knerror [getStickyUnloadMsg] | | knerror [getStickyUnloadMsg] |
| | |
| skipping to change at line 241 | | skipping to change at line 260 |
|---|
| modcontent 1 env 1] | | modcontent 1 env 1] |
| | |
| # commands that should be renamed before aliases setup | | # commands that should be renamed before aliases setup |
| array set ::g_modfileRenameCmds [list puts _puts] | | array set ::g_modfileRenameCmds [list puts _puts] |
| } | | } |
| # dedicate an interpreter per mode and per level of interpretation to have | | # dedicate an interpreter per mode and per level of interpretation to have |
| # a dedicated interpreter in case of cascaded multi-mode interpretations | | # a dedicated interpreter in case of cascaded multi-mode interpretations |
| set itrp [getCurrentModfileInterpName] | | set itrp [getCurrentModfileInterpName] |
| | |
| # evaluation mode-specific configuration | | # evaluation mode-specific configuration |
|
| set dumpCommandsVN g_modfile${mode}Commands | | set autosuf [expr {[getConf auto_handling] ? {AH} : {}}] |
| set aliasesVN g_modfile${mode}Aliases | | set dumpCommandsVN g_modfile${mode}${autosuf}Commands |
| set aliasesPassArgVN g_modfile${mode}AliasesPassArg | | set aliasesVN g_modfile${mode}${autosuf}Aliases |
| set tracesVN g_modfile${mode}Traces | | set aliasesPassArgVN g_modfile${mode}${autosuf}AliasesPassArg |
| | set tracesVN g_modfile${mode}${autosuf}Traces |
| | ##nagelfar ignore Suspicious variable name |
| if {![info exists ::$aliasesVN]} { | | if {![info exists ::$aliasesVN]} { |
|
| initModfileModeAliases $mode $aliasesVN $aliasesPassArgVN $tracesVN | | ##nagelfar vartype aliasesVN varName |
| | ##nagelfar vartype aliasesPassArgVN varName |
| | ##nagelfar vartype tracesVN varName |
| | initModfileModeAliases $mode [getConf auto_handling] $aliasesVN\ |
| | $aliasesPassArgVN $tracesVN |
| | } |
| | |
| | # variable to define in modulefile interp |
| | if {![info exists ::g_modfileBaseVars]} { |
| | # record module tool properties |
| | set ::g_modfileBaseVars [list ModuleTool Modules ModuleToolVersion\ |
| | {@MODULES_RELEASE@}] |
| | |
| | if {[info exists ::modulefile_extra_vars]} { |
| | if {([llength $::modulefile_extra_vars] % 2) != 0} { |
| | knerror "Invalid value '$::modulefile_extra_vars' (list must have\ |
| | an even number of elements)\nfor siteconfig variable\ |
| | 'modulefile_extra_vars'" |
| | } |
| | foreach {var val} $::modulefile_extra_vars { |
| | if {[string first { } $var] != -1} { |
| | knerror "Invalid variable name '$var'\ndefined in siteconfig\ |
| | variable 'modulefile_extra_vars'" |
| | } |
| | } |
| | lappend ::g_modfileBaseVars {*}$::modulefile_extra_vars |
| | } |
| } | | } |
| | |
| # create modulefile interpreter at first interpretation | | # create modulefile interpreter at first interpretation |
| if {![interp exists $itrp]} { | | if {![interp exists $itrp]} { |
| reportDebug "creating interp $itrp" | | reportDebug "creating interp $itrp" |
| interp create $itrp | | interp create $itrp |
| | |
|
| # record module tool properties | | # initialize global static variables for modulefile interp |
| interp eval $itrp set ::ModuleTool Modules | | foreach {var val} $::g_modfileBaseVars { |
| interp eval $itrp set ::ModuleToolVersion {@MODULES_RELEASE@} | | interp eval $itrp set ::$var "{$val}" |
| | } |
| | |
| # dump initial interpreter state to restore it before each modulefile | | # dump initial interpreter state to restore it before each modulefile |
| # interpretation. use same dump state for all modes/levels | | # interpretation. use same dump state for all modes/levels |
| if {![info exists ::g_modfileVars]} { | | if {![info exists ::g_modfileVars]} { |
| dumpInterpState $itrp g_modfileVars g_modfileArrayVars\ | | dumpInterpState $itrp g_modfileVars g_modfileArrayVars\ |
| g_modfileUntrackVars g_modfileProcs | | g_modfileUntrackVars g_modfileProcs |
| } | | } |
| | |
| # interp has just been created | | # interp has just been created |
| set fresh 1 | | set fresh 1 |
| | |
| skipping to change at line 281 | | skipping to change at line 329 |
|---|
| # reset interp state command before each interpretation | | # reset interp state command before each interpretation |
| resetInterpState $itrp $fresh g_modfileVars g_modfileArrayVars\ | | resetInterpState $itrp $fresh g_modfileVars g_modfileArrayVars\ |
| g_modfileUntrackVars g_modfileProcs $aliasesVN $aliasesPassArgVN\ | | g_modfileUntrackVars g_modfileProcs $aliasesVN $aliasesPassArgVN\ |
| $tracesVN g_modfileRenameCmds $dumpCommandsVN | | $tracesVN g_modfileRenameCmds $dumpCommandsVN |
| | |
| # reset modulefile-specific variable before each interpretation | | # reset modulefile-specific variable before each interpretation |
| interp eval $itrp set ::ModulesCurrentModulefile "{$modfile}" | | interp eval $itrp set ::ModulesCurrentModulefile "{$modfile}" |
| interp eval $itrp set vrspeclist "{[getVariantListFromVersSpec\ | | interp eval $itrp set vrspeclist "{[getVariantListFromVersSpec\ |
| $modnamevr]}" | | $modnamevr]}" |
| | |
|
| | ##nagelfar ignore +7 Suspicious # char |
| set errorVal [interp eval $itrp { | | set errorVal [interp eval $itrp { |
| set modcontent [readModuleContent $::ModulesCurrentModulefile 1] | | set modcontent [readModuleContent $::ModulesCurrentModulefile 1] |
| if {$modcontent eq {}} { | | if {$modcontent eq {}} { |
| return 1 | | return 1 |
| } | | } |
| info script $::ModulesCurrentModulefile | | info script $::ModulesCurrentModulefile |
| # eval then call for specific proc depending mode under same catch | | # eval then call for specific proc depending mode under same catch |
| set sourceFailed [catch { | | set sourceFailed [catch { |
| eval $modcontent | | eval $modcontent |
| | |
| | |
| skipping to change at line 446 | | skipping to change at line 495 |
|---|
| # list interpreter alias commands to define | | # list interpreter alias commands to define |
| array set ::g_modrcAliases [list uname uname system system versioncmp\ | | array set ::g_modrcAliases [list uname uname system system versioncmp\ |
| versioncmp is-loaded is-loaded is-used is-used module-version\ | | versioncmp is-loaded is-loaded is-used is-used module-version\ |
| module-version module-alias module-alias module-virtual\ | | module-version module-alias module-alias module-virtual\ |
| module-virtual module-forbid module-forbid module-hide module-hide\ | | module-virtual module-forbid module-forbid module-hide module-hide\ |
| module-tag module-tag module-info module-info\ | | module-tag module-tag module-info module-info\ |
| reportInternalBug reportInternalBug setModulesVersion\ | | reportInternalBug reportInternalBug setModulesVersion\ |
| setModulesVersion readModuleContent readModuleContent\ | | setModulesVersion readModuleContent readModuleContent\ |
| formatErrStackTrace formatErrStackTrace] | | formatErrStackTrace formatErrStackTrace] |
| | |
|
| | # add site-specific command aliases for modulerc interp |
| | if {[info exists ::modulerc_extra_cmds]} { |
| | if {[catch {array set ::g_modrcAliases $::modulerc_extra_cmds}\ |
| | errorMsg]} { |
| | knerror "Invalid value '$::modulerc_extra_cmds' ($errorMsg)\nfor\ |
| | siteconfig variable 'modulerc_extra_cmds'" |
| | } |
| | } |
| | |
| # alias commands where an argument should be passed | | # alias commands where an argument should be passed |
| array set ::g_modrcAliasesPassArg [list] | | array set ::g_modrcAliasesPassArg [list] |
| | |
| # trace commands that should be associated to aliases | | # trace commands that should be associated to aliases |
| array set ::g_modrcAliasesTraces [list] | | array set ::g_modrcAliasesTraces [list] |
|
| | |
| | # variable to define in modulerc interp |
| | set ::g_modrcBaseVars [list ModuleTool Modules ModuleToolVersion\ |
| | {@MODULES_RELEASE@}] |
| | |
| | if {[info exists ::modulerc_extra_vars]} { |
| | if {([llength $::modulerc_extra_vars] % 2) != 0} { |
| | knerror "Invalid value '$::modulerc_extra_vars' (list must have\ |
| | an even number of elements)\nfor siteconfig variable\ |
| | 'modulerc_extra_vars'" |
| | } |
| | foreach {var val} $::modulerc_extra_vars { |
| | if {[string first { } $var] != -1} { |
| | knerror "Invalid variable name '$var'\ndefined in siteconfig\ |
| | variable 'modulerc_extra_vars'" |
| | } |
| | } |
| | lappend ::g_modrcBaseVars {*}$::modulerc_extra_vars |
| | } |
| } | | } |
| | |
| # dedicate an interpreter per level of interpretation to have in case of | | # dedicate an interpreter per level of interpretation to have in case of |
| # cascaded interpretations a specific interpreter per level | | # cascaded interpretations a specific interpreter per level |
| set itrp __modrc_[depthState modulename] | | set itrp __modrc_[depthState modulename] |
| | |
| reportTrace '$modfile' {Evaluate modulerc} | | reportTrace '$modfile' {Evaluate modulerc} |
| # create modulerc interpreter at first interpretation | | # create modulerc interpreter at first interpretation |
| if {![interp exists $itrp]} { | | if {![interp exists $itrp]} { |
| reportDebug "creating interp $itrp" | | reportDebug "creating interp $itrp" |
| interp create $itrp | | interp create $itrp |
| | |
|
| # record module tool properties | | # initialize global static variables for modulerc interp |
| interp eval $itrp set ::ModuleTool Modules | | foreach {var val} $::g_modrcBaseVars { |
| interp eval $itrp set ::ModuleToolVersion {@MODULES_RELEASE@} | | interp eval $itrp set ::$var "{$val}" |
| | } |
| | |
| # dump initial interpreter state to restore it before each modulerc | | # dump initial interpreter state to restore it before each modulerc |
| # interpretation. use same dump state for all levels | | # interpretation. use same dump state for all levels |
| if {![info exists ::g_modrcVars]} { | | if {![info exists ::g_modrcVars]} { |
| dumpInterpState $itrp g_modrcVars g_modrcArrayVars\ | | dumpInterpState $itrp g_modrcVars g_modrcArrayVars\ |
| g_modrcUntrackVars g_modrcProcs | | g_modrcUntrackVars g_modrcProcs |
| } | | } |
| | |
| # interp has just been created | | # interp has just been created |
| set fresh 1 | | set fresh 1 |
| | |
| skipping to change at line 490 | | skipping to change at line 568 |
|---|
| # reset interp state command before each interpretation | | # reset interp state command before each interpretation |
| resetInterpState $itrp $fresh g_modrcVars g_modrcArrayVars\ | | resetInterpState $itrp $fresh g_modrcVars g_modrcArrayVars\ |
| g_modrcUntrackVars g_modrcProcs g_modrcAliases g_modrcAliasesPassArg\ | | g_modrcUntrackVars g_modrcProcs g_modrcAliases g_modrcAliasesPassArg\ |
| g_modrcAliasesTraces g_modrcRenameCmds g_modrcCommands | | g_modrcAliasesTraces g_modrcRenameCmds g_modrcCommands |
| | |
| interp eval $itrp set ::ModulesCurrentModulefile "{$modfile}" | | interp eval $itrp set ::ModulesCurrentModulefile "{$modfile}" |
| interp eval $itrp {set ::ModulesVersion {}} | | interp eval $itrp {set ::ModulesVersion {}} |
| # create an alias ModuleVersion on ModulesVersion | | # create an alias ModuleVersion on ModulesVersion |
| interp eval $itrp {upvar 0 ::ModulesVersion ::ModuleVersion} | | interp eval $itrp {upvar 0 ::ModulesVersion ::ModuleVersion} |
| | |
|
| | ##nagelfar ignore +4 Suspicious # char |
| set errorVal [interp eval $itrp { | | set errorVal [interp eval $itrp { |
| set modcontent [readModuleContent $::ModulesCurrentModulefile] | | set modcontent [readModuleContent $::ModulesCurrentModulefile] |
| if {$modcontent eq {}} { | | if {$modcontent eq {}} { |
| # simply skip rc file, no exit on error here | | # simply skip rc file, no exit on error here |
| return 1 | | return 1 |
| } | | } |
| info script $::ModulesCurrentModulefile | | info script $::ModulesCurrentModulefile |
| if [catch {eval $modcontent} errorMsg] { | | if [catch {eval $modcontent} errorMsg] { |
| # format stack trace to report modulerc information only | | # format stack trace to report modulerc information only |
| reportInternalBug [formatErrStackTrace $::errorInfo\ | | reportInternalBug [formatErrStackTrace $::errorInfo\ |
| | |
| skipping to change at line 585 | | skipping to change at line 664 |
|---|
| if {$fresh} { | | if {$fresh} { |
| foreach cmd [array names renameCmds] { | | foreach cmd [array names renameCmds] { |
| $itrp eval rename $cmd $renameCmds($cmd) | | $itrp eval rename $cmd $renameCmds($cmd) |
| } | | } |
| } | | } |
| | |
| # set interpreter alias commands each time to guaranty them being | | # set interpreter alias commands each time to guaranty them being |
| # defined and not overridden by modulefile or modulerc content | | # defined and not overridden by modulefile or modulerc content |
| foreach alias [array names aliases] { | | foreach alias [array names aliases] { |
| if {[info exists aliasesPassArg($alias)]} { | | if {[info exists aliasesPassArg($alias)]} { |
|
| set aliasarg $aliasesPassArg($alias) | | set aliasargs $aliasesPassArg($alias) |
| # pass current itrp reference on special keyword | | # pass current itrp reference on special keyword |
|
| if {$aliasarg eq {__itrp__}} { | | if {[lindex $aliasargs 0] eq {__itrp__}} { |
| set aliasarg $itrp | | lset aliasargs 0 $itrp |
| } | | } |
|
| interp alias $itrp $alias {} $aliases($alias) $aliasarg | | interp alias $itrp $alias {} $aliases($alias) {*}$aliasargs |
| } else { | | } else { |
| interp alias $itrp $alias {} $aliases($alias) | | interp alias $itrp $alias {} $aliases($alias) |
| } | | } |
| } | | } |
| | |
| if {$fresh} { | | if {$fresh} { |
|
| # trace each modulefile command call if verbosity is set to debug | | # trace each modulefile command call if verbosity is set to debug (when |
| # (when higher verbosity level is set all cmds are already traced) | | # higher verbosity level is set all cmds are already traced) and timer |
| if {[getConf verbosity] eq {debug}} { | | # mode is disabled |
| | if {[getConf verbosity] eq {debug} && ![getState timer]} { |
| interp alias $itrp reportTraceExecEnter {} reportTraceExecEnter | | interp alias $itrp reportTraceExecEnter {} reportTraceExecEnter |
| foreach alias [array names aliases] { | | foreach alias [array names aliases] { |
| # exclude internal commands expoxed to modulerc/file interpreter | | # exclude internal commands expoxed to modulerc/file interpreter |
| if {$alias ni {report reportDebug reportError reportWarning\ | | if {$alias ni {report reportDebug reportError reportWarning\ |
| reportCmdTrace raiseErrorCount reportInternalBug\ | | reportCmdTrace raiseErrorCount reportInternalBug\ |
| formatErrStackTrace isVerbosityLevel}} { | | formatErrStackTrace isVerbosityLevel}} { |
| interp eval $itrp [list trace add execution $alias enter\ | | interp eval $itrp [list trace add execution $alias enter\ |
| reportTraceExecEnter] | | reportTraceExecEnter] |
| } | | } |
| } | | } |
| | |
| skipping to change at line 642 | | skipping to change at line 722 |
|---|
| # initial state list. do not check if they have been altered as no vital | | # initial state list. do not check if they have been altered as no vital |
| # procedures lied there. note that if a Tcl command has been overridden | | # procedures lied there. note that if a Tcl command has been overridden |
| # by a proc, it will be removed here and command will also disappear | | # by a proc, it will be removed here and command will also disappear |
| foreach var [$itrp eval {info procs}] { | | foreach var [$itrp eval {info procs}] { |
| if {![info exists dumpProcs($var)]} { | | if {![info exists dumpProcs($var)]} { |
| reportDebug "removing on $itrp proc $var" | | reportDebug "removing on $itrp proc $var" |
| $itrp eval [list rename $var {}] | | $itrp eval [list rename $var {}] |
| } | | } |
| } | | } |
| | |
|
| | ##nagelfar vartype aliasesVN varName |
| | ##nagelfar vartype aliasesPassArgVN varName |
| | ##nagelfar vartype tracesVN varName |
| | ##nagelfar vartype renameCmdsVN varName |
| # rename some commands and set aliases on interpreter | | # rename some commands and set aliases on interpreter |
| initInterpCommands $itrp $fresh $aliasesVN $aliasesPassArgVN $tracesVN\ | | initInterpCommands $itrp $fresh $aliasesVN $aliasesPassArgVN $tracesVN\ |
| $renameCmdsVN | | $renameCmdsVN |
| | |
| # dump interpreter command list here on first time as aliases should be | | # dump interpreter command list here on first time as aliases should be |
| # set prior to be found on this list for correct match | | # set prior to be found on this list for correct match |
| if {![info exists dumpCommands]} { | | if {![info exists dumpCommands]} { |
| set dumpCommands [$itrp eval {info commands}] | | set dumpCommands [$itrp eval {info commands}] |
| reportDebug "saving for $itrp command list $dumpCommands" | | reportDebug "saving for $itrp command list $dumpCommands" |
| # if current interpreter command list does not match initial list it | | # if current interpreter command list does not match initial list it |
| | |
| skipping to change at line 929 | | skipping to change at line 1013 |
|---|
| } | | } |
| } | | } |
| | |
| # parse application criteria arguments and determine if command applies | | # parse application criteria arguments and determine if command applies |
| proc parseApplicationCriteriaArgs {aftbef nearsec args} { | | proc parseApplicationCriteriaArgs {aftbef nearsec args} { |
| set otherargs {} | | set otherargs {} |
| | |
| # parse argument list | | # parse argument list |
| foreach arg $args { | | foreach arg $args { |
| if {[info exists nextargisval]} { | | if {[info exists nextargisval]} { |
|
| | ##nagelfar vartype nextargisval varName |
| set $nextargisval $arg | | set $nextargisval $arg |
| unset nextargisval | | unset nextargisval |
| } elseif {[info exists nextargisdatetime]} { | | } elseif {[info exists nextargisdatetime]} { |
|
| | ##nagelfar ignore Suspicious variable name |
| set ${nextargisdatetime}raw $arg | | set ${nextargisdatetime}raw $arg |
| # get epoch time from date time argument value | | # get epoch time from date time argument value |
|
| | ##nagelfar vartype nextargisdatetime varName |
| | ##nagelfar ignore Unknown variable |
| set $nextargisdatetime [parseDateTimeArg $prevarg $arg] | | set $nextargisdatetime [parseDateTimeArg $prevarg $arg] |
| unset nextargisdatetime | | unset nextargisdatetime |
| } else { | | } else { |
| switch -- $arg { | | switch -- $arg { |
| --after - --before { | | --after - --before { |
| # treat --after/--before as regular content if disabled | | # treat --after/--before as regular content if disabled |
| if {!$aftbef} { | | if {!$aftbef} { |
| lappend otherargs $arg | | lappend otherargs $arg |
| } else { | | } else { |
| set nextargisdatetime [string trimleft $arg -] | | set nextargisdatetime [string trimleft $arg -] |
| | |
| skipping to change at line 1031 | | skipping to change at line 1119 |
|---|
| proc module-forbid {args} { | | proc module-forbid {args} { |
| # parse application criteria arguments to determine if command apply | | # parse application criteria arguments to determine if command apply |
| lassign [parseApplicationCriteriaArgs 1 [expr {[getConf\ | | lassign [parseApplicationCriteriaArgs 1 [expr {[getConf\ |
| nearly_forbidden_days] * 86400}] {*}$args] apply isnearly after\ | | nearly_forbidden_days] * 86400}] {*}$args] apply isnearly after\ |
| otherargs | | otherargs |
| | |
| # parse remaining argument list, do it even if command does not apply to | | # parse remaining argument list, do it even if command does not apply to |
| # raise any command specification error | | # raise any command specification error |
| foreach arg $otherargs { | | foreach arg $otherargs { |
| if {[info exists nextargisval]} { | | if {[info exists nextargisval]} { |
|
| | ##nagelfar vartype nextargisval varName |
| set $nextargisval $arg | | set $nextargisval $arg |
| unset nextargisval | | unset nextargisval |
| } else { | | } else { |
| switch -glob -- $arg { | | switch -glob -- $arg { |
| --nearly-message { | | --nearly-message { |
| set nextargisval nearlymessage | | set nextargisval nearlymessage |
| } | | } |
| --message { | | --message { |
| set nextargisval message | | set nextargisval message |
| } | | } |
| | |
| skipping to change at line 1064 | | skipping to change at line 1153 |
|---|
| } | | } |
| | |
| if {![info exists modarglist]} { | | if {![info exists modarglist]} { |
| knerror {No module specified in argument} | | knerror {No module specified in argument} |
| } | | } |
| | |
| # skip record if application criteria are not met | | # skip record if application criteria are not met |
| if {$apply} { | | if {$apply} { |
| set proplist {} | | set proplist {} |
| if {[info exists message]} { | | if {[info exists message]} { |
|
| | ##nagelfar ignore Found constant |
| lappend proplist message $message | | lappend proplist message $message |
| } | | } |
| | |
| # record each forbid spec after parsing them | | # record each forbid spec after parsing them |
| foreach modarg [parseModuleSpecification 0 {*}$modarglist] { | | foreach modarg [parseModuleSpecification 0 {*}$modarglist] { |
| setModspecTag $modarg forbidden $proplist | | setModspecTag $modarg forbidden $proplist |
| } | | } |
| } elseif {$isnearly} { | | } elseif {$isnearly} { |
|
| | ##nagelfar ignore Found constant |
| lappend proplist after $after | | lappend proplist after $after |
| if {[info exists nearlymessage]} { | | if {[info exists nearlymessage]} { |
|
| | ##nagelfar ignore Found constant |
| lappend proplist message $nearlymessage | | lappend proplist message $nearlymessage |
| } | | } |
| # record each nearly forbid spec after parsing them | | # record each nearly forbid spec after parsing them |
| foreach modarg [parseModuleSpecification 0 {*}$modarglist] { | | foreach modarg [parseModuleSpecification 0 {*}$modarglist] { |
| setModspecTag $modarg nearly-forbidden $proplist | | setModspecTag $modarg nearly-forbidden $proplist |
| } | | } |
| } | | } |
| } | | } |
| | |
| proc module-hide {args} { | | proc module-hide {args} { |
| | |
| skipping to change at line 1448 | | skipping to change at line 1540 |
|---|
| } | | } |
| | |
| # supersede puts command to catch content sent to stdout/stderr within | | # supersede puts command to catch content sent to stdout/stderr within |
| # modulefile in order to correctly send stderr content (if a pager has been | | # modulefile in order to correctly send stderr content (if a pager has been |
| # enabled) or postpone content channel send after rendering on stdout the | | # enabled) or postpone content channel send after rendering on stdout the |
| # relative environment changes required by the modulefile | | # relative environment changes required by the modulefile |
| proc putsModfileCmd {itrp args} { | | proc putsModfileCmd {itrp args} { |
| # determine if puts call targets the stdout or stderr channel | | # determine if puts call targets the stdout or stderr channel |
| switch -- [llength $args] { | | switch -- [llength $args] { |
| 1 { | | 1 { |
|
| set deferPuts 1 | | # create struct with newline status and message to output |
| | set deferPuts [list 1 [lindex $args 0]] |
| } | | } |
| 2 { | | 2 { |
| switch -- [lindex $args 0] { | | switch -- [lindex $args 0] { |
|
| -nonewline - stdout { | | -nonewline { |
| set deferPuts 1 | | set deferPuts [list 0 [lindex $args 1]] |
| | } |
| | stdout { |
| | set deferPuts [list 1 [lindex $args 1]] |
| } | | } |
| prestdout { | | prestdout { |
|
| set deferPrePuts 1 | | set deferPrePuts [list 1 [lindex $args 1]] |
| set args [lreplace $args 0 0 stdout] | | |
| } | | } |
| stderr { | | stderr { |
| set reportArgs [list [lindex $args 1]] | | set reportArgs [list [lindex $args 1]] |
| } | | } |
| } | | } |
| } | | } |
| 3 { | | 3 { |
| if {[lindex $args 0] eq {-nonewline}} { | | if {[lindex $args 0] eq {-nonewline}} { |
| switch -- [lindex $args 1] { | | switch -- [lindex $args 1] { |
| stdout { | | stdout { |
|
| set deferPuts 1 | | set deferPuts [list 0 [lindex $args 2]] |
| } | | } |
| prestdout { | | prestdout { |
|
| set deferPrePuts 1 | | set deferPrePuts [list 0 [lindex $args 2]] |
| set args [lreplace $args 1 1 stdout] | | |
| } | | } |
| stderr { | | stderr { |
| set reportArgs [list [lindex $args 2] 1] | | set reportArgs [list [lindex $args 2] 1] |
| } | | } |
| } | | } |
| } else { | | } else { |
| set wrongNumArgs 1 | | set wrongNumArgs 1 |
| } | | } |
| } | | } |
| default { | | default { |
| set wrongNumArgs 1 | | set wrongNumArgs 1 |
| } | | } |
| } | | } |
| | |
| # raise error if bad argument number detected, do this here rather in _puts | | # raise error if bad argument number detected, do this here rather in _puts |
| # not to confuse people with an error reported by an internal name (_puts) | | # not to confuse people with an error reported by an internal name (_puts) |
| if {[info exists wrongNumArgs]} { | | if {[info exists wrongNumArgs]} { |
| knerror {wrong # args: should be "puts ?-nonewline? ?channelId? string"} | | knerror {wrong # args: should be "puts ?-nonewline? ?channelId? string"} |
| # defer puts if it targets stdout (see renderSettings) | | # defer puts if it targets stdout (see renderSettings) |
| } elseif {[info exists deferPuts]} { | | } elseif {[info exists deferPuts]} { |
|
| lappend ::g_stdoutPuts $args | | lappend ::g_stdoutPuts {*}$deferPuts |
| } elseif {[info exists deferPrePuts]} { | | } elseif {[info exists deferPrePuts]} { |
|
| lappend ::g_prestdoutPuts $args | | lappend ::g_prestdoutPuts {*}$deferPrePuts |
| # if it targets stderr call report, which knows what channel to use | | # if it targets stderr call report, which knows what channel to use |
| } elseif {[info exists reportArgs]} { | | } elseif {[info exists reportArgs]} { |
| # report message only if not silent | | # report message only if not silent |
| if {[isVerbosityLevel concise]} { | | if {[isVerbosityLevel concise]} { |
| report {*}$reportArgs | | report {*}$reportArgs |
| } | | } |
| # pass to real puts command if not related to stdout and do that in modfile | | # pass to real puts command if not related to stdout and do that in modfile |
| # interpreter context to get access to eventual specific channel | | # interpreter context to get access to eventual specific channel |
| } else { | | } else { |
| # re-throw error as a known error for accurate stack trace print | | # re-throw error as a known error for accurate stack trace print |
| | |
| skipping to change at line 1580 | | skipping to change at line 1674 |
|---|
| set ::env($var) {} | | set ::env($var) {} |
| } | | } |
| | |
| return {} | | return {} |
| } | | } |
| | |
| proc set-alias {alias what} { | | proc set-alias {alias what} { |
| set ::g_Aliases($alias) $what | | set ::g_Aliases($alias) $what |
| set ::g_stateAliases($alias) new | | set ::g_stateAliases($alias) new |
| | |
|
| | # current module is qualified for refresh evaluation |
| | lappendState -nodup refresh_qualified [currentState modulename] |
| | |
| return {} | | return {} |
| } | | } |
| | |
| # undo set-alias in unload mode | | # undo set-alias in unload mode |
| proc set-alias-un {alias what} { | | proc set-alias-un {alias what} { |
| return [unset-alias $alias] | | return [unset-alias $alias] |
| } | | } |
| | |
| proc unset-alias {alias} { | | proc unset-alias {alias} { |
| set ::g_Aliases($alias) {} | | set ::g_Aliases($alias) {} |
| set ::g_stateAliases($alias) del | | set ::g_stateAliases($alias) del |
| | |
| return {} | | return {} |
| } | | } |
| | |
| proc set-function {function what} { | | proc set-function {function what} { |
| set ::g_Functions($function) $what | | set ::g_Functions($function) $what |
| set ::g_stateFunctions($function) new | | set ::g_stateFunctions($function) new |
| | |
|
| | # current module is qualified for refresh evaluation |
| | lappendState -nodup refresh_qualified [currentState modulename] |
| | |
| return {} | | return {} |
| } | | } |
| | |
| # undo set-function in unload mode | | # undo set-function in unload mode |
| proc set-function-un {function what} { | | proc set-function-un {function what} { |
| return [unset-function $function] | | return [unset-function $function] |
| } | | } |
| | |
| proc unset-function {function} { | | proc unset-function {function} { |
| set ::g_Functions($function) {} | | set ::g_Functions($function) {} |
| | |
| skipping to change at line 1624 | | skipping to change at line 1724 |
|---|
| proc is-loaded {args} { | | proc is-loaded {args} { |
| # parse module version specification | | # parse module version specification |
| set args [parseModuleSpecification 0 {*}$args] | | set args [parseModuleSpecification 0 {*}$args] |
| | |
| foreach mod $args { | | foreach mod $args { |
| if {[getLoadedMatchingName $mod returnfirst] ne {}} { | | if {[getLoadedMatchingName $mod returnfirst] ne {}} { |
| return 1 | | return 1 |
| } | | } |
| } | | } |
| # is something loaded whatever it is? | | # is something loaded whatever it is? |
|
| return [expr {[llength $args] == 0 && [llength [getLoadedModuleList]] > 0}] | | return [expr {[llength $args] == 0 && [llength\ |
| | [getLoadedModulePropertyList name]] > 0}] |
| } | | } |
| | |
| proc is-loading {args} { | | proc is-loading {args} { |
| foreach mod $args { | | foreach mod $args { |
| if {[getLoadedMatchingName $mod returnfirst 1] ne {}} { | | if {[getLoadedMatchingName $mod returnfirst 1] ne {}} { |
| return 1 | | return 1 |
| } | | } |
| } | | } |
| # is something else loading whatever it is? | | # is something else loading whatever it is? |
| return [expr {[llength $args] == 0 && [llength [getLoadingModuleList]] >1}] | | return [expr {[llength $args] == 0 && [llength [getLoadingModuleList]] >1}] |
| | |
| skipping to change at line 1670 | | skipping to change at line 1771 |
|---|
| # if the conflicting module is loaded, we cannot either | | # if the conflicting module is loaded, we cannot either |
| if {[is-loaded $mod] || $isloading} { | | if {[is-loaded $mod] || $isloading} { |
| reportPresentConflictError $curmodnamevr $mod $isloading | | reportPresentConflictError $curmodnamevr $mod $isloading |
| } | | } |
| } | | } |
| | |
| return {} | | return {} |
| } | | } |
| | |
| proc parsePrereqCommandArgs {cmd args} { | | proc parsePrereqCommandArgs {cmd args} { |
|
| # parse tags defined | | set tag_list {} |
| switch -glob -- [lindex $args 0] { | | set optional 0 |
| --tag { | | set opt_list {} |
| set tag_list [split [lindex $args 1] :] | | set prereq_list {} |
| set tag_opt [list --tag [lindex $args 1]] | | |
| set args [lrange $args 2 end] | | # parse options defined |
| } | | set i 0 |
| --tag=* { | | foreach arg $args { |
| set tag_list [split [string range [lindex $args 0] 6 end] :] | | if {[info exists nextargistaglist]} { |
| set tag_opt [list [lindex $args 0]] | | set tag_list [split $arg :] |
| set args [lrange $args 1 end] | | lappend opt_list $arg |
| if {[llength $tag_list] == 0} { | | unset nextargistaglist |
| knerror "Missing value for '--tag' option" | | } else { |
| | switch -glob -- $arg { |
| | --optional { |
| | set optional 1 |
| | lappend opt_list $arg |
| | } |
| | --tag=* { |
| | set tag_list [split [string range $arg 6 end] :] |
| | lappend opt_list $arg |
| | if {[llength $tag_list] == 0} { |
| | knerror "Missing value for '--tag' option" |
| | } |
| | } |
| | --tag { |
| | set nextargistaglist 1 |
| | lappend opt_list $arg |
| | } |
| | -* { |
| | knerror "Invalid option '$arg'" |
| | } |
| | default { |
| | set prereq_list [lrange $args $i end] |
| | # end option parsing: remaining elts are list of prereqs |
| | break |
| | } |
| } | | } |
| } | | } |
|
| default { | | incr i |
| set tag_list {} | | |
| set tag_opt {} | | |
| } | | |
| } | | } |
|
| | |
| foreach tag $tag_list { | | foreach tag $tag_list { |
| if {$tag in [list loaded auto-loaded forbidden nearly-forbidden\ | | if {$tag in [list loaded auto-loaded forbidden nearly-forbidden\ |
| hidden]} { | | hidden]} { |
| knerror "Tag '$tag' cannot be manually set" | | knerror "Tag '$tag' cannot be manually set" |
| } | | } |
| } | | } |
|
| if {[llength $args] == 0} { | | if {[llength $prereq_list] == 0} { |
| knerror "wrong # args: should be \"$cmd ?--tag? ?taglist? modulefile\ | | knerror "wrong # args: should be \"$cmd ?--optional? ?--tag? ?taglist?\ |
| ?...?\"" | | modulefile ?...?\"" |
| } | | } elseif {[set mispopt [lsearch -inline -glob $prereq_list --*]] ne {}} { |
| return [list $tag_list $tag_opt $args] | | knerror "Misplaced option '$mispopt'" |
| | } |
| | return [list $tag_list $optional $opt_list $prereq_list] |
| } | | } |
| | |
|
| proc prereq {args} { | | proc prereqAnyModfileCmd {tryload auto args} { |
| lassign [parsePrereqCommandArgs prereq {*}$args] tag_list tag_opt args | | lassign [parsePrereqCommandArgs prereq {*}$args] tag_list optional\ |
| | opt_list args |
| | |
| set currentModule [currentState modulename] | | set currentModule [currentState modulename] |
| set curmodnamevr [currentState modulenamevr] | | set curmodnamevr [currentState modulenamevr] |
| | |
| # parse module version specification | | # parse module version specification |
| set args [parseModuleSpecification 0 {*}$args] | | set args [parseModuleSpecification 0 {*}$args] |
| | |
| # register prereq list (sets of optional prereq are registered as list) | | # register prereq list (sets of optional prereq are registered as list) |
| # unless record inhibited for current iterp context | | # unless record inhibited for current iterp context |
| if {[currentState inhibit_req_record] != [currentState evalid]} { | | if {[currentState inhibit_req_record] != [currentState evalid]} { |
|
| setLoadedPrereq $currentModule $args | | # if requirement is optional, add current module to the recorded prereq |
| | # list to make the requirement rule satisfied even if none loaded, as |
| | # current module will be loaded |
| | if {$optional} { |
| | lappend record_list $currentModule |
| | } |
| | lappend record_list {*}$args |
| | setLoadedPrereq $currentModule $record_list |
| } | | } |
| | |
|
| # if dependency resolving is enabled try to load prereq | | if {$auto} { |
| if {[getConf auto_handling]} { | | # try to load prereq as dependency resolving is enabled |
| loadRequirementModuleList $tag_list {*}$args | | lassign [loadRequirementModuleList $tryload $optional $tag_list\ |
| } | | {*}$args] retlo prereqloaded |
| | | } else { |
| set loadedmod_list {} | | set loadedmod_list {} |
| foreach mod $args { | | foreach mod $args { |
| # get all loaded or loading mod in args list | | # get all loaded or loading mod in args list |
| if {[set loadedmod [getLoadedMatchingName $mod returnfirst]] ne {} ||\ | | if {[set loadedmod [getLoadedMatchingName $mod returnfirst]] ne {}\ |
| [set loadedmod [getLoadedMatchingName $mod returnfirst 1]] ne {}} { | | || [set loadedmod [getLoadedMatchingName $mod returnfirst 1]] ne\ |
| lappend loadedmod_list $loadedmod | | {}} { |
| } | | lappend loadedmod_list $loadedmod |
| } | | } |
| | | } |
| if {[llength $loadedmod_list] == 0} { | | set prereqloaded [expr {[llength $loadedmod_list] > 0}] |
| reportMissingPrereqError $curmodnamevr {*}$args | | } |
| } elseif {![getConf auto_handling]} { | | |
| # apply missing tag to all loaded module found | | if {!$prereqloaded} { |
| | if {!$optional} { |
| | # error if requirement is not satisfied unless if optional |
| | reportMissingPrereqError $curmodnamevr {*}$args |
| | } |
| | } elseif {!$auto} { |
| | # apply missing tag to all loaded module found (already done when |
| | # dependency resolving is enabled) |
| cmdModuleTag 0 0 $tag_list {*}$loadedmod_list | | cmdModuleTag 0 0 $tag_list {*}$loadedmod_list |
| } | | } |
| | |
| return {} | | return {} |
| } | | } |
| | |
| proc x-resource {resource {value {}}} { | | proc x-resource {resource {value {}}} { |
| # sometimes x-resource value may be provided within resource name | | # sometimes x-resource value may be provided within resource name |
| # as the "x-resource {Ileaf.popup.saveUnder: True}" example provided | | # as the "x-resource {Ileaf.popup.saveUnder: True}" example provided |
| # in manpage. so here is an attempt to extract real resource name and | | # in manpage. so here is an attempt to extract real resource name and |
| | |
| skipping to change at line 1891 | | skipping to change at line 2031 |
|---|
| LOADEDMODULES] | | LOADEDMODULES] |
| | |
| # define shell command to run to source script and analyze the environment | | # define shell command to run to source script and analyze the environment |
| # changes it performs | | # changes it performs |
| switch -- [file tail $shell] { | | switch -- [file tail $shell] { |
| dash - sh { | | dash - sh { |
| # declare is not supported by dash but functions cannot be retrieved | | # declare is not supported by dash but functions cannot be retrieved |
| # anyway, so keep using declare and throw errors out to avoid overall | | # anyway, so keep using declare and throw errors out to avoid overall |
| # execution error. dash does not pass arguments to sourced script but | | # execution error. dash does not pass arguments to sourced script but |
| # it does not raise error if arguments are set | | # it does not raise error if arguments are set |
|
| | ##nagelfar ignore +3 Found constant |
| set command "export -p; echo $sep; declare -f 2>/dev/null; echo\ | | set command "export -p; echo $sep; declare -f 2>/dev/null; echo\ |
| $sep; alias; echo $sep; echo $sep; pwd; echo $sep; . [listTo\ | | $sep; alias; echo $sep; echo $sep; pwd; echo $sep; . [listTo\ |
| shell $shdesc] 2>&1; echo $sep; export -p; echo $sep; declare -f\ | | shell $shdesc] 2>&1; echo $sep; export -p; echo $sep; declare -f\ |
| 2>/dev/null; echo $sep; alias; echo $sep; echo $sep; pwd" | | 2>/dev/null; echo $sep; alias; echo $sep; echo $sep; pwd" |
| set varre {export (\S+?)=["']?(.*?)["']?$} | | set varre {export (\S+?)=["']?(.*?)["']?$} |
| set funcre {(\S+?) \(\)\s?\n?{\s?\n(.+?)\n}$} | | set funcre {(\S+?) \(\)\s?\n?{\s?\n(.+?)\n}$} |
| set aliasre {(\S+?)='(.*?)'$} | | set aliasre {(\S+?)='(.*?)'$} |
| set varvalmap [list {\"} {"} \\\\ \\] | | set varvalmap [list {\"} {"} \\\\ \\] |
| set alvalmap [list {'\''} ' {'"'"'} '] | | set alvalmap [list {'\''} ' {'"'"'} '] |
| } | | } |
| bash { | | bash { |
|
| | ##nagelfar ignore +2 Found constant |
| set command "export -p; echo $sep; declare -f; echo $sep; alias;\ | | set command "export -p; echo $sep; declare -f; echo $sep; alias;\ |
| echo $sep; complete; echo $sep; pwd; echo $sep; . [listTo shell\ | | echo $sep; complete; echo $sep; pwd; echo $sep; . [listTo shell\ |
| $shdesc] 2>&1; echo $sep; export -p; echo $sep; declare -f; echo\ | | $shdesc] 2>&1; echo $sep; export -p; echo $sep; declare -f; echo\ |
| $sep; alias; echo $sep; complete; echo $sep; pwd" | | $sep; alias; echo $sep; complete; echo $sep; pwd" |
| set varre {declare -x (\S+?)="(.*?)"$} | | set varre {declare -x (\S+?)="(.*?)"$} |
| set funcre {(\S+?) \(\)\s?\n{\s?\n(.+?)\n}$} | | set funcre {(\S+?) \(\)\s?\n{\s?\n(.+?)\n}$} |
| set aliasre {alias (\S+?)='(.*?)'$} | | set aliasre {alias (\S+?)='(.*?)'$} |
| set compre {complete (.+?) (\S+?)$} | | set compre {complete (.+?) (\S+?)$} |
| set comprevar [list match value name] | | set comprevar [list match value name] |
| set varvalmap [list {\"} {"} \\\\ \\] | | set varvalmap [list {\"} {"} \\\\ \\] |
| set alvalmap [list {'\''} '] | | set alvalmap [list {'\''} '] |
| lappend shellopts --noprofile --norc | | lappend shellopts --noprofile --norc |
| } | | } |
| ksh - ksh93 { | | ksh - ksh93 { |
|
| | ##nagelfar ignore +3 Found constant |
| set command "typeset -x; echo $sep; typeset +f | while read f; do\ | | set command "typeset -x; echo $sep; typeset +f | while read f; do\ |
| typeset -f \${f%\\(\\)}; echo; done; echo $sep; alias; echo $sep;\ | | typeset -f \${f%\\(\\)}; echo; done; echo $sep; alias; echo $sep;\ |
| echo $sep; pwd; echo $sep; . [listTo shell $shdesc] 2>&1; echo\ | | echo $sep; pwd; echo $sep; . [listTo shell $shdesc] 2>&1; echo\ |
| $sep; typeset -x; echo $sep; typeset +f | while read f; do\ | | $sep; typeset -x; echo $sep; typeset +f | while read f; do\ |
| typeset -f \${f%\\(\\)}; echo; done; echo $sep; alias; echo $sep;\ | | typeset -f \${f%\\(\\)}; echo; done; echo $sep; alias; echo $sep;\ |
| echo $sep; pwd" | | echo $sep; pwd" |
| set varre {(\S+?)=\$?'?(.*?)'?$} | | set varre {(\S+?)=\$?'?(.*?)'?$} |
| set funcre {(\S+?)\(\) {\n?(.+?)}[;\n]?$} | | set funcre {(\S+?)\(\) {\n?(.+?)}[;\n]?$} |
| set aliasre {(\S+?)=\$?'?(.*?)'?$} | | set aliasre {(\S+?)=\$?'?(.*?)'?$} |
| set varvalmap [list {\'} '] | | set varvalmap [list {\'} '] |
| set alvalmap [list {\"} {"} {\\'} ' {\'} ' {\\\\} {\\}] | | set alvalmap [list {\"} {"} {\\'} ' {\'} ' {\\\\} {\\}] |
| } | | } |
| zsh { | | zsh { |
|
| | ##nagelfar ignore +2 Found constant |
| set command "typeset -x; echo $sep; declare -f; echo $sep; alias;\ | | set command "typeset -x; echo $sep; declare -f; echo $sep; alias;\ |
| echo $sep; echo $sep; pwd; echo $sep; . [listTo shell $shdesc]\ | | echo $sep; echo $sep; pwd; echo $sep; . [listTo shell $shdesc]\ |
| 2>&1; echo $sep; typeset -x; echo $sep; declare -f; echo $sep;\ | | 2>&1; echo $sep; typeset -x; echo $sep; declare -f; echo $sep;\ |
| alias; echo $sep; echo $sep; pwd" | | alias; echo $sep; echo $sep; pwd" |
| set varre {(\S+?)=\$?'?(.*?)'?$} | | set varre {(\S+?)=\$?'?(.*?)'?$} |
| set funcre {(\S+?) \(\) {\n(.+?)\n}$} | | set funcre {(\S+?) \(\) {\n(.+?)\n}$} |
| set aliasre {(\S+?)=\$?'?(.*?)'?$} | | set aliasre {(\S+?)=\$?'?(.*?)'?$} |
| set varvalmap [list {'\''} '] | | set varvalmap [list {'\''} '] |
| set alvalmap [list {'\''} '] | | set alvalmap [list {'\''} '] |
| } | | } |
| csh { | | csh { |
|
| | ##nagelfar ignore +2 Found constant |
| set command "setenv; echo $sep; echo $sep; alias; echo $sep; echo\ | | set command "setenv; echo $sep; echo $sep; alias; echo $sep; echo\ |
| $sep; pwd; echo $sep; source [listTo shell $shdesc] >&\ | | $sep; pwd; echo $sep; source [listTo shell $shdesc] >&\ |
| /dev/stdout; echo $sep; setenv; echo $sep; echo $sep; alias; echo\ | | /dev/stdout; echo $sep; setenv; echo $sep; echo $sep; alias; echo\ |
| $sep; echo $sep; pwd" | | $sep; echo $sep; pwd" |
| set varre {(\S+?)=(.*?)$} | | set varre {(\S+?)=(.*?)$} |
| set aliasre {(\S+?)\t(.*?)$} | | set aliasre {(\S+?)\t(.*?)$} |
| set varvalmap [list] | | set varvalmap [list] |
| set alvalmap [list] | | set alvalmap [list] |
| lappend shellopts -f | | lappend shellopts -f |
| } | | } |
| tcsh { | | tcsh { |
|
| | ##nagelfar ignore +2 Found constant |
| set command "setenv; echo $sep; echo $sep; alias; echo $sep;\ | | set command "setenv; echo $sep; echo $sep; alias; echo $sep;\ |
| complete; echo $sep; pwd; echo $sep; source [listTo shell\ | | complete; echo $sep; pwd; echo $sep; source [listTo shell\ |
| $shdesc] >& /dev/stdout; echo $sep; setenv; echo $sep; echo $sep;\ | | $shdesc] >& /dev/stdout; echo $sep; setenv; echo $sep; echo $sep;\ |
| alias; echo $sep; complete; echo $sep; pwd" | | alias; echo $sep; complete; echo $sep; pwd" |
| set varre {(\S+?)=(.*?)$} | | set varre {(\S+?)=(.*?)$} |
| set aliasre {(\S+?)\t\(?(.*?)\)?$} | | set aliasre {(\S+?)\t\(?(.*?)\)?$} |
| set compre {(\S+?)\t(.*?)$} | | set compre {(\S+?)\t(.*?)$} |
| set comprevar [list match name value] | | set comprevar [list match name value] |
| set varvalmap [list] | | set varvalmap [list] |
| set alvalmap [list] | | set alvalmap [list] |
| lappend shellopts -f | | lappend shellopts -f |
| } | | } |
| fish { | | fish { |
| # exclude from search builtins, fish-specific functions and private | | # exclude from search builtins, fish-specific functions and private |
| # functions defined prior script evaluation: reduce this way the | | # functions defined prior script evaluation: reduce this way the |
| # the number of functions to parse. | | # the number of functions to parse. |
| set getfunc "set funcout (string match -r -v \$funcfilter (functions\ | | set getfunc "set funcout (string match -r -v \$funcfilter (functions\ |
| -a -n) | while read f; functions \$f; echo '$subsep'; end)" | | -a -n) | while read f; functions \$f; echo '$subsep'; end)" |
|
| set command "set -xgL; echo '$sep'; set funcfilter \\^\\((string\ | | ##nagelfar ignore +9 Found constant |
| join '|' (string replace -r '(\\\[|\\.)' '\\\\\\\\\\\\\\\$1'\ | | set command "set -xgL; echo '$sep'; status test-feature\ |
| | regex-easyesc 2>/dev/null; and set escrepl '\\\\\\\\\$1'; or set\ |
| | escrepl '\\\\\\\\\\\\\\\$1'; set funcfilter \\^\\((string\ |
| | join '|' (string replace -r '(\\\[|\\.)' \$escrepl\ |
| (builtin -n; functions -a -n | string split ', ' | string match\ | | (builtin -n; functions -a -n | string split ', ' | string match\ |
| -e -r '^_')))\\|fish\\.\\*\\)\\\$; $getfunc; $getfunc; string\ | | -e -r '^_')))\\|fish\\.\\*\\)\\\$; $getfunc; $getfunc; string\ |
| split \$funcout; echo '$sep'; string split \$funcout; echo\ | | split \$funcout; echo '$sep'; string split \$funcout; echo\ |
| '$sep'; complete; echo '$sep'; pwd; echo '$sep'; source [listTo\ | | '$sep'; complete; echo '$sep'; pwd; echo '$sep'; source [listTo\ |
| shell $shdesc] 2>&1; or exit \$status; echo '$sep'; set -xgL;\ | | shell $shdesc] 2>&1; or exit \$status; echo '$sep'; set -xgL;\ |
| echo '$sep'; $getfunc; string split \$funcout; echo '$sep';\ | | echo '$sep'; $getfunc; string split \$funcout; echo '$sep';\ |
| string split \$funcout; echo '$sep'; complete; echo '$sep'; pwd" | | string split \$funcout; echo '$sep'; complete; echo '$sep'; pwd" |
| set varre {^(\S+?\M) ?'?(.*?)'?$} | | set varre {^(\S+?\M) ?'?(.*?)'?$} |
| # exclude alias from function list | | # exclude alias from function list |
| set funcre "^function (\\S+?)(?: \[^\\n\]*?--description\ | | set funcre "^function (\\S+?)(?: \[^\\n\]*?--description\ |
| | |
| skipping to change at line 2022 | | skipping to change at line 2171 |
|---|
| set sherr 1 | | set sherr 1 |
| } | | } |
| | |
| # link result variables to calling context | | # link result variables to calling context |
| upvar cwdbefout cwdbefout cwdaftout cwdaftout | | upvar cwdbefout cwdbefout cwdaftout cwdaftout |
| | |
| # extract each output sections | | # extract each output sections |
| set idx 0 | | set idx 0 |
| foreach varout {varbefout funcbefout aliasbefout compbefout cwdbefout\ | | foreach varout {varbefout funcbefout aliasbefout compbefout cwdbefout\ |
| scriptout varaftout funcaftout aliasaftout compaftout cwdaftout} { | | scriptout varaftout funcaftout aliasaftout compaftout cwdaftout} { |
|
| | ##nagelfar vartype varout varName |
| if {[set sepidx [string first $sep $output $idx]] == -1} { | | if {[set sepidx [string first $sep $output $idx]] == -1} { |
| set $varout [string trimright [string range $output $idx end] \n] | | set $varout [string trimright [string range $output $idx end] \n] |
| if {$varout ne {cwdaftout} && !$sherr} { | | if {$varout ne {cwdaftout} && !$sherr} { |
| knerror "Unexpected output when sourcing '$shdesc' in shell\ | | knerror "Unexpected output when sourcing '$shdesc' in shell\ |
| '$shell'" | | '$shell'" |
| } | | } |
| } else { | | } else { |
| set $varout [string trimright [string range $output $idx [expr\ | | set $varout [string trimright [string range $output $idx [expr\ |
| {$sepidx - 1}]] \n] | | {$sepidx - 1}]] \n] |
| set idx [expr {$sepidx + [string length $sep] + 1}] | | set idx [expr {$sepidx + [string length $sep] + 1}] |
| | |
| skipping to change at line 2060 | | skipping to change at line 2210 |
|---|
| knerror $errmsg | | knerror $errmsg |
| } | | } |
| | |
| # link result variables to calling context | | # link result variables to calling context |
| upvar varbef varbef varaft varaft | | upvar varbef varbef varaft varaft |
| upvar funcbef funcbef funcaft funcaft | | upvar funcbef funcbef funcaft funcaft |
| upvar aliasbef aliasbef aliasaft aliasaft | | upvar aliasbef aliasbef aliasaft aliasaft |
| upvar compbef compbef compaft compaft | | upvar compbef compbef compaft compaft |
| | |
| # extract environment variable information | | # extract environment variable information |
|
| | ##nagelfar ignore Found constant |
| foreach {out arr} [list varbefout varbef varaftout varaft] { | | foreach {out arr} [list varbefout varbef varaftout varaft] { |
|
| | ##nagelfar vartype out varName |
| foreach {match name value} [regexp -all -inline -lineanchor $varre [set\ | | foreach {match name value} [regexp -all -inline -lineanchor $varre [set\ |
| $out]] { | | $out]] { |
| # convert shell-specific escaping | | # convert shell-specific escaping |
|
| | ##nagelfar ignore Suspicious variable name |
| set ${arr}($name) [string map $varvalmap $value] | | set ${arr}($name) [string map $varvalmap $value] |
| } | | } |
| } | | } |
| # extract function information if function supported by shell | | # extract function information if function supported by shell |
| if {[info exists funcre]} { | | if {[info exists funcre]} { |
|
| | ##nagelfar ignore Found constant |
| foreach {out arr} [list funcbefout funcbef funcaftout funcaft] { | | foreach {out arr} [list funcbefout funcbef funcaftout funcaft] { |
| foreach {match name value} [regexp -all -inline -lineanchor $funcre\ | | foreach {match name value} [regexp -all -inline -lineanchor $funcre\ |
| [set $out]] { | | [set $out]] { |
| # no specific escaping to convert for functions | | # no specific escaping to convert for functions |
|
| | ##nagelfar ignore Suspicious variable name |
| set ${arr}($name) $value | | set ${arr}($name) $value |
| } | | } |
| } | | } |
| } | | } |
| # extract alias information | | # extract alias information |
|
| | ##nagelfar ignore Found constant |
| foreach {out arr} [list aliasbefout aliasbef aliasaftout aliasaft] { | | foreach {out arr} [list aliasbefout aliasbef aliasaftout aliasaft] { |
| foreach {match name value} [regexp -all -inline -lineanchor $aliasre\ | | foreach {match name value} [regexp -all -inline -lineanchor $aliasre\ |
| [set $out]] { | | [set $out]] { |
|
| | ##nagelfar ignore Suspicious variable name |
| set ${arr}($name) [string map $alvalmap $value] | | set ${arr}($name) [string map $alvalmap $value] |
| } | | } |
| } | | } |
| # extract complete information if supported by shell | | # extract complete information if supported by shell |
| if {[info exists compre]} { | | if {[info exists compre]} { |
|
| | ##nagelfar ignore Found constant |
| foreach {out arr} [list compbefout compbef compaftout compaft] { | | foreach {out arr} [list compbefout compbef compaftout compaft] { |
|
| | ##nagelfar ignore Non constant variable list to foreach statement |
| foreach $comprevar [regexp -all -inline -lineanchor $compre [set\ | | foreach $comprevar [regexp -all -inline -lineanchor $compre [set\ |
| $out]] { | | $out]] { |
| if {[info exists valpart1]} { | | if {[info exists valpart1]} { |
|
| | ##nagelfar ignore Unknown variable |
| set value [concat $valpart1 $valpart2] | | set value [concat $valpart1 $valpart2] |
| } | | } |
| # no specific escaping to convert for completes | | # no specific escaping to convert for completes |
|
| | ##nagelfar ignore Suspicious variable name |
| lappend ${arr}($name) $value | | lappend ${arr}($name) $value |
| } | | } |
| } | | } |
| } | | } |
| } | | } |
| | |
| # execute script with args through shell and convert environment changes into | | # execute script with args through shell and convert environment changes into |
| # corresponding modulefile commands | | # corresponding modulefile commands |
| proc sh-to-mod {args} { | | proc sh-to-mod {args} { |
| set modcontent [list] | | set modcontent [list] |
| set pathsep [getState path_separator] | | set pathsep [getState path_separator] |
| set shell [lindex $args 0] | | set shell [lindex $args 0] |
| | |
| # evaluate script and retrieve environment before and after evaluation | | # evaluate script and retrieve environment before and after evaluation |
| # procedure will set result variables in current context | | # procedure will set result variables in current context |
|
| | ##nagelfar implicitvarcmd {execShAndGetEnv *} ignvarlist cwdbefout\ |
| | cwdaftout varbef varaft funcbef funcaft aliasbef aliasaft compbef\ |
| | compaft |
| execShAndGetEnv {*}$args | | execShAndGetEnv {*}$args |
| | |
| # check environment variable change | | # check environment variable change |
| lassign [getDiffBetweenArray varbef varaft] notaft diff notbef | | lassign [getDiffBetweenArray varbef varaft] notaft diff notbef |
| foreach name $notaft { | | foreach name $notaft { |
| # also ignore Modules variables intended for internal use | | # also ignore Modules variables intended for internal use |
| if {$name ni $ignvarlist && ![string equal -length 10 $name\ | | if {$name ni $ignvarlist && ![string equal -length 10 $name\ |
| __MODULES_]} { | | __MODULES_]} { |
| lappend modcontent [list unsetenv $name] | | lappend modcontent [list unsetenv $name] |
| } | | } |
| | |
| skipping to change at line 2343 | | skipping to change at line 2507 |
|---|
| | |
| # parse arguments set on a variant modulefile command | | # parse arguments set on a variant modulefile command |
| proc parseVariantCommandArgs {args} { | | proc parseVariantCommandArgs {args} { |
| set dflvalue {} | | set dflvalue {} |
| set defdflvalue 0 | | set defdflvalue 0 |
| set isboolean 0 | | set isboolean 0 |
| set i 0 | | set i 0 |
| foreach arg $args { | | foreach arg $args { |
| incr i | | incr i |
| if {[info exists nextargisval]} { | | if {[info exists nextargisval]} { |
|
| | ##nagelfar vartype nextargisval varName |
| set $nextargisval $arg | | set $nextargisval $arg |
| unset nextargisval | | unset nextargisval |
| } else { | | } else { |
| switch -glob -- $arg { | | switch -glob -- $arg { |
| --default { | | --default { |
|
| | ##nagelfar ignore Found constant |
| set nextargisval dflvalue | | set nextargisval dflvalue |
| set defdflvalue 1 | | set defdflvalue 1 |
| } | | } |
| --boolean { | | --boolean { |
| set isboolean 1 | | set isboolean 1 |
| } | | } |
| -* { | | -* { |
| knerror "Invalid option '$arg'" | | knerror "Invalid option '$arg'" |
| } | | } |
| default { | | default { |
| | |
| skipping to change at line 2512 | | skipping to change at line 2678 |
|---|
| proc require-fullname {} { | | proc require-fullname {} { |
| # test specified name is any alternative name of currently evaluating mod | | # test specified name is any alternative name of currently evaluating mod |
| # expect the default and parent dir name (which are considered unqualified) | | # expect the default and parent dir name (which are considered unqualified) |
| if {![modEq [currentState specifiedname] [currentState modulename] eqspec\ | | if {![modEq [currentState specifiedname] [currentState modulename] eqspec\ |
| 1 4]} { | | 1 4]} { |
| knerror {Module version must be specified to load module}\ | | knerror {Module version must be specified to load module}\ |
| MODULES_ERR_GLOBAL | | MODULES_ERR_GLOBAL |
| } | | } |
| } | | } |
| | |
|
| proc prereq-all {args} { | | proc prereqAllModfileCmd {tryload auto args} { |
| lassign [parsePrereqCommandArgs prereq-all {*}$args] tag_list tag_opt args | | lassign [parsePrereqCommandArgs prereq-all {*}$args] tag_list optional\ |
| | opt_list args |
| # call prereq over each arg independently to emulate a prereq-all | | # call prereq over each arg independently to emulate a prereq-all |
| foreach arg $args { | | foreach arg $args { |
|
| prereq {*}$tag_opt $arg | | prereqAnyModfileCmd $tryload $auto {*}$opt_list $arg |
| } | | } |
| } | | } |
| | |
| proc always-load {args} { | | proc always-load {args} { |
|
| lassign [parsePrereqCommandArgs always-load {*}$args] tag_list tag_opt args | | lassign [parsePrereqCommandArgs always-load {*}$args] tag_list optional\ |
| | opt_list args |
| | # append keep-loaded tag to the list, second tag list in opt_list will take |
| | # over the initial list defined |
| lappend tag_list keep-loaded | | lappend tag_list keep-loaded |
|
| # load all module specified, call module rather directly cmdModuleLoad to | | lappend opt_list --tag [join $tag_list :] |
| # get prereq recording | | |
| module load --tag [join $tag_list :] {*}$args | | # auto load is inhibited if currently in DepRe context |
| | set auto [expr {[currentModuleEvalContext] eq {depre} ? {0} : {1}}] |
| | |
| | # load all module specified |
| | prereqAllModfileCmd 0 $auto {*}$opt_list {*}$args |
| } | | } |
| | |
| proc family {name} { | | proc family {name} { |
| # ensure name is valid to be part of the name of an environment variable | | # ensure name is valid to be part of the name of an environment variable |
| if {[string length $name] == 0 || ![regexp {^[A-Za-z0-9_]*$} $name]} { | | if {[string length $name] == 0 || ![regexp {^[A-Za-z0-9_]*$} $name]} { |
| knerror "Invalid family name '$name'" | | knerror "Invalid family name '$name'" |
| } | | } |
| | |
| # only one loaded module could provide a given family | | # only one loaded module could provide a given family |
| conflict $name | | conflict $name |
| | |
| skipping to change at line 2570 | | skipping to change at line 2744 |
|---|
| } | | } |
| | |
| proc complete {shell name body} { | | proc complete {shell name body} { |
| if {[string length $name] == 0} { | | if {[string length $name] == 0} { |
| knerror "Invalid command name '$name'" | | knerror "Invalid command name '$name'" |
| } | | } |
| # append definition retaining for which shell they are made | | # append definition retaining for which shell they are made |
| # also some shells may set multiple definitions for a single name | | # also some shells may set multiple definitions for a single name |
| lappend ::g_Completes($name) $shell $body | | lappend ::g_Completes($name) $shell $body |
| set ::g_stateCompletes($name) new | | set ::g_stateCompletes($name) new |
|
| | |
| | # current module is qualified for refresh evaluation |
| | lappendState -nodup refresh_qualified [currentState modulename] |
| } | | } |
| | |
| # undo complete in unload mode | | # undo complete in unload mode |
| proc complete-un {shell name body} { | | proc complete-un {shell name body} { |
| return [uncomplete $name] | | return [uncomplete $name] |
| } | | } |
| | |
| proc uncomplete {name} { | | proc uncomplete {name} { |
| if {[string length $name] == 0} { | | if {[string length $name] == 0} { |
| knerror "Invalid command name '$name'" | | knerror "Invalid command name '$name'" |
| | |
| skipping to change at line 2627 | | skipping to change at line 2804 |
|---|
| set pushlist [lreplace $pushlist $popidx $popidx] | | set pushlist [lreplace $pushlist $popidx $popidx] |
| remove-path --index $pushvar $popidx | | remove-path --index $pushvar $popidx |
| } | | } |
| | |
| if {[llength $pushlist] > 0} { | | if {[llength $pushlist] > 0} { |
| # fetch value on top of the stack | | # fetch value on top of the stack |
| set validx [expr {[string first & [lindex $pushlist 0]] + 1}] | | set validx [expr {[string first & [lindex $pushlist 0]] + 1}] |
| set popval [string range [lindex $pushlist 0] $validx end] | | set popval [string range [lindex $pushlist 0] $validx end] |
| | |
| # restore top value if different from current one | | # restore top value if different from current one |
|
| # env array is used instead of get-env to know if env var is undefined | | # env array is used instead of get-env to know if envvar is undefined |
| if {![info exists ::env($var)] || $::env($var) ne $popval} { | | if {![info exists ::env($var)] || $::env($var) ne $popval} { |
| set-env $var $popval | | set-env $var $popval |
| } | | } |
| | |
| # if last element remaining in stack is the initial value prior first | | # if last element remaining in stack is the initial value prior first |
| # pushenv, then clear the stack totally | | # pushenv, then clear the stack totally |
| if {$validx == 1} { | | if {$validx == 1} { |
| remove-path --index $pushvar 0 | | remove-path --index $pushvar 0 |
| } | | } |
| } else { | | } else { |
| | | |
| End of changes. 76 change blocks. |
|---|
| 96 lines changed or deleted | | 273 lines changed or added |
|---|
"Fossies" - the Fresh Open Source Software Archive 