From 3bd6c9c1b46d1836b8b844809da3df5d16a0a2f3 Mon Sep 17 00:00:00 2001 From: Achim Gsell Date: Wed, 1 Mar 2017 14:08:17 +0100 Subject: [PATCH] Pmodules/modulecmd.tcl.in - indentation changed to 8 spaces - avoid needless nesting --- Pmodules/modulecmd.tcl.in | 4024 ++++++++++++++++++------------------- 1 file changed, 1984 insertions(+), 2040 deletions(-) diff --git a/Pmodules/modulecmd.tcl.in b/Pmodules/modulecmd.tcl.in index 15049a4..4eed291 100644 --- a/Pmodules/modulecmd.tcl.in +++ b/Pmodules/modulecmd.tcl.in @@ -22,13 +22,13 @@ set flag_default_mf 1 ;# Report default modulefiles and version alias # Used to tell if a machine is running Windows or not proc isWin {} { - global tcl_platform + global tcl_platform - if { $tcl_platform(platform) == "windows" } { - return 1 - } else { - return 0 - } + if { $tcl_platform(platform) == "windows" } { + return 1 + } else { + return 0 + } } # @@ -43,7 +43,7 @@ if { [isWin] } { # Dynamic columns set DEF_COLUMNS 80 ;# Default size of columns for formatting if {[catch {exec stty size} stty_size] == 0 && $stty_size != ""} { - set DEF_COLUMNS [lindex $stty_size 1] + set DEF_COLUMNS [lindex $stty_size 1] } # Change this to your support email address... @@ -65,25 +65,25 @@ set show_modtimes 0 ;# Gets set if you do module list/avail -l # Info, Warnings and Error message handling. # proc reportWarning {message {nonewline ""}} { - if {$nonewline != ""} { - puts -nonewline stderr "$message" - } else { - puts stderr "$message" - } + if {$nonewline != ""} { + puts -nonewline stderr "$message" + } else { + puts stderr "$message" + } } proc reportInternalBug {message} { - global contact + global contact - puts stderr "Module ERROR: $message\nPlease contact: $contact" + puts stderr "Module ERROR: $message\nPlease contact: $contact" } proc report {message {nonewline ""}} { - if {$nonewline != ""} { - puts -nonewline stderr "$message" - } else { - puts stderr "$message" - } + if {$nonewline != ""} { + puts -nonewline stderr "$message" + } else { + puts stderr "$message" + } } ######################################################################## @@ -91,170 +91,165 @@ proc report {message {nonewline ""}} { # proc unset-env {var} { - global env g_debug + global env g_debug - if {[info exists env($var)]} { - if {$g_debug} { - report "DEBUG unset-env: $var" - } - unset env($var) - } + if {[info exists env($var)]} { + if {$g_debug} { + report "DEBUG unset-env: $var" + } + unset env($var) + } } proc execute-modulefile {modfile {help ""}} { - global g_debug - global ModulesCurrentModulefile - set ModulesCurrentModulefile $modfile + global g_debug + global ModulesCurrentModulefile + set ModulesCurrentModulefile $modfile - if {$g_debug} { - report "DEBUG execute-modulefile: Starting $modfile" - } - set slave __[currentModuleName] - if {![interp exists $slave]} { - interp create $slave - interp alias $slave setenv {} setenv - interp alias $slave unsetenv {} unsetenv - interp alias $slave getenv {} getenv - interp alias $slave system {} system - interp alias $slave append-path {} append-path - interp alias $slave prepend-path {} prepend-path - interp alias $slave remove-path {} remove-path - interp alias $slave prereq {} prereq - interp alias $slave conflict {} conflict - interp alias $slave is-loaded {} is-loaded - interp alias $slave module {} module - interp alias $slave module-info {} module-info - interp alias $slave module-whatis {} module-whatis - interp alias $slave set-alias {} set-alias - interp alias $slave unset-alias {} unset-alias - interp alias $slave uname {} uname - interp alias $slave x-resource {} x-resource - interp alias $slave module-version {} module-version - interp alias $slave module-alias {} module-alias - interp alias $slave reportInternalBug {} reportInternalBug - interp alias $slave reportWarning {} reportWarning - interp alias $slave report {} report - interp alias $slave isWin {} isWin - - interp eval $slave {global ModulesCurrentModulefile g_debug} - interp eval $slave [list "set" "ModulesCurrentModulefile" $modfile] - interp eval $slave [list "set" "g_debug" $g_debug] - interp eval $slave [list "set" "help" $help] - - } - set errorVal [interp eval $slave { if {$g_debug} { - report "Sourcing $ModulesCurrentModulefile" - } - set sourceFailed [catch {source $ModulesCurrentModulefile} errorMsg] - if {$help != ""} { - if {[info procs "ModulesHelp"] == "ModulesHelp"} { - ModulesHelp - } else { - reportWarning "Unable to find ModulesHelp in\ - $ModulesCurrentModulefile." - } - set sourceFailed 0 + report "DEBUG execute-modulefile: Starting $modfile" } - if {$sourceFailed} { - if {$errorMsg == "" && $errorInfo == ""} { - unset errorMsg - return 1 - }\ - elseif [regexp "^WARNING" $errorMsg] { - reportWarning $errorMsg - return 1 - } else { - global errorInfo - reportInternalBug "ERROR occurred in file\ - $ModulesCurrentModulefile:$errorInfo" - exit 1 - } - } else { - unset errorMsg - return 0 - } - }] - interp delete $slave - if {$g_debug} { - report "DEBUG Exiting $modfile" - } - return $errorVal -} - -# Smaller subset than main module load... This function runs modulerc and\ - .version files -proc execute-modulerc {modfile} { - global g_rcfilesSourced - global g_debug g_moduleDefault - global ModulesCurrentModulefile - - - if {$g_debug} { - report "DEBUG execute-modulerc: $modfile" - } - - set ModulesCurrentModulefile $modfile - - if {![checkValidModule $modfile]} { - reportInternalBug "+(0):ERROR:0: Magic cookie '#%Module' missing in\ - '$modfile'" - return "" - } - - set modparent [file dirname $modfile] - - if {![info exists g_rcfilesSourced($modfile)]} { - if {$g_debug} { - report "DEBUG execute-modulerc: sourcing rc $modfile" - } - set slave __.modulerc + set slave __[currentModuleName] if {![interp exists $slave]} { - interp create $slave - interp alias $slave uname {} uname - interp alias $slave system {} system - interp alias $slave module-version {} module-version - interp alias $slave module-alias {} module-alias - interp alias $slave module {} module - interp alias $slave reportInternalBug {} reportInternalBug + interp create $slave + interp alias $slave setenv {} setenv + interp alias $slave unsetenv {} unsetenv + interp alias $slave getenv {} getenv + interp alias $slave system {} system + interp alias $slave append-path {} append-path + interp alias $slave prepend-path {} prepend-path + interp alias $slave remove-path {} remove-path + interp alias $slave prereq {} prereq + interp alias $slave conflict {} conflict + interp alias $slave is-loaded {} is-loaded + interp alias $slave module {} module + interp alias $slave module-info {} module-info + interp alias $slave module-whatis {} module-whatis + interp alias $slave set-alias {} set-alias + interp alias $slave unset-alias {} unset-alias + interp alias $slave uname {} uname + interp alias $slave x-resource {} x-resource + interp alias $slave module-version {} module-version + interp alias $slave module-alias {} module-alias + interp alias $slave reportInternalBug {} reportInternalBug + interp alias $slave reportWarning {} reportWarning + interp alias $slave report {} report + interp alias $slave isWin {} isWin + + interp eval $slave {global ModulesCurrentModulefile g_debug} + interp eval $slave [list "set" "ModulesCurrentModulefile" $modfile] + interp eval $slave [list "set" "g_debug" $g_debug] + interp eval $slave [list "set" "help" $help] - interp eval $slave {global ModulesCurrentModulefile g_debug} - interp eval $slave [list "global" "ModulesVersion"] - interp eval $slave [list "set" "ModulesCurrentModulefile" $modfile] - interp eval $slave [list "set" "g_debug" $g_debug] - interp eval $slave {set ModulesVersion {}} } - set ModulesVersion [interp eval $slave { - if [catch {source $ModulesCurrentModulefile} errorMsg] { - global errorInfo - reportInternalBug "occurred in file\ + set errorVal [interp eval $slave { + if {$g_debug} { + report "Sourcing $ModulesCurrentModulefile" + } + set sourceFailed [catch {source $ModulesCurrentModulefile} errorMsg] + if {$help != ""} { + if {[info procs "ModulesHelp"] == "ModulesHelp"} { + ModulesHelp + } else { + reportWarning "Unable to find ModulesHelp in\ + $ModulesCurrentModulefile." + } + set sourceFailed 0 + } + if {$sourceFailed} { + if {$errorMsg == "" && $errorInfo == ""} { + unset errorMsg + return 1 + } elseif [regexp "^WARNING" $errorMsg] { + reportWarning $errorMsg + return 1 + } else { + global errorInfo + reportInternalBug "ERROR occurred in file\ $ModulesCurrentModulefile:$errorInfo" - exit 1 - }\ - elseif [info exists ModulesVersion] { - return $ModulesVersion - } else { - return {} - } + exit 1 + } + } else { + unset errorMsg + return 0 + } }] interp delete $slave - - if {[file tail $modfile] == ".version"} { - # only set g_moduleDefault if .version file, - # otherwise any modulerc settings ala "module-version /xxx default" - # would get overwritten - set g_moduleDefault($modparent) $ModulesVersion + if {$g_debug} { + report "DEBUG Exiting $modfile" } + return $errorVal +} + +# Smaller subset than main module load... This function runs modulerc and +# .version files +proc execute-modulerc {modfile} { + global g_rcfilesSourced + global g_debug g_moduleDefault + global ModulesCurrentModulefile + if {$g_debug} { - report "DEBUG execute-version: Setting g_moduleDefault($modparent)\ - $ModulesVersion" + report "DEBUG execute-modulerc: $modfile" } - # Keep track of rc files we already sourced so we don't run them again - set g_rcfilesSourced($modfile) $ModulesVersion - } - return $g_rcfilesSourced($modfile) + set ModulesCurrentModulefile $modfile + + if {![checkValidModule $modfile]} { + reportInternalBug "+(0):ERROR:0: Magic cookie '#%Module' missing in '$modfile'" + return "" + } + + set modparent [file dirname $modfile] + + if {![info exists g_rcfilesSourced($modfile)]} { + if {$g_debug} { + report "DEBUG execute-modulerc: sourcing rc $modfile" + } + set slave __.modulerc + if {![interp exists $slave]} { + interp create $slave + interp alias $slave uname {} uname + interp alias $slave system {} system + interp alias $slave module-version {} module-version + interp alias $slave module-alias {} module-alias + interp alias $slave module {} module + interp alias $slave reportInternalBug {} reportInternalBug + + interp eval $slave {global ModulesCurrentModulefile g_debug} + interp eval $slave [list "global" "ModulesVersion"] + interp eval $slave [list "set" "ModulesCurrentModulefile" $modfile] + interp eval $slave [list "set" "g_debug" $g_debug] + interp eval $slave {set ModulesVersion {}} + } + set ModulesVersion [interp eval $slave { + if [catch {source $ModulesCurrentModulefile} errorMsg] { + global errorInfo + reportInternalBug "occurred in file $ModulesCurrentModulefile:$errorInfo" + exit 1 + } elseif [info exists ModulesVersion] { + return $ModulesVersion + } else { + return {} + } + }] + interp delete $slave + + if {[file tail $modfile] == ".version"} { + # only set g_moduleDefault if .version file, + # otherwise any modulerc settings ala "module-version /xxx default" + # would get overwritten + set g_moduleDefault($modparent) $ModulesVersion + } + + if {$g_debug} { + report "DEBUG execute-version: Setting g_moduleDefault($modparent) $ModulesVersion" + } + + # Keep track of rc files we already sourced so we don't run them again + set g_rcfilesSourced($modfile) $ModulesVersion + } + return $g_rcfilesSourced($modfile) } @@ -264,103 +259,102 @@ proc execute-modulerc {modfile} { set ModulesCurrentModulefile {} proc module-info {what {more {}}} { - global g_shellType g_shell g_debug tcl_platform - global g_moduleAlias g_symbolHash g_versionHash + global g_shellType g_shell g_debug tcl_platform + global g_moduleAlias g_symbolHash g_versionHash - set mode [currentMode] + set mode [currentMode] - if {$g_debug} { - report "DEBUG module-info: $what $more mode=$mode" - } + if {$g_debug} { + report "DEBUG module-info: $what $more mode=$mode" + } - switch -- $what { - "mode" { - if {$more != ""} { - if {$mode == $more} { - return 1 - } else { - return 0 + switch -- $what { + "mode" { + if {$more != ""} { + if {$mode == $more} { + return 1 + } else { + return 0 + } + } else { + return $mode + } + } + "name" - + "specified" { + return [currentModuleName] + } + "shell" { + return $g_shell + } + "flags" { + return 0 + } + "shelltype" { + return $g_shellType + } + "user" { + return $tcl_platform(user) + } + "alias" { + if {[info exists g_moduleAlias($more)]} { + return $g_moduleAlias($more) + } else { + return {} + } + } + "trace" { + return {} + } + "tracepat" { + return {} + } + "symbols" { + if {[regexp {^\/} $more]} { + set tmp [currentModuleName] + set tmp [file dirname $tmp] + set more "${tmp}$more" + } + if {[info exists g_symbolHash($more)]} { + return $g_symbolHash($more) + } else { + return {} + } + } + "version" { + if {[regexp {^\/} $more]} { + set tmp [currentModuleName] + set tmp [file dirname $tmp] + set more "${tmp}$more" + } + if {[info exists g_versionHash($more)]} { + return $g_versionHash($more) + } else { + return {} + } + } + default { + error "module-info $what not supported" + return {} } - } else { - return $mode - } } - "name" - - "specified" { - return [currentModuleName] - } - "shell" { - return $g_shell - } - "flags" { - return 0 - } - "shelltype" { - return $g_shellType - } - "user" { - return $tcl_platform(user) - } - "alias" { - if {[info exists g_moduleAlias($more)]} { - return $g_moduleAlias($more) - } else { - return {} - } - } - "trace" { - return {} - } - "tracepat" { - return {} - } - "symbols" { - if {[regexp {^\/} $more]} { - set tmp [currentModuleName] - set tmp [file dirname $tmp] - set more "${tmp}$more" - } - if {[info exists g_symbolHash($more)]} { - return $g_symbolHash($more) - } else { - return {} - } - } - "version" { - if {[regexp {^\/} $more]} { - set tmp [currentModuleName] - set tmp [file dirname $tmp] - set more "${tmp}$more" - } - if {[info exists g_versionHash($more)]} { - return $g_versionHash($more) - } else { - return {} - } - } - default { - error "module-info $what not supported" - return {} - } - } } proc module-whatis {message} { - global g_whatis g_debug + global g_whatis g_debug - set mode [currentMode] + set mode [currentMode] - if {$g_debug} { - report "DEBUG module-whatis: $message mode=$mode" - } + if {$g_debug} { + report "DEBUG module-whatis: $message mode=$mode" + } - if {$mode == "display"} { - report "module-whatis\t$message" - }\ - elseif {$mode == "whatis"} { - set g_whatis $message - } - return {} + if {$mode == "display"} { + report "module-whatis\t$message" + } elseif {$mode == "whatis"} { + set g_whatis $message + } + return {} } # Specifies a default or alias version for a module that points to an @@ -369,753 +363,728 @@ proc module-whatis {message} { # defaults from one directory will apply to modules of the same name found # in other directories. proc module-version {args} { - global g_moduleVersion g_versionHash - global g_moduleDefault - global g_debug - global ModulesCurrentModulefile + global g_moduleVersion g_versionHash + global g_moduleDefault + global g_debug + global ModulesCurrentModulefile - if {$g_debug} { - report "DEBUG module-version: executing module-version $args" - } - set module_name [lindex $args 0] - - # Check for shorthand notation of just a version "/version". Base is - # implied by current dir prepend the current directory to module_name - if {[regexp {^\/} $module_name]} { - set base [file dirname $ModulesCurrentModulefile] - set module_name "${base}$module_name" - } - - foreach version [lrange $args 1 end] { - - set base [file dirname $module_name] - set aliasversion [file tail $module_name] - - if {$base != ""} { - if {[string match $version "default"]} { - # If we see more than one default for the same module, just\ - keep the first - if {![info exists g_moduleDefault($base)]} { - set g_moduleDefault($base) $aliasversion - if {$g_debug} { - report "DEBUG module-version: default $base\ - =$aliasversion" - } - } - } else { - set aliasversion "$base/$version" - if {$g_debug} { - report "DEBUG module-version: alias $aliasversion =\ - $module_name" - } - set g_moduleVersion($aliasversion) $module_name - - if {[info exists g_versionHash($module_name)]} { - # don't add duplicates - if {[lsearch -exact $g_versionHash($module_name)\ - $aliasversion] < 0} { - set tmplist $g_versionHash($module_name) - set tmplist [linsert $tmplist end $aliasversion] - set g_versionHash($module_name) $tmplist - } - } else { - set g_versionHash($module_name) $aliasversion - } - } - - - if {$g_debug} { - report "DEBUG module-version: $aliasversion = $module_name" - } - } else { - error "module-version: module argument for default must not be\ - fully version qualified" + if {$g_debug} { + report "DEBUG module-version: executing module-version $args" } - } - if {[string match [currentMode] "display"]} { - report "module-version\t$args" - } - return {} + set module_name [lindex $args 0] + + # Check for shorthand notation of just a version "/version". Base is + # implied by current dir prepend the current directory to module_name + if {[regexp {^\/} $module_name]} { + set base [file dirname $ModulesCurrentModulefile] + set module_name "${base}$module_name" + } + + foreach version [lrange $args 1 end] { + + set base [file dirname $module_name] + set aliasversion [file tail $module_name] + + if {$base == ""} { + error "module-version: module argument for default must not be fully version qualified" + } + if {[string match $version "default"]} { + # If we see more than one default for the same module, just + # keep the first + if {![info exists g_moduleDefault($base)]} { + set g_moduleDefault($base) $aliasversion + if {$g_debug} { + report "DEBUG module-version: default $base = $aliasversion" + } + } + } else { + set aliasversion "$base/$version" + if {$g_debug} { + report "DEBUG module-version: alias $aliasversion = $module_name" + } + set g_moduleVersion($aliasversion) $module_name + + if {[info exists g_versionHash($module_name)]} { + # don't add duplicates + if {[lsearch -exact $g_versionHash($module_name)\ + $aliasversion] < 0} { + set tmplist $g_versionHash($module_name) + set tmplist [linsert $tmplist end $aliasversion] + set g_versionHash($module_name) $tmplist + } + } else { + set g_versionHash($module_name) $aliasversion + } + } + + if {$g_debug} { + report "DEBUG module-version: $aliasversion = $module_name" + } + } + if {[string match [currentMode] "display"]} { + report "module-version\t$args" + } + return {} } proc module-alias {args} { - global g_moduleAlias - global ModulesCurrentModulefile - global g_debug + global g_moduleAlias + global ModulesCurrentModulefile + global g_debug - set alias [lindex $args 0] - set module_file [lindex $args 1] + set alias [lindex $args 0] + set module_file [lindex $args 1] - if {$g_debug} { - report "DEBUG module-alias: $alias = $module_file" - } + if {$g_debug} { + report "DEBUG module-alias: $alias = $module_file" + } - set g_moduleAlias($alias) $module_file + set g_moduleAlias($alias) $module_file - if {[info exists g_aliasHash($module_file)]} { - set tmplist $g_aliasHash($module_file) - set tmplist [linsert $tmplist end $alias] - set g_aliasHash($module_file) $tmplist - } else { - set g_aliasHash($module_file) $alias - } + if {[info exists g_aliasHash($module_file)]} { + set tmplist $g_aliasHash($module_file) + set tmplist [linsert $tmplist end $alias] + set g_aliasHash($module_file) $tmplist + } else { + set g_aliasHash($module_file) $alias + } - if {[string match [currentMode] "display"]} { - report "module-alias\t$args" - } + if {[string match [currentMode] "display"]} { + report "module-alias\t$args" + } - return {} + return {} } proc module {command args} { - set mode [currentMode] - global g_debug + set mode [currentMode] + global g_debug - # Resolve any module aliases - if {$g_debug} { - report "DEBUG module: Resolving $args" - } - set args [resolveModuleVersionOrAlias $args] - if {$g_debug} { - report "DEBUG module: Resolved to $args" - } + # Resolve any module aliases + if {$g_debug} { + report "DEBUG module: Resolving $args" + } + set args [resolveModuleVersionOrAlias $args] + if {$g_debug} { + report "DEBUG module: Resolved to $args" + } - switch -- $command { - add - lo - - load { - if {$mode == "load"} { - eval cmdModuleLoad $args - }\ - elseif {$mode == "unload"} { - eval cmdModuleUnload $args - }\ - elseif {$mode == "display"} { - report "module load\t$args" - } - } - rm - unlo - - unload { - if {$mode == "load"} { - eval cmdModuleUnload $args - }\ - elseif {$mode == "unload"} { - eval cmdModuleUnload $args - }\ - elseif {$mode == "display"} { - report "module unload\t$args" - } - } - reload { - cmdModuleReload - } - use { - eval cmdModuleUse $args - } - unuse { - eval cmdModuleUnuse $args - } - source { - eval cmdModuleSource $args - } - switch - - swap { - eval cmdModuleSwitch $args - } - display - dis - - show { - eval cmdModuleDisplay $args - } - avail - av { - if {$args != ""} { - foreach arg $args { - cmdModuleAvail $arg + switch -- $command { + add - lo - + load { + if {$mode == "load"} { + eval cmdModuleLoad $args + }\ + elseif {$mode == "unload"} { + eval cmdModuleUnload $args + }\ + elseif {$mode == "display"} { + report "module load\t$args" + } } - } else { - cmdModuleAvail - # Not sure if this should be a part of cmdModuleAvail or not - cmdModuleAliases - } - } - aliases - al { - cmdModuleAliases - } - path { - eval cmdModulePath $args - } - paths { - eval cmdModulePaths $args - } - list { - cmdModuleList - } - whatis { - if {$args != ""} { - foreach arg $args { - cmdModuleWhatIs $arg + rm - unlo - + unload { + if {$mode == "load"} { + eval cmdModuleUnload $args + }\ + elseif {$mode == "unload"} { + eval cmdModuleUnload $args + }\ + elseif {$mode == "display"} { + report "module unload\t$args" + } + } + reload { + cmdModuleReload + } + use { + eval cmdModuleUse $args + } + unuse { + eval cmdModuleUnuse $args + } + source { + eval cmdModuleSource $args + } + switch - + swap { + eval cmdModuleSwitch $args + } + display - dis - + show { + eval cmdModuleDisplay $args + } + avail - av { + if {$args != ""} { + foreach arg $args { + cmdModuleAvail $arg + } + } else { + cmdModuleAvail + # Not sure if this should be a part of cmdModuleAvail or not + cmdModuleAliases + } + } + aliases - al { + cmdModuleAliases + } + path { + eval cmdModulePath $args + } + paths { + eval cmdModulePaths $args + } + list { + cmdModuleList + } + whatis { + if {$args != ""} { + foreach arg $args { + cmdModuleWhatIs $arg + } + } else { + cmdModuleWhatIs + } + } + apropos - search - + keyword { + eval cmdModuleApropos $args + } + purge { + eval cmdModulePurge + } + initadd { + eval cmdModuleInit add $args + } + initprepend { + eval cmdModuleInit prepend $args + } + initrm { + eval cmdModuleInit rm $args + } + initlist { + eval cmdModuleInit list $args + } + initclear { + eval cmdModuleInit clear $args + } + default { + error "module $command not understood" } - } else { - cmdModuleWhatIs - } } - apropos - search - - keyword { - eval cmdModuleApropos $args - } - purge { - eval cmdModulePurge - } - initadd { - eval cmdModuleInit add $args - } - initprepend { - eval cmdModuleInit prepend $args - } - initrm { - eval cmdModuleInit rm $args - } - initlist { - eval cmdModuleInit list $args - } - initclear { - eval cmdModuleInit clear $args - } - default { - error "module $command not understood" - } - } - return {} + return {} } proc setenv {var val} { - global g_stateEnvVars env g_debug - set mode [currentMode] + global g_stateEnvVars env g_debug + set mode [currentMode] - if {$g_debug} { - report "DEBUG setenv: ($var,$val) mode = $mode" - } + if {$g_debug} { + report "DEBUG setenv: ($var,$val) mode = $mode" + } - if {$mode == "load"} { - set env($var) $val - set g_stateEnvVars($var) "new" - }\ - elseif {$mode == "unload"} { - # Don't unset-env here ... it breaks modulefiles - # that use env(var) is later in the modulefile - #unset-env $var - set g_stateEnvVars($var) "del" - }\ - elseif {$mode == "display"} { - # Let display set the variable for later use in the display - # but don't commit it to the env - set env($var) $val - set g_stateEnvVars($var) "nop" - report "setenv\t\t$var\t$val" - } - return {} + if {$mode == "load"} { + set env($var) $val + set g_stateEnvVars($var) "new" + } elseif {$mode == "unload"} { + # Don't unset-env here ... it breaks modulefiles + # that use env(var) is later in the modulefile + #unset-env $var + set g_stateEnvVars($var) "del" + } elseif {$mode == "display"} { + # Let display set the variable for later use in the display + # but don't commit it to the env + set env($var) $val + set g_stateEnvVars($var) "nop" + report "setenv\t\t$var\t$val" + } + return {} } proc getenv {var} { - global g_debug - set mode [currentMode] + global g_debug + set mode [currentMode] - if {$g_debug} { - report "DEBUG getenv: ($var) mode = $mode" - } + if {$g_debug} { + report "DEBUG getenv: ($var) mode = $mode" + } - if {$mode == "load" || $mode == "unload"} { - if {[info exists env($var)]} { - return $::env($var) - } else { - return "_UNDEFINED_" - } - }\ - elseif {$mode == "display"} { - return "\$$var" - } - return {} + if {$mode == "load" || $mode == "unload"} { + if {[info exists env($var)]} { + return $::env($var) + } else { + return "_UNDEFINED_" + } + } elseif {$mode == "display"} { + return "\$$var" + } + return {} } proc unsetenv {var {val {}}} { - global g_stateEnvVars env g_debug - set mode [currentMode] + global g_stateEnvVars env g_debug + set mode [currentMode] - if {$g_debug} { - report "DEBUG unsetenv: ($var,$val) mode = $mode" - } + if {$g_debug} { + report "DEBUG unsetenv: ($var,$val) mode = $mode" + } - if {$mode == "load"} { - if {[info exists env($var)]} { - unset-env $var + if {$mode == "load"} { + if {[info exists env($var)]} { + unset-env $var + } + set g_stateEnvVars($var) "del" + } elseif {$mode == "unload"} { + if {$val != ""} { + set env($var) $val + set g_stateEnvVars($var) "new" + } + } elseif {$mode == "display"} { + report "unsetenv\t\t$var" } - set g_stateEnvVars($var) "del" - }\ - elseif {$mode == "unload"} { - if {$val != ""} { - set env($var) $val - set g_stateEnvVars($var) "new" - } - }\ - elseif {$mode == "display"} { - report "unsetenv\t\t$var" - } - return {} + return {} } ######################################################################## # path fiddling proc getReferenceCountArray {var separator} { - global env g_force g_def_separator g_debug + global env g_force g_def_separator g_debug - if {$g_debug} { - report "DEBUG getReferenceCountArray: ($var, $separator)" - } + if {$g_debug} { + report "DEBUG getReferenceCountArray: ($var, $separator)" + } - set sharevar "${var}_modshare" - set modshareok 1 - if {[info exists env($sharevar)]} { - if {[info exists env($var)]} { - set modsharelist [split $env($sharevar) $g_def_separator] - set temp [expr {[llength $modsharelist] % 2}] - if {$temp == 0} { - array set countarr $modsharelist + set sharevar "${var}_modshare" + set modshareok 1 + if {[info exists env($sharevar)]} { + if {[info exists env($var)]} { + set modsharelist [split $env($sharevar) $g_def_separator] + set temp [expr {[llength $modsharelist] % 2}] + if {$temp == 0} { + array set countarr $modsharelist - # sanity check the modshare list - array set fixers {} - array set usagearr {} - foreach dir [split $env($var) $separator] { - set usagearr($dir) 1 - } - foreach path [array names countarr] { - if {! [info exists usagearr($path)]} { - unset countarr($path) - set fixers($path) 1 - } - } + # sanity check the modshare list + array set fixers {} + array set usagearr {} + foreach dir [split $env($var) $separator] { + set usagearr($dir) 1 + } + foreach path [array names countarr] { + if {! [info exists usagearr($path)]} { + unset countarr($path) + set fixers($path) 1 + } + } - foreach path [array names usagearr] { - if {! [info exists countarr($path)]} { - set countarr($path) 999999999 - } - } + foreach path [array names usagearr] { + if {! [info exists countarr($path)]} { + set countarr($path) 999999999 + } + } - if {! $g_force} { - if {[array size fixers]} { - reportWarning "WARNING: \$$var does not agree with\ + if {! $g_force} { + if {[array size fixers]} { + reportWarning "WARNING: \$$var does not agree with\ \$${var}_modshare counter. The following\ directories' usage counters were adjusted to match.\ Note that this may mean that module unloading may\ not work correctly." - foreach dir [array names fixers] { - reportWarning " $dir" -nonewline + foreach dir [array names fixers] { + reportWarning " $dir" -nonewline + } + reportWarning "" + } + } + + } else { + # sharevar was corrupted, odd number of elements. + set modshareok 0 } - reportWarning "" - } - } - - } else { - # sharevar was corrupted, odd number of elements. - set modshareok 0 - } - } else { - if {$g_debug} { - reportWarning "WARNING: module: $sharevar exists (\ + } else { + if {$g_debug} { + reportWarning "WARNING: module: $sharevar exists (\ $env($sharevar) ), but $var doesn't. Environment is corrupted." - } - set modshareok 0 + } + set modshareok 0 + } + } else { + set modshareok 0 } - } else { - set modshareok 0 - } - if {$modshareok == 0 && [info exists env($var)]} { - array set countarr {} - foreach dir [split $env($var) $separator] { - set countarr($dir) 1 + if {$modshareok == 0 && [info exists env($var)]} { + array set countarr {} + foreach dir [split $env($var) $separator] { + set countarr($dir) 1 + } } - } - return [array get countarr] + return [array get countarr] } proc unload-path {var path separator} { - global g_stateEnvVars env g_force g_def_separator g_debug + global g_stateEnvVars env g_force g_def_separator g_debug - array set countarr [getReferenceCountArray $var $separator] + array set countarr [getReferenceCountArray $var $separator] - if {$g_debug} { - report "DEBUG unload-path: ($var, $path, $separator)" - } - - # Don't worry about dealing with this variable if it is already scheduled\ - for deletion - if {[info exists g_stateEnvVars($var)] && $g_stateEnvVars($var) == "del"} { - return {} - } - - foreach dir [split $path $separator] { - set doit 0 - - if {[info exists countarr($dir)]} { - incr countarr($dir) -1 - if {$countarr($dir) <= 0} { - set doit 1 - unset countarr($dir) - } - } else { - set doit 1 + if {$g_debug} { + report "DEBUG unload-path: ($var, $path, $separator)" } - if {$doit || $g_force} { - if {[info exists env($var)]} { - set dirs [split $env($var) $separator] - set newpath "" - foreach elem $dirs { - if {$elem != $dir} { - lappend newpath $elem - } - } - if {$newpath == ""} { - unset-env $var - set g_stateEnvVars($var) "del" + # Don't worry about dealing with this variable if it is already scheduled + # for deletion + if {[info exists g_stateEnvVars($var)] && $g_stateEnvVars($var) == "del"} { + return {} + } + + foreach dir [split $path $separator] { + set doit 0 + + if {[info exists countarr($dir)]} { + incr countarr($dir) -1 + if {$countarr($dir) <= 0} { + set doit 1 + unset countarr($dir) + } } else { - set env($var) [join $newpath $separator] - set g_stateEnvVars($var) "new" + set doit 1 } - } - } - } - set sharevar "${var}_modshare" - if {[array size countarr] > 0} { - set env($sharevar) [join [array get countarr] $g_def_separator] - set g_stateEnvVars($sharevar) "new" - } else { - unset-env $sharevar - set g_stateEnvVars($sharevar) "del" - } - return {} + if {$doit || $g_force} { + if {[info exists env($var)]} { + set dirs [split $env($var) $separator] + set newpath "" + foreach elem $dirs { + if {$elem != $dir} { + lappend newpath $elem + } + } + if {$newpath == ""} { + unset-env $var + set g_stateEnvVars($var) "del" + } else { + set env($var) [join $newpath $separator] + set g_stateEnvVars($var) "new" + } + } + } + } + + set sharevar "${var}_modshare" + if {[array size countarr] > 0} { + set env($sharevar) [join [array get countarr] $g_def_separator] + set g_stateEnvVars($sharevar) "new" + } else { + unset-env $sharevar + set g_stateEnvVars($sharevar) "del" + } + return {} } proc add-path {var path pos separator} { - global env g_stateEnvVars g_def_separator g_debug + global env g_stateEnvVars g_def_separator g_debug - if {$g_debug} { - report "DEBUG add-path: ($var, $path, $separator)" - } - - set sharevar "${var}_modshare" - array set countarr [getReferenceCountArray $var $separator] - - if {$pos == "prepend"} { - set pathelems [reverseList [split $path $separator]] - } else { - set pathelems [split $path $separator] - } - foreach dir $pathelems { - if {[info exists countarr($dir)]} { - # already see $dir in $var" - incr countarr($dir) - } else { - if {[info exists env($var)]} { - if {$pos == "prepend"} { - set env($var) "$dir$separator$env($var)" - }\ - elseif {$pos == "append"} { - set env($var) "$env($var)$separator$dir" - } else { - error "add-path doesn't support $pos" - } - } else { - set env($var) "$dir" - } - set countarr($dir) 1 + if {$g_debug} { + report "DEBUG add-path: ($var, $path, $separator)" + } + + set sharevar "${var}_modshare" + array set countarr [getReferenceCountArray $var $separator] + + if {$pos == "prepend"} { + set pathelems [reverseList [split $path $separator]] + } else { + set pathelems [split $path $separator] + } + foreach dir $pathelems { + if {[info exists countarr($dir)]} { + # already see $dir in $var" + incr countarr($dir) + } else { + if {[info exists env($var)]} { + if {$pos == "prepend"} { + set env($var) "$dir$separator$env($var)" + } elseif {$pos == "append"} { + set env($var) "$env($var)$separator$dir" + } else { + error "add-path doesn't support $pos" + } + } else { + set env($var) "$dir" + } + set countarr($dir) 1 + } + if {$g_debug} { + report "DEBUG add-path: env($var) = $env($var)" + } } - if {$g_debug} { - report "DEBUG add-path: env($var) = $env($var)" - } - } - set env($sharevar) [join [array get countarr] $g_def_separator] - set g_stateEnvVars($var) "new" - set g_stateEnvVars($sharevar) "new" - return {} + set env($sharevar) [join [array get countarr] $g_def_separator] + set g_stateEnvVars($var) "new" + set g_stateEnvVars($sharevar) "new" + return {} } proc prepend-path {var path args} { - global g_def_separator g_debug + global g_def_separator g_debug - set mode [currentMode] + set mode [currentMode] - if {$g_debug} { - report "DEBUG prepend-path: ($var, $path, $args) mode=$mode" - } + if {$g_debug} { + report "DEBUG prepend-path: ($var, $path, $args) mode=$mode" + } - if {[string match $var "-delim"]} { - set separator $path - set var [lindex $args 0] - set path [lindex $args 1] - } else { - set separator $g_def_separator - } + if {[string match $var "-delim"]} { + set separator $path + set var [lindex $args 0] + set path [lindex $args 1] + } else { + set separator $g_def_separator + } - if {$mode == "load"} { - add-path $var $path "prepend" $separator - }\ - elseif {$mode == "unload"} { - unload-path $var $path $separator - }\ - elseif {$mode == "display"} { - report "prepend-path\t$var\t$path" - } - return {} + if {$mode == "load"} { + add-path $var $path "prepend" $separator + } elseif {$mode == "unload"} { + unload-path $var $path $separator + } elseif {$mode == "display"} { + report "prepend-path\t$var\t$path" + } + return {} } proc append-path {var path args} { - global g_def_separator g_debug + global g_def_separator g_debug - set mode [currentMode] + set mode [currentMode] - if {$g_debug} { - report "DEBUG append-path: ($var, $path, $args) mode=$mode" - } + if {$g_debug} { + report "DEBUG append-path: ($var, $path, $args) mode=$mode" + } - if {[string match $var "-delim"]} { - set separator $path - set var [lindex $args 0] - set path [lindex $args 1] - } else { - set separator $g_def_separator - } + if {[string match $var "-delim"]} { + set separator $path + set var [lindex $args 0] + set path [lindex $args 1] + } else { + set separator $g_def_separator + } - if {$mode == "load"} { - add-path $var $path "append" $separator - }\ - elseif {$mode == "unload"} { - unload-path $var $path $separator - }\ - elseif {$mode == "display"} { - report "append-path\t$var\t$path" - } - return {} + if {$mode == "load"} { + add-path $var $path "append" $separator + } elseif {$mode == "unload"} { + unload-path $var $path $separator + } elseif {$mode == "display"} { + report "append-path\t$var\t$path" + } + return {} } proc remove-path {var path args} { - global g_def_separator g_debug + global g_def_separator g_debug - set mode [currentMode] + set mode [currentMode] - if {$g_debug} { - report "DEBUG remove-path: ($var, $path, $args) mode=$mode" - } + if {$g_debug} { + report "DEBUG remove-path: ($var, $path, $args) mode=$mode" + } - if {[string match $var "-delim"]} { - set separator $path - set var [lindex $args 0] - set path [lindex $args 1] - } else { - set separator $g_def_separator - } + if {[string match $var "-delim"]} { + set separator $path + set var [lindex $args 0] + set path [lindex $args 1] + } else { + set separator $g_def_separator + } - if {$mode == "load"} { - unload-path $var $path $separator - }\ - elseif {$mode == "display"} { - report "remove-path\t$var\t$path" - } - return {} + if {$mode == "load"} { + unload-path $var $path $separator + } elseif {$mode == "display"} { + report "remove-path\t$var\t$path" + } + return {} } proc set-alias {alias what} { - global g_Aliases g_stateAliases g_debug - set mode [currentMode] + global g_Aliases g_stateAliases g_debug + set mode [currentMode] - if {$g_debug} { - report "DEBUG set-alias: ($alias, $what) mode=$mode" - } - if {$mode == "load"} { - set g_Aliases($alias) $what - set g_stateAliases($alias) "new" - }\ - elseif {$mode == "unload"} { - set g_Aliases($alias) {} - set g_stateAliases($alias) "del" - }\ - elseif {$mode == "display"} { - report "set-alias\t$alias\t$what" - } - return {} + if {$g_debug} { + report "DEBUG set-alias: ($alias, $what) mode=$mode" + } + if {$mode == "load"} { + set g_Aliases($alias) $what + set g_stateAliases($alias) "new" + } elseif {$mode == "unload"} { + set g_Aliases($alias) {} + set g_stateAliases($alias) "del" + } elseif {$mode == "display"} { + report "set-alias\t$alias\t$what" + } + return {} } proc unset-alias {alias} { - global g_Aliases g_stateAliases g_debug - set mode [currentMode] + global g_Aliases g_stateAliases g_debug + set mode [currentMode] - if {$g_debug} { - report "DEBUG unset-alias: ($alias) mode=$mode" - } - if {$mode == "load"} { - set g_Aliases($alias) {} - set g_stateAliases($alias) "del" - }\ - elseif {$mode == "display"} { - report "unset-alias\t$alias" - } - return {} + if {$g_debug} { + report "DEBUG unset-alias: ($alias) mode=$mode" + } + if {$mode == "load"} { + set g_Aliases($alias) {} + set g_stateAliases($alias) "del" + } elseif {$mode == "display"} { + report "unset-alias\t$alias" + } + return {} } proc is-loaded {modulelist} { - global env g_def_separator g_debug + global env g_def_separator g_debug - if {$g_debug} { - report "DEBUG is-loaded: $modulelist" - } - - if {[llength $modulelist] > 0} { - if {[info exists env(LOADEDMODULES)]} { - foreach arg $modulelist { - set arg "$arg/" - foreach mod [split $env(LOADEDMODULES) $g_def_separator] { - set mod "$mod/" - if {[string first $arg $mod] == 0} { - return 1 - } - } - } - return 0 - } else { - return 0 + if {$g_debug} { + report "DEBUG is-loaded: $modulelist" } - } - return 1 + + if {[llength $modulelist] > 0} { + if {[info exists env(LOADEDMODULES)]} { + foreach arg $modulelist { + set arg "$arg/" + foreach mod [split $env(LOADEDMODULES) $g_def_separator] { + set mod "$mod/" + if {[string first $arg $mod] == 0} { + return 1 + } + } + } + return 0 + } else { + return 0 + } + } + return 1 } proc conflict {args} { - global ModulesCurrentModulefile g_debug - set mode [currentMode] - set currentModule [currentModuleName] + global ModulesCurrentModulefile g_debug + set mode [currentMode] + set currentModule [currentModuleName] - if {$g_debug} { - report "DEBUG conflict: ($args) mode = $mode" - } - - if {$mode == "load"} { - foreach mod $args { - # If the current module is already loaded, we can proceed - if {![is-loaded $currentModule]} { - # otherwise if the conflict module is loaded, we cannot - if {[is-loaded $mod]} { - set errMsg "WARNING: $currentModule cannot be loaded due\ - to a conflict." - set errMsg "$errMsg\nHINT: Might try \"module unload\ - $mod\" first." - error $errMsg - } - } + if {$g_debug} { + report "DEBUG conflict: ($args) mode = $mode" } - }\ - elseif {$mode == "display"} { - report "conflict\t$args" - } - return {} + + if {$mode == "load"} { + foreach mod $args { + # If the current module is already loaded, we can proceed + if {![is-loaded $currentModule]} { + # otherwise if the conflict module is loaded, we cannot + if {[is-loaded $mod]} { + set errMsg "WARNING: $currentModule cannot be loaded due\ + to a conflict." + set errMsg "$errMsg\nHINT: Might try \"module unload\ + $mod\" first." + error $errMsg + } + } + } + } elseif {$mode == "display"} { + report "conflict\t$args" + } + return {} } proc prereq {args} { - global g_debug - set mode [currentMode] - set currentModule [currentModuleName] + global g_debug + set mode [currentMode] + set currentModule [currentModuleName] - if {$g_debug} { - report "DEBUG prereq: ($args) mode = $mode" - } - - if {$mode == "load"} { - if {![is-loaded $args]} { - set errMsg "WARNING: $currentModule cannot be loaded due to\ - missing prereq." - set errMsg "$errMsg\nHINT: the following modules must be loaded\ - first: $args" - error $errMsg + if {$g_debug} { + report "DEBUG prereq: ($args) mode = $mode" } - }\ - elseif {$mode == "display"} { - report "prereq\t\t$args" - } - return {} + + if {$mode == "load"} { + if {![is-loaded $args]} { + set errMsg "WARNING: $currentModule cannot be loaded due to missing prereq." + set errMsg "$errMsg\nHINT: the following modules must be loaded first: $args" + error $errMsg + } + } elseif {$mode == "display"} { + report "prereq\t\t$args" + } + return {} } proc x-resource {resource {value {}}} { - global g_newXResources g_delXResources g_debug - set mode [currentMode] + global g_newXResources g_delXResources g_debug + set mode [currentMode] - if {$g_debug} { - report "DEBUG x-resource: ($resource, $value)" - } + if {$g_debug} { + report "DEBUG x-resource: ($resource, $value)" + } - if {$mode == "load"} { - set g_newXResources($resource) $value - }\ - elseif {$mode =="unload"} { - set g_delXResources($resource) 1 - }\ - elseif {$mode == "display"} { - report "x-resource\t$resource\t$value" - } - return {} + if {$mode == "load"} { + set g_newXResources($resource) $value + } elseif {$mode =="unload"} { + set g_delXResources($resource) 1 + } elseif {$mode == "display"} { + report "x-resource\t$resource\t$value" + } + return {} } proc uname {what} { - global unameCache tcl_platform g_debug - set result {} + global unameCache tcl_platform g_debug + set result {} - if {$g_debug} { - report "DEBUG uname: called: $what" - } - - if {! [info exists unameCache($what)]} { - switch -- $what { - sysname { - set result $tcl_platform(os) - } - machine { - set result $tcl_platform(machine) - } - nodename - - node { - set result [info hostname] - } - release { - # on ubuntu get the CODENAME of the Distribution - if { [file isfile /etc/lsb-release]} { - set fd [open "/etc/lsb-release" "r"] - set a [read $fd] - regexp -nocase {DISTRIB_CODENAME=(\S+)(.*)} $a matched res end - set result $res - } else { - set result $tcl_platform(osVersion) - } - } - domain { - set result [exec /bin/domainname] - } - version { - set result [exec /bin/uname -v] - } - default { - error "uname $what not supported" - } + if {$g_debug} { + report "DEBUG uname: called: $what" } - set unameCache($what) $result - } - return $unameCache($what) + if {! [info exists unameCache($what)]} { + switch -- $what { + sysname { + set result $tcl_platform(os) + } + machine { + set result $tcl_platform(machine) + } + nodename - + node { + set result [info hostname] + } + release { + # on ubuntu get the CODENAME of the Distribution + if { [file isfile /etc/lsb-release]} { + set fd [open "/etc/lsb-release" "r"] + set a [read $fd] + regexp -nocase {DISTRIB_CODENAME=(\S+)(.*)} $a matched res end + set result $res + } else { + set result $tcl_platform(osVersion) + } + } + domain { + set result [exec /bin/domainname] + } + version { + set result [exec /bin/uname -v] + } + default { + error "uname $what not supported" + } + } + set unameCache($what) $result + } + + return $unameCache($what) } ######################################################################## @@ -1124,48 +1093,48 @@ proc uname {what} { set g_modeStack {} proc currentMode {} { - global g_modeStack + global g_modeStack - set mode [lindex $g_modeStack end] - return $mode + set mode [lindex $g_modeStack end] + return $mode } proc pushMode {mode} { - global g_modeStack + global g_modeStack - lappend g_modeStack $mode + lappend g_modeStack $mode } proc popMode {} { - global g_modeStack + global g_modeStack - set len [llength $g_modeStack] - set len [expr {$len - 2}] - set g_modeStack [lrange $g_modeStack 0 $len] + set len [llength $g_modeStack] + set len [expr {$len - 2}] + set g_modeStack [lrange $g_modeStack 0 $len] } set g_moduleNameStack {} proc currentModuleName {} { - global g_moduleNameStack + global g_moduleNameStack - set moduleName [lindex $g_moduleNameStack end] - return $moduleName + set moduleName [lindex $g_moduleNameStack end] + return $moduleName } proc pushModuleName {moduleName} { - global g_moduleNameStack + global g_moduleNameStack - lappend g_moduleNameStack $moduleName + lappend g_moduleNameStack $moduleName } proc popModuleName {} { - global g_moduleNameStack + global g_moduleNameStack - set len [llength $g_moduleNameStack] - set len [expr {$len - 2}] - set g_moduleNameStack [lrange $g_moduleNameStack 0 $len] + set len [llength $g_moduleNameStack] + set len [expr {$len - 2}] + set g_moduleNameStack [lrange $g_moduleNameStack 0 $len] } @@ -1173,1230 +1142,1205 @@ proc popModuleName {} { # Resolve aliases and default versions if the module name is something like # "name/version" or just "name" (find default version). proc getPathToModule {mod {separator {}}} { - global env g_loadedModulesGeneric - global g_moduleAlias g_moduleVersion - global g_debug g_def_separator - global ModulesCurrentModulefile flag_default_mf flag_default_dir + global env g_loadedModulesGeneric + global g_moduleAlias g_moduleVersion + global g_debug g_def_separator + global ModulesCurrentModulefile flag_default_mf flag_default_dir - set retlist "" + set retlist "" - if {$mod == ""} { - return "" - } - - if {$separator == "" } { - set separator $g_def_separator - } - - if {$g_debug} { - report "DEBUG getPathToModule: Finding $mod" - } - - # Check for aliases -# This is already done at the root level so why do it again? -# set newmod [resolveModuleVersionOrAlias $mod] -# if {$newmod != $mod} { -# # Alias before ModulesVersion -# return [getPathToModule $newmod] -# } - - # Check for $mod specified as a full pathname - if {[string match {/*} $mod]} { - if {[file exists $mod]} { - if {[file readable $mod]} { - if {[file isfile $mod]} { - # note that a raw filename as an argument returns the full\ - path as the module name - if {[checkValidModule $mod]} { - return [list $mod $mod] - } else { - report "+(0):ERROR:0: Unable to locate a modulefile\ - for '$mod'" - return "" - } - } - } + if {$mod == ""} { + return "" + } + + if {$separator == "" } { + set separator $g_def_separator + } + + if {$g_debug} { + report "DEBUG getPathToModule: Finding $mod" + } + + # Check for aliases + # This is already done at the root level so why do it again? + # set newmod [resolveModuleVersionOrAlias $mod] + # if {$newmod != $mod} { + # # Alias before ModulesVersion + # return [getPathToModule $newmod] + # } + + # Check for $mod specified as a full pathname + if {[string match {/*} $mod]} { + if {[file exists $mod]} { + if {[file readable $mod]} { + if {[file isfile $mod]} { + # note that a raw filename as an argument returns the full + # path as the module name + if {[checkValidModule $mod]} { + return [list $mod $mod] + } else { + report "+(0):ERROR:0: Unable to locate a modulefile for '$mod'" + return "" + } + } + } + } + } elseif {![info exists env(MODULEPATH)]} { + error "\$MODULEPATH not defined" + return "" } - }\ - elseif {[info exists env(MODULEPATH)]} { # Now search for $mod in MODULEPATH foreach dir [split $env(MODULEPATH) $separator] { - set path "$dir/$mod" + set path "$dir/$mod" - # modparent is the the modulename minus the module version. - set modparent [file dirname $mod] - set modversion [file tail $mod] - # If $mod was specified without a version (no "/") then mod is\ - really modparent - if {$modparent == "."} { - set modparent $mod - } - set modparentpath "$dir/$modparent" - - - # Search the modparent directory for .modulerc files in case we\ - need to translate an alias - if {[file isdirectory $modparentpath]} { - # Execute any modulerc for this module - if {[file exists "$modparentpath/.modulerc"]} { - if {$g_debug} { - report "DEBUG getPathToModule: Found\ - $modparentpath/.modulerc" - } - execute-modulerc $modparentpath/.modulerc + # modparent is the the modulename minus the module version. + set modparent [file dirname $mod] + set modversion [file tail $mod] + # If $mod was specified without a version (no "/") then mod is + # really modparent + if {$modparent == "."} { + set modparent $mod } - # Check for an alias - set newmod [resolveModuleVersionOrAlias $mod] - if {$newmod != $mod} { - # Alias before ModulesVersion - return [getPathToModule $newmod] - } - } + set modparentpath "$dir/$modparent" - # Now check if the mod specified is a file or a directory - if {[file readable $path]} { + # Search the modparent directory for .modulerc files in case we + # need to translate an alias + if {[file isdirectory $modparentpath]} { + # Execute any modulerc for this module + if {[file exists "$modparentpath/.modulerc"]} { + if {$g_debug} { + report "DEBUG getPathToModule: Found $modparentpath/.modulerc" + } + execute-modulerc $modparentpath/.modulerc + } + # Check for an alias + set newmod [resolveModuleVersionOrAlias $mod] + if {$newmod != $mod} { + # Alias before ModulesVersion + return [getPathToModule $newmod] + } + } + + # Now check if the mod specified is a file or a directory + if {![file readable $path]} { + continue + } # If a directory, return the default if a .version file is # present or return the last file within the dir if {[file isdirectory $path]} { - set ModulesVersion "" - # Not an alias or version alias - check for a .version\ - file or find the default file - if {[info exists g_loadedModulesGeneric($mod)]} { - set ModulesVersion $g_loadedModulesGeneric($mod) - }\ - elseif {[file exists "$path/.version"] && ![file readable\ - "$path/.modulerc"]} { - # .version files aren't read if .modulerc present - if {$g_debug} { - report "DEBUG getPathToModule: Found $path/.version" + set ModulesVersion "" + # Not an alias or version alias - check for a .version\ + file or find the default file + if {[info exists g_loadedModulesGeneric($mod)]} { + set ModulesVersion $g_loadedModulesGeneric($mod) + } elseif {[file exists "$path/.version"] && ![file readable "$path/.modulerc"]} { + # .version files aren't read if .modulerc present + if {$g_debug} { + report "DEBUG getPathToModule: Found $path/.version" + } + set ModulesVersion [execute-modulerc "$path/.version"] } - set ModulesVersion [execute-modulerc "$path/.version"] - } - # Try for the last file in directory if no luck so far - if {$ModulesVersion == ""} { - set modlist [listModules $path "" 0 "-dictionary" 0 0] - set ModulesVersion [lindex $modlist end] - if {$g_debug} { - report "DEBUG getPathToModule: Found\ - $ModulesVersion in $path" + # Try for the last file in directory if no luck so far + if {$ModulesVersion == ""} { + set modlist [listModules $path "" 0 "-dictionary" 0 0] + set ModulesVersion [lindex $modlist end] + if {$g_debug} { + report "DEBUG getPathToModule: Found $ModulesVersion in $path" + } } - } - if {$ModulesVersion != ""} { - # The path to the module file - set verspath "$path/$ModulesVersion" - # The modulename (name + version) - set versmod "$mod/$ModulesVersion" - set retlist [list $verspath $versmod] - } + if {$ModulesVersion != ""} { + # The path to the module file + set verspath "$path/$ModulesVersion" + # The modulename (name + version) + set versmod "$mod/$ModulesVersion" + set retlist [list $verspath $versmod] + } } else { - # If mod was a file in this path, try and return that file - set retlist [list $path $mod] + # If mod was a file in this path, try and return that file + set retlist [list $path $mod] } # We may have a winner, check validity of result if {[llength $retlist] == 2} { - # Check to see if we've found only a directory. If so,\ - keep looking - if {[file isdirectory [lindex $retlist 0]]} { - set retlist [getPathToModule [lindex $retlist 1]] - } - - if {! [checkValidModule [lindex $retlist 0]]} { - set path [lindex $retlist 0] - } else { - return $retlist - } + # Check to see if we've found only a directory. If so, + # keep looking + if {[file isdirectory [lindex $retlist 0]]} { + set retlist [getPathToModule [lindex $retlist 1]] + } + + if {! [checkValidModule [lindex $retlist 0]]} { + set path [lindex $retlist 0] + } else { + return $retlist + } } - } - # File wasn't readable, go to next path } # End of of foreach loop report "+(0):ERROR:0: Unable to locate a modulefile for '$mod'" return "" - } else { - error "\$MODULEPATH not defined" - return "" - } } proc runModulerc {} { - # Runs the global RC files if they exist - global env g_debug + # Runs the global RC files if they exist + global env g_debug - if {$g_debug} { - report "DEBUG runModulerc: running..." - report "DEBUG runModulerc: env MODULESHOME = $env(MODULESHOME)" - report "DEBUG runModulerc: env HOME = $env(HOME)" - } - if {[info exists env(MODULERCFILE)]} { - if {[file readable $env(MODULERCFILE)]} { - if {$g_debug} { - report "DEBUG runModulerc: Executing $env(MODULERCFILE)" - } - cmdModuleSource $env(MODULERCFILE) + if {$g_debug} { + report "DEBUG runModulerc: running..." + report "DEBUG runModulerc: env MODULESHOME = $env(MODULESHOME)" + report "DEBUG runModulerc: env HOME = $env(HOME)" } - } - if {[info exists env(MODULESHOME)]} { - if {[file readable "$env(MODULESHOME)/etc/rc"]} { - if {$g_debug} { - report "DEBUG runModulerc: Executing $env(MODULESHOME)/etc/rc" - } - cmdModuleSource "$env(MODULESHOME)/etc/rc" + if {[info exists env(MODULERCFILE)]} { + if {[file readable $env(MODULERCFILE)]} { + if {$g_debug} { + report "DEBUG runModulerc: Executing $env(MODULERCFILE)" + } + cmdModuleSource $env(MODULERCFILE) + } } - } - if {[info exists env(HOME)]} { - if {[file readable "$env(HOME)/.modulerc"]} { - if {$g_debug} { - report "DEBUG runModulerc: Executing $env(HOME)/.modulerc" - } - cmdModuleSource "$env(HOME)/.modulerc" + if {[info exists env(MODULESHOME)]} { + if {[file readable "$env(MODULESHOME)/etc/rc"]} { + if {$g_debug} { + report "DEBUG runModulerc: Executing $env(MODULESHOME)/etc/rc" + } + cmdModuleSource "$env(MODULESHOME)/etc/rc" + } + } + if {[info exists env(HOME)]} { + if {[file readable "$env(HOME)/.modulerc"]} { + if {$g_debug} { + report "DEBUG runModulerc: Executing $env(HOME)/.modulerc" + } + cmdModuleSource "$env(HOME)/.modulerc" + } } - } } proc saveSettings {} { - foreach var {env g_Aliases g_stateEnvVars g_stateAliases g_newXResource\ - g_delXResource} { - eval "global g_SAVE_$var $var" - eval "array set g_SAVE_$var \[array get $var\]" - } + foreach var {env g_Aliases g_stateEnvVars g_stateAliases g_newXResource g_delXResource} { + eval "global g_SAVE_$var $var" + eval "array set g_SAVE_$var \[array get $var\]" + } } proc restoreSettings {} { - foreach var {env g_Aliases g_stateEnvVars g_stateAliases g_newXResource\ - g_delXResource} { - eval "global g_SAVE_$var $var" - eval "array set $var \[array get g_SAVE_$var\]" - } + foreach var {env g_Aliases g_stateEnvVars g_stateAliases g_newXResource g_delXResource} { + eval "global g_SAVE_$var $var" + eval "array set $var \[array get g_SAVE_$var\]" + } } proc renderSettings {} { - global env g_Aliases g_shellType g_shell - global g_stateEnvVars g_stateAliases - global g_newXResources g_delXResources - global g_pathList g_systemList error_count - global g_autoInit CSH_LIMIT g_debug + global env g_Aliases g_shellType g_shell + global g_stateEnvVars g_stateAliases + global g_newXResources g_delXResources + global g_pathList g_systemList error_count + global g_autoInit CSH_LIMIT g_debug + + if {$g_debug} { + report "DEBUG renderSettings: called." + } - if {$g_debug} { - report "DEBUG renderSettings: called." - } + set iattempt 0 - set iattempt 0 - - # required to work on cygwin, shouldn't hurt real linux - fconfigure stdout -translation lf + # required to work on cygwin, shouldn't hurt real linux + fconfigure stdout -translation lf # preliminaries - + switch -- $g_shellType { - python { - puts stdout "import os" - } + python { + puts stdout "import os" + } } if {$g_autoInit} { - global argv0 + global argv0 - # automatically detect which tclsh should be used for future module commands - set tclshbin [info nameofexecutable] + # automatically detect which tclsh should be used for future module commands + set tclshbin [info nameofexecutable] - # add cwd if not absolute script path - if {! [regexp {^/} $argv0]} { - set pwd [exec pwd] - set argv0 "$pwd/$argv0" - } + # add cwd if not absolute script path + if {! [regexp {^/} $argv0]} { + set pwd [exec pwd] + set argv0 "$pwd/$argv0" + } - set env(MODULESHOME) [file dirname $argv0] - set g_stateEnvVars(MODULESHOME) "new" + set env(MODULESHOME) [file dirname $argv0] + set g_stateEnvVars(MODULESHOME) "new" - switch -- $g_shellType { - csh { - puts stdout "if ( \$?histchars ) then" - puts stdout " set _histchars = \$histchars" - puts stdout " if (\$?prompt) then" - puts stdout " alias module 'unset histchars;set\ + switch -- $g_shellType { + csh { + puts stdout "if ( \$?histchars ) then" + puts stdout " set _histchars = \$histchars" + puts stdout " if (\$?prompt) then" + puts stdout " alias module 'unset histchars;set\ _prompt=\"\$prompt\";eval `'$tclshbin' '$argv0' '$g_shell' \\!*`;set\ histchars = \$_histchars; set prompt=\"\$_prompt\";unset\ _prompt'" - puts stdout " else" - puts stdout " alias module 'unset histchars;eval `'$tclshbin' '$argv0'\ + puts stdout " else" + puts stdout " alias module 'unset histchars;eval `'$tclshbin' '$argv0'\ '$g_shell' \\!*`;set histchars = \$_histchars'" - puts stdout " endif" - puts stdout "else" - puts stdout " if (\$?prompt) then" - puts stdout " alias module 'set _prompt=\"\$prompt\";set\ + puts stdout " endif" + puts stdout "else" + puts stdout " if (\$?prompt) then" + puts stdout " alias module 'set _prompt=\"\$prompt\";set\ prompt=\"\";eval `'$tclshbin' '$argv0' '$g_shell' \\!*`;set\ prompt=\"\$_prompt\";unset _prompt'" - puts stdout " else" - puts stdout " alias module 'eval `'$tclshbin' '$argv0' '$g_shell' \\!*`'" - puts stdout " endif" - puts stdout "endif" - } - sh { - puts stdout "module () { eval `'$tclshbin' '$argv0' '$g_shell' \$*`; } ;" - } - cmd { - puts stdout "start /b \%MODULESHOME\%/init/module.cmd %*" - } - perl { - puts stdout "sub module {" - puts stdout " eval `$tclshbin \$ENV{\'MODULESHOME\'}/modulecmd.tcl perl @_`;" - puts stdout " if(\$@) {" - puts stdout " use Carp;" - puts stdout " confess \"module-error: \$@\n\";" - puts stdout " }" - puts stdout " return 1;" - puts stdout "}" - } - python { - puts stdout "import subprocess" - puts stdout "def module(command, *arguments):" - puts stdout " exec subprocess.Popen(\['$tclshbin', '$argv0', 'python', command\] \ + puts stdout " else" + puts stdout " alias module 'eval `'$tclshbin' '$argv0' '$g_shell' \\!*`'" + puts stdout " endif" + puts stdout "endif" + } + sh { + puts stdout "module () { eval `'$tclshbin' '$argv0' '$g_shell' \$*`; } ;" + } + cmd { + puts stdout "start /b \%MODULESHOME\%/init/module.cmd %*" + } + perl { + puts stdout "sub module {" + puts stdout " eval `$tclshbin \$ENV{\'MODULESHOME\'}/modulecmd.tcl perl @_`;" + puts stdout " if(\$@) {" + puts stdout " use Carp;" + puts stdout " confess \"module-error: \$@\n\";" + puts stdout " }" + puts stdout " return 1;" + puts stdout "}" + } + python { + puts stdout "import subprocess" + puts stdout "def module(command, *arguments):" + puts stdout " exec subprocess.Popen(\['$tclshbin', '$argv0', 'python', command\] \ list(arguments), stdout=subprcess.PIPE).communicate()\[0\]" + } + lisp { + error "ERROR: XXX lisp mode autoinit not yet implemented" + } } - lisp { - error "ERROR: XXX lisp mode autoinit not yet implemented" - } - } - if {[file exists "$env(MODULESHOME)/modulerc"]} { - cmdModuleSource "$env(MODULESHOME)/modulerc" - } - if {[file exists "$env(MODULESHOME)/init/modulerc"]} { - cmdModuleSource "$env(MODULESHOME)/init/modulerc" - } + if {[file exists "$env(MODULESHOME)/modulerc"]} { + cmdModuleSource "$env(MODULESHOME)/modulerc" + } + if {[file exists "$env(MODULESHOME)/init/modulerc"]} { + cmdModuleSource "$env(MODULESHOME)/init/modulerc" + } } # new environment variables foreach var [array names g_stateEnvVars] { - if {$g_stateEnvVars($var) == "new"} { - switch -- $g_shellType { - csh { - set val [multiEscaped $env($var)] - # csh barfs on long env vars - if {$g_shell == "csh" && [string length $val] >\ - $CSH_LIMIT} { - if {$var == "PATH"} { - reportWarning "WARNING: module: PATH exceeds\ + if {$g_stateEnvVars($var) == "new"} { + switch -- $g_shellType { + csh { + set val [multiEscaped $env($var)] + # csh barfs on long env vars + if {$g_shell == "csh" && [string length $val] >\ + $CSH_LIMIT} { + if {$var == "PATH"} { + reportWarning "WARNING: module: PATH exceeds\ $CSH_LIMIT characters, truncating and\ appending /usr/bin:/bin ..." - set val [string range $val 0 [expr {$CSH_LIMIT\ - - 1}]]:/usr/bin:/bin - } else { - reportWarning "WARNING: module: $var exceeds\ + set val [string range $val 0 [expr {$CSH_LIMIT\ + - 1}]]:/usr/bin:/bin + } else { + reportWarning "WARNING: module: $var exceeds\ $CSH_LIMIT characters, truncating..." - set val [string range $val 0 [expr {$CSH_LIMIT\ - - 1}]] - } + set val [string range $val 0 [expr {$CSH_LIMIT\ + - 1}]] + } + } + puts stdout "setenv $var $val;" + } + sh { + puts stdout "$var=[multiEscaped $env($var)]; export $var;" + } + perl { + set val [doubleQuoteEscaped $env($var)] + set val [atSymbolEscaped $env($var)] + puts stdout "\$ENV{\'$var\'} = \'$val\';" + } + python { + set val [singleQuoteEscaped $env($var)] + puts stdout "os.environ\['$var'\] = '$val'" + } + lisp { + set val [doubleQuoteEscaped $env($var)] + puts stdout "(setenv \"$var\" \"$val\")" + } + cmd { + set val $env($var) + puts stdout "set $var=$val" + } + } + } elseif {$g_stateEnvVars($var) == "del"} { + switch -- $g_shellType { + csh { + puts stdout "unsetenv $var;" + } + sh { + puts stdout "unset $var;" + } + cmd { + puts stdout "set $var=" + } + perl { + puts stdout "delete \$ENV{\'$var\'};" + } + python { + puts stdout "os.environ\['$var'\] = ''" + puts stdout "del os.environ\['$var'\]" + } + lisp { + puts stdout "(setenv \"$var\" nil)" + } } - puts stdout "setenv $var $val;" - } - sh { - puts stdout "$var=[multiEscaped $env($var)]; export $var;" - } - perl { - set val [doubleQuoteEscaped $env($var)] - set val [atSymbolEscaped $env($var)] - puts stdout "\$ENV{\'$var\'} = \'$val\';" - } - python { - set val [singleQuoteEscaped $env($var)] - puts stdout "os.environ\['$var'\] = '$val'" - } - lisp { - set val [doubleQuoteEscaped $env($var)] - puts stdout "(setenv \"$var\" \"$val\")" - } - cmd { - set val $env($var) - puts stdout "set $var=$val" - } } - } elseif {$g_stateEnvVars($var) == "del"} { - switch -- $g_shellType { - csh { - puts stdout "unsetenv $var;" - } - sh { - puts stdout "unset $var;" - } - cmd { - puts stdout "set $var=" - } - perl { - puts stdout "delete \$ENV{\'$var\'};" - } - python { - puts stdout "os.environ\['$var'\] = ''" - puts stdout "del os.environ\['$var'\]" - } - lisp { - puts stdout "(setenv \"$var\" nil)" - } - } - } } foreach var [array names g_stateAliases] { - if {$g_stateAliases($var) == "new"} { - switch -- $g_shellType { - csh { - # set val [multiEscaped $g_Aliases($var)] - set val $g_Aliases($var) - # Convert $n -> \!\!:n - regsub -all {\$([0-9]+)} $val {\\!\\!:\1} val - # Convert $* -> \!* - regsub -all {\$\*} $val {\\!*} val - puts stdout "alias $var '$val';" - } - sh { - set val $g_Aliases($var) - puts stdout "alias $var=\'$val\';" - } - } - } elseif {$g_stateAliases($var) == "del"} { - switch -- $g_shellType { - csh { - puts stdout "unalias $var;" - } - sh { - puts stdout "unalias $var;" - } - } - } + if {$g_stateAliases($var) == "new"} { + switch -- $g_shellType { + csh { + # set val [multiEscaped $g_Aliases($var)] + set val $g_Aliases($var) + # Convert $n -> \!\!:n + regsub -all {\$([0-9]+)} $val {\\!\\!:\1} val + # Convert $* -> \!* + regsub -all {\$\*} $val {\\!*} val + puts stdout "alias $var '$val';" + } + sh { + set val $g_Aliases($var) + puts stdout "alias $var=\'$val\';" + } + } + } elseif {$g_stateAliases($var) == "del"} { + switch -- $g_shellType { + csh { + puts stdout "unalias $var;" + } + sh { + puts stdout "unalias $var;" + } + } + } } # new x resources if {[array size g_newXResources] > 0} { - set xrdb [findExecutable "xrdb"] - foreach var [array names g_newXResources] { - set val $g_newXResources($var) - if {$val == ""} { - switch -regexp -- $g_shellType { - {^(csh|sh)$} { - if {[file exists $var]} { - puts stdout "$xrdb -merge $var;" - } else { - puts stdout "$xrdb -merge < 0} { - set xrdb [findExecutable "xrdb"] - foreach var [array names g_delXResources] { - if {$val == ""} { - # do nothing - } else { - puts stdout "xrdb -remove < 0} { - reportWarning "ERROR: $error_count error(s) detected." - switch -- $g_shellType { - csh { - puts stdout "/bin/false;" - } - sh { - puts stdout "/bin/false;" - } - cmd { - # nothing needed, reserve for future cygwin, MKS, etc - } - perl { - puts stdout "die \"modulefile.tcl: $error_count error(s)\ + reportWarning "ERROR: $error_count error(s) detected." + switch -- $g_shellType { + csh { + puts stdout "/bin/false;" + } + sh { + puts stdout "/bin/false;" + } + cmd { + # nothing needed, reserve for future cygwin, MKS, etc + } + perl { + puts stdout "die \"modulefile.tcl: $error_count error(s)\ detected!\\n\"" - } - python { - puts stdout "raise RuntimeError, 'modulefile.tcl: $error_count error(s) detected!'" - } - lisp { - puts stdout "(error \"modulefile.tcl: $error_count error(s)\ + } + python { + puts stdout "raise RuntimeError, 'modulefile.tcl: $error_count error(s) detected!'" + } + lisp { + puts stdout "(error \"modulefile.tcl: $error_count error(s)\ detected!\")" + } } - } - set nop 0 + set nop 0 } else { - switch -- $g_shellType { - perl { - puts stdout "1;" + switch -- $g_shellType { + perl { + puts stdout "1;" + } } - } } if {$nop} { - # nothing written! - switch -- $g_shellType { - csh { - puts "/bin/true;" + # nothing written! + switch -- $g_shellType { + csh { + puts "/bin/true;" + } + sh { + puts "/bin/true;" + } + cmd { + # nothing needed, reserve for future cygwin, MKS, etc + } + perl { + puts "1;" + } + python { + # this is not correct + puts "" + } + lisp { + puts "t" + } } - sh { - puts "/bin/true;" - } - cmd { - # nothing needed, reserve for future cygwin, MKS, etc - } - perl { - puts "1;" - } - python { - # this is not correct - puts "" - } - lisp { - puts "t" - } - } } else { } } proc cacheCurrentModules {{separator {}}} { - global g_loadedModules g_loadedModulesGeneric env g_def_separator g_debug + global g_loadedModules g_loadedModulesGeneric env g_def_separator g_debug - - if {$g_debug} { - report "DEBUG cacheCurrentModules: ($separator)" - } - - if {$separator == "" } { - set separator $g_def_separator - } - - # mark specific as well as generic modules as loaded - if {[info exists env(LOADEDMODULES)]} { - foreach mod [split $env(LOADEDMODULES) $separator] { - set g_loadedModules($mod) 1 - set g_loadedModulesGeneric([file dirname $mod]) [file tail $mod] + if {$g_debug} { + report "DEBUG cacheCurrentModules: ($separator)" + } + + if {$separator == "" } { + set separator $g_def_separator + } + + # mark specific as well as generic modules as loaded + if {[info exists env(LOADEDMODULES)]} { + foreach mod [split $env(LOADEDMODULES) $separator] { + set g_loadedModules($mod) 1 + set g_loadedModulesGeneric([file dirname $mod]) [file tail $mod] + } } - } } -# This proc resolves module aliases or version aliases to the real module name\ - and version +# This proc resolves module aliases or version aliases to the real module name +# and version proc resolveModuleVersionOrAlias {names} { - global g_moduleVersion g_moduleDefault g_moduleAlias g_debug + global g_moduleVersion g_moduleDefault g_moduleAlias g_debug - if {$g_debug} { - report "DEBUG resolveModuleVersionOrAlias: Resolving $names" - } - set ret_list {} + if {$g_debug} { + report "DEBUG resolveModuleVersionOrAlias: Resolving $names" + } + set ret_list {} - foreach name $names { - # Chop off (default) if it exists - set x [expr {[string length $name] - 9}] - if {($x > 0) &&([string range $name $x end] == "\(default\)")} { - set name [string range $name 0 [expr {$x -1}]] - if {$g_debug} { - report "DEBUG resolveModuleVersionOrAlias: trimming name =\ - \"$name\"" - } + foreach name $names { + # Chop off (default) if it exists + set x [expr {[string length $name] - 9}] + if {($x > 0) &&([string range $name $x end] == "\(default\)")} { + set name [string range $name 0 [expr {$x -1}]] + if {$g_debug} { + report "DEBUG resolveModuleVersionOrAlias: trimming name = \"$name\"" + } + } + if {[info exists g_moduleAlias($name)]} { + # if the alias is another alias, we need to resolve it + if {$g_debug} { + report "DEBUG resolveModuleVersionOrAlias: $name is an alias" + } + set ret_list [linsert $ret_list end\ + [resolveModuleVersionOrAlias $g_moduleAlias($name)]] + } elseif {[info exists g_moduleVersion($name)]} { + # if the pseudo version is an alias, we need to resolve it + if {$g_debug} { + report "DEBUG resolveModuleVersionOrAlias: $name is a version alias" + } + set ret_list [linsert $ret_list end\ + [resolveModuleVersionOrAlias $g_moduleVersion($name)]] + } elseif {[info exists g_moduleDefault($name)]} { + # if the default is an alias, we need to resolve it + if {$g_debug} { + report "DEBUG resolveModuleVersionOrAlias: found a default for $name" + } + set ret_list [linsert $ret_list end [resolveModuleVersionOrAlias\ + "$name/$g_moduleDefault($name)"]] + } else { + if {$g_debug} { + report "DEBUG resolveModuleVersionOrAlias: $name is nothing special" + } + set ret_list [linsert $ret_list end $name] + } } - if {[info exists g_moduleAlias($name)]} { - # if the alias is another alias, we need to resolve it - if {$g_debug} { - report "DEBUG resolveModuleVersionOrAlias: $name is an alias" - } - set ret_list [linsert $ret_list end\ - [resolveModuleVersionOrAlias $g_moduleAlias($name)]] - }\ - elseif {[info exists g_moduleVersion($name)]} { - # if the pseudo version is an alias, we need to resolve it - if {$g_debug} { - report "DEBUG resolveModuleVersionOrAlias: $name is a version\ - alias" - } - set ret_list [linsert $ret_list end\ - [resolveModuleVersionOrAlias $g_moduleVersion($name)]] - }\ - elseif {[info exists g_moduleDefault($name)]} { - # if the default is an alias, we need to resolve it - if {$g_debug} { - report "DEBUG resolveModuleVersionOrAlias: found a default for\ - $name" - } - set ret_list [linsert $ret_list end [resolveModuleVersionOrAlias\ - "$name/$g_moduleDefault($name)"]] - } else { - if {$g_debug} { - report "DEBUG resolveModuleVersionOrAlias: $name is nothing\ - special" - } - set ret_list [linsert $ret_list end $name] + if {$g_debug} { + report "DEBUG resolveModuleVersionOrAlias: Resolved to $ret_list" } - } - if {$g_debug} { - report "DEBUG resolveModuleVersionOrAlias: Resolved to $ret_list" - } - return $ret_list + return $ret_list } proc spaceEscaped {text} { - regsub -all " " $text "\\ " regsub_tmpstrg - return $regsub_tmpstrg + regsub -all " " $text "\\ " regsub_tmpstrg + return $regsub_tmpstrg } proc multiEscaped {text} { - regsub -all {([ \\\t\{\}|<>!;#^$&*"'`()])} $text {\\\1} regsub_tmpstrg - return $regsub_tmpstrg + regsub -all {([ \\\t\{\}|<>!;#^$&*"'`()])} $text {\\\1} regsub_tmpstrg + return $regsub_tmpstrg } proc doubleQuoteEscaped {text} { - regsub -all "\"" $text "\\\"" regsub_tmpstrg - return $regsub_tmpstrg + regsub -all "\"" $text "\\\"" regsub_tmpstrg + return $regsub_tmpstrg } proc atSymbolEscaped {text} { - regsub -all "@" $text "\\@" regsub_tmpstrg - return $regsub_tmpstrg + regsub -all "@" $text "\\@" regsub_tmpstrg + return $regsub_tmpstrg } proc singleQuoteEscaped {text} { - regsub -all "\'" $text "\\\'" regsub_tmpstrg - return $regsub_tmpstrg + regsub -all "\'" $text "\\\'" regsub_tmpstrg + return $regsub_tmpstrg } proc findExecutable {cmd} { - foreach dir {/usr/X11R6/bin /usr/openwin/bin /usr/bin/X11} { - if {[file executable "$dir/$cmd"]} { - return "$dir/$cmd" + foreach dir {/usr/X11R6/bin /usr/openwin/bin /usr/bin/X11} { + if {[file executable "$dir/$cmd"]} { + return "$dir/$cmd" + } } - } - return $cmd + return $cmd } proc reverseList {list} { - set newlist {} + set newlist {} - foreach item $list { - set newlist [linsert $newlist 0 $item] - } - return $newlist + foreach item $list { + set newlist [linsert $newlist 0 $item] + } + return $newlist } proc replaceFromList {list1 item {item2 {}}} { - set xi [lsearch -exact $list1 $item] + set xi [lsearch -exact $list1 $item] - while {$xi >= 0} { - if {[string length $item2] == 0} { - set list1 [lreplace $list1 $xi $xi] - } else { - set list1 [lreplace $list1 $xi $xi $item2] - } - set xi [lsearch -exact $list1 $item] - } + while {$xi >= 0} { + if {[string length $item2] == 0} { + set list1 [lreplace $list1 $xi $xi] + } else { + set list1 [lreplace $list1 $xi $xi $item2] + } + set xi [lsearch -exact $list1 $item] + } - return $list1 + return $list1 } proc checkValidModule {modfile} { - global g_debug + global g_debug - if {$g_debug} { - report "DEBUG checkValidModule: $modfile" - } - - # Check for valid module - if {![catch {open $modfile r} fileId]} { - gets $fileId first_line - close $fileId - if {[string first "\#%Module" $first_line] == 0} { - return 1 + if {$g_debug} { + report "DEBUG checkValidModule: $modfile" } - } - return 0 + + # Check for valid module + if {![catch {open $modfile r} fileId]} { + gets $fileId first_line + close $fileId + if {[string first "\#%Module" $first_line] == 0} { + return 1 + } + } + return 0 } # If given module maps to default or other version aliases, a list of # those aliases is returned. This takes the full path to a module as # an argument. proc getVersAliasList {modulename} { - global g_versionHash g_moduleDefault g_debug + global g_versionHash g_moduleDefault g_debug - if {$g_debug} { - report "DEBUG getVersAliasList: $modulename" - } - - set modparent [file dirname $modulename] - - set tag_list {} - if {[info exists g_versionHash($modulename)]} { - # remove module basenames to get just version names - foreach version $g_versionHash($modulename) { - set alias_tag [file tail $version] - set tag_list [linsert $tag_list end $alias_tag] + if {$g_debug} { + report "DEBUG getVersAliasList: $modulename" } - } - if {[info exists g_moduleDefault($modparent)]} { - set tmp_name "$modparent/$g_moduleDefault($modparent)" - if {$tmp_name == $modulename} { - set tag_list [linsert $tag_list end "default"] + + set modparent [file dirname $modulename] + + set tag_list {} + if {[info exists g_versionHash($modulename)]} { + # remove module basenames to get just version names + foreach version $g_versionHash($modulename) { + set alias_tag [file tail $version] + set tag_list [linsert $tag_list end $alias_tag] + } } - } - return $tag_list + if {[info exists g_moduleDefault($modparent)]} { + set tmp_name "$modparent/$g_moduleDefault($modparent)" + if {$tmp_name == $modulename} { + set tag_list [linsert $tag_list end "default"] + } + } + return $tag_list } # Finds all module versions for mod in the module path dir proc listModules {dir mod {full_path 1} {sort_order {-dictionary}}\ - {flag_default_mf {1}} {flag_default_dir {1}}} { - global ignoreDir - global ModulesCurrentModulefile - global g_debug - global tcl_platform - global g_versionHash + {flag_default_mf {1}} {flag_default_dir {1}}} { + global ignoreDir + global ModulesCurrentModulefile + global g_debug + global tcl_platform + global g_versionHash - # On Cygwin, glob may change the $dir path if there are symlinks involved - # So it is safest to reglob the $dir. - # example: - # [glob /home/stuff] -> "//homeserver/users0/stuff" + # On Cygwin, glob may change the $dir path if there are symlinks involved + # So it is safest to reglob the $dir. + # example: + # [glob /home/stuff] -> "//homeserver/users0/stuff" - set dir [glob $dir] - set full_list [glob -nocomplain "$dir/$mod"] + set dir [glob $dir] + set full_list [glob -nocomplain "$dir/$mod"] - # remove trailing / needed on some platforms - regsub {\/$} $full_list {} full_list + # remove trailing / needed on some platforms + regsub {\/$} $full_list {} full_list - set clean_list {} - set ModulesVersion {} - for {set i 0} {$i < [llength $full_list]} {incr i 1} { - set element [lindex $full_list $i] - set tag_list {} + set clean_list {} + set ModulesVersion {} + for {set i 0} {$i < [llength $full_list]} {incr i 1} { + set element [lindex $full_list $i] + set tag_list {} - # Cygwin TCL likes to append ".lnk" to the end of symbolic links. - # This is not necessary and pollutes the module names, so let's - # trim it off. - if { [isWin] } { - regsub {\.lnk$} $element {} element - } - - set tail [file tail $element] - set direlem [file dirname $element] - - set sstart [expr {[string length $dir] +1}] - set modulename [string range $element $sstart end] - - - if {[file isdirectory $element] && [file readable $element]} { - set ModulesVersion "" - - if {$g_debug} { - report "DEBUG listModules: found $element" - } - - if {![info exists ignoreDir($tail)]} { - # include .modulerc or if not present .version file - if {[file readable $element/.modulerc]} { - lappend full_list $element/.modulerc - }\ - elseif {[file readable $element/.version]} { - lappend full_list $element/.version - } - # Add each element in the current directory to the list - foreach f [glob -nocomplain "$element/*"] { - lappend full_list $f + # Cygwin TCL likes to append ".lnk" to the end of symbolic links. + # This is not necessary and pollutes the module names, so let's + # trim it off. + if { [isWin] } { + regsub {\.lnk$} $element {} element } - # if element is directory AND default or a version alias, add\ - it to the list - set tag_list [getVersAliasList $element] + set tail [file tail $element] + set direlem [file dirname $element] - set tag {} - if {[llength $tag_list]} { - append tag "(" [join $tag_list ":"] ")" + set sstart [expr {[string length $dir] +1}] + set modulename [string range $element $sstart end] - if {$full_path} { - set mystr ${element} - } else { - set mystr ${modulename} - } - if {[file isdirectory ${element}]} { - if {$flag_default_dir} { - set mystr "$mystr$tag" - } - }\ - elseif {$flag_default_mf} { - set mystr "$mystr$tag" - } - lappend clean_list $mystr - } - - } - } else { - if {$g_debug} { - report "DEBUG listModules: checking $element ($modulename)\ - dir=$flag_default_dir mf=$flag_default_mf" - } - switch -glob -- $tail { - {.modulerc} { - if {$flag_default_dir || $flag_default_mf} { - # set is needed for execute-modulerc - set ModulesCurrentModulefile $element - execute-modulerc $element - } - } - {.version} { - if {$flag_default_dir || $flag_default_mf} { - # set is needed for execute-modulerc - set ModulesCurrentModulefile $element - execute-modulerc "$element" + if {[file isdirectory $element] && [file readable $element]} { + set ModulesVersion "" if {$g_debug} { - report "DEBUG listModules: checking default\ - $element" + report "DEBUG listModules: found $element" } - } - } - {.*} - - {*~} - - {*,v} - - {\#*\#} { } - default { - if {[checkValidModule $element]} { - set tag_list [getVersAliasList $element] + if {![info exists ignoreDir($tail)]} { + # include .modulerc or if not present .version file + if {[file readable $element/.modulerc]} { + lappend full_list $element/.modulerc + } elseif {[file readable $element/.version]} { + lappend full_list $element/.version + } + # Add each element in the current directory to the list + foreach f [glob -nocomplain "$element/*"] { + lappend full_list $f + } - set tag {} - if {[llength $tag_list]} { - append tag "(" [join $tag_list ":"] ")" + # if element is directory AND default or a version alias, add + # it to the list + set tag_list [getVersAliasList $element] + + set tag {} + if {[llength $tag_list]} { + append tag "(" [join $tag_list ":"] ")" + + if {$full_path} { + set mystr ${element} + } else { + set mystr ${modulename} + } + if {[file isdirectory ${element}]} { + if {$flag_default_dir} { + set mystr "$mystr$tag" + } + } elseif {$flag_default_mf} { + set mystr "$mystr$tag" + } + lappend clean_list $mystr + } } - if {$full_path} { - set mystr ${element} - } else { - set mystr ${modulename} + } else { + if {$g_debug} { + report "DEBUG listModules: checking $element ($modulename) dir=$flag_default_dir mf=$flag_default_mf" } - if {[file isdirectory ${element}]} { - if {$flag_default_dir} { - set mystr "$mystr$tag" - } - }\ - elseif {$flag_default_mf} { - set mystr "$mystr$tag" + switch -glob -- $tail { + {.modulerc} { + if {$flag_default_dir || $flag_default_mf} { + # set is needed for execute-modulerc + set ModulesCurrentModulefile $element + execute-modulerc $element + } + } + {.version} { + if {$flag_default_dir || $flag_default_mf} { + # set is needed for execute-modulerc + set ModulesCurrentModulefile $element + execute-modulerc "$element" + + if {$g_debug} { + report "DEBUG listModules: checking default $element" + } + } + } + {.*} - + {*~} - + {*,v} - + {\#*\#} { } + default { + if {[checkValidModule $element]} { + + set tag_list [getVersAliasList $element] + + set tag {} + if {[llength $tag_list]} { + append tag "(" [join $tag_list ":"] ")" + } + if {$full_path} { + set mystr ${element} + } else { + set mystr ${modulename} + } + if {[file isdirectory ${element}]} { + if {$flag_default_dir} { + set mystr "$mystr$tag" + } + } elseif {$flag_default_mf} { + set mystr "$mystr$tag" + } + lappend clean_list $mystr + } + } } - lappend clean_list $mystr - } } - } } - } - if {$sort_order != {}} { - set clean_list [lsort $sort_order $clean_list] - } - if {$g_debug} { - report "DEBUG listModules: Returning $clean_list" - } + if {$sort_order != {}} { + set clean_list [lsort $sort_order $clean_list] + } + if {$g_debug} { + report "DEBUG listModules: Returning $clean_list" + } - return $clean_list + return $clean_list } proc showModulePath {{separator {}}} { - global env g_def_separator g_debug - - if {$g_debug} { - report "DEBUG showModulePath: $separator" - } - - if {$separator == "" } { - set separator $g_def_separator - } - if {[info exists env(MODULEPATH)]} { - report "Search path for module files (in search order):" - foreach path [split $env(MODULEPATH) $separator] { - report " $path" + global env g_def_separator g_debug + if {$g_debug} { + report "DEBUG showModulePath: $separator" } - } else { - reportWarning "WARNING: no directories on module search path" - } + if {$separator == "" } { + set separator $g_def_separator + } + if {[info exists env(MODULEPATH)]} { + report "Search path for module files (in search order):" + foreach path [split $env(MODULEPATH) $separator] { + report " $path" + + } + } else { + reportWarning "WARNING: no directories on module search path" + } } ######################################################################## # command line commands proc cmdModuleList {{separator {}}} { - global env DEF_COLUMNS show_oneperline show_modtimes g_debug - global g_def_separator + global env DEF_COLUMNS show_oneperline show_modtimes g_debug + global g_def_separator - if {$separator == "" } { - set separator $g_def_separator - } + if {$separator == "" } { + set separator $g_def_separator + } - if {[info exists env(LOADEDMODULES)]} { - set loaded $env(LOADEDMODULES) - } else { - set loaded "" - } + if {[info exists env(LOADEDMODULES)]} { + set loaded $env(LOADEDMODULES) + } else { + set loaded "" + } - if { [string length $loaded] == 0} { - report "No Modulefiles Currently Loaded." - } else { - set list {} - report "Currently Loaded Modulefiles:" - set max 0 + if { [string length $loaded] == 0} { + report "No Modulefiles Currently Loaded." + return + } + set list {} + report "Currently Loaded Modulefiles:" + set max 0 - foreach mod [split $loaded $separator] { - set len [string length $mod] + foreach mod [split $loaded $separator] { + set len [string length $mod] - if {$len > 0} { - - if {$show_oneperline} { - report $mod - }\ - elseif {$show_modtimes} { - set filetime [clock format [file mtime [lindex\ - [getPathToModule $mod] 0]] -format "%Y/%m/%b %H:%M:%S"] - report [format "%-50s%10s" $mod $filetime] - } else { - if {$len > $max} { - set max $len - } - # skip zero length module names - # call getPathToModule to find and execute .version and\ - .modulerc files for this module - getPathToModule $mod - set tag_list [getVersAliasList $mod] - - if {[llength $tag_list]} { - append mod "(" [join $tag_list $separator] ")" - # expand string length to include version alises - set len [string length $mod] - if {$len > $max} { - set max $len + if {$len > 0} { + + if {$show_oneperline} { + report $mod + } elseif {$show_modtimes} { + set filetime [clock format [file mtime [lindex [getPathToModule $mod] 0]] -format "%Y/%m/%b %H:%M:%S"] + report [format "%-50s%10s" $mod $filetime] + } else { + if {$len > $max} { + set max $len + } + # skip zero length module names + # call getPathToModule to find and execute .version and\ + .modulerc files for this module + getPathToModule $mod + set tag_list [getVersAliasList $mod] + + if {[llength $tag_list]} { + append mod "(" [join $tag_list $separator] ")" + # expand string length to include version alises + set len [string length $mod] + if {$len > $max} { + set max $len + } + } + + lappend list $mod } - } - - lappend list $mod - } - } - } - if {$show_oneperline ==0 && $show_modtimes == 0} { - # save room for numbers and spacing: 2 digits + ) + space + space - set cols [expr {int($DEF_COLUMNS/($max + 5))}] - # safety check to prevent divide by zero error below - if {$cols <= 0} { - set cols 1 - } - - set item_cnt [llength $list] - set rows [expr {int($item_cnt / $cols)}] - set lastrow_item_cnt [expr {int($item_cnt % $cols)}] - if {$lastrow_item_cnt > 0} { - incr rows - } - if {$g_debug} { - report "list = $list" - report "rows/cols = $rows/$cols, max = $max" - report "item_cnt = $item_cnt, lastrow_item_cnt =\ - $lastrow_item_cnt" - } - for {set row 0} {$row < $rows} {incr row} { - for {set col 0} {$col < $cols} {incr col} { - set index [expr {$col * $rows + $row}] - set mod [lindex $list $index] - - if {$mod != ""} { - set n [expr {$index +1}] - set mod [format "%2d) %-${max}s " $n $mod] - report $mod -nonewline - } } - report "" - } } - } + if {$show_oneperline == 0 && $show_modtimes == 0} { + # save room for numbers and spacing: 2 digits + ) + space + space + set cols [expr {int($DEF_COLUMNS/($max + 5))}] + # safety check to prevent divide by zero error below + if {$cols <= 0} { + set cols 1 + } + + set item_cnt [llength $list] + set rows [expr {int($item_cnt / $cols)}] + set lastrow_item_cnt [expr {int($item_cnt % $cols)}] + if {$lastrow_item_cnt > 0} { + incr rows + } + if {$g_debug} { + report "list = $list" + report "rows/cols = $rows/$cols, max = $max" + report "item_cnt = $item_cnt, lastrow_item_cnt = $lastrow_item_cnt" + } + for {set row 0} {$row < $rows} {incr row} { + for {set col 0} {$col < $cols} {incr col} { + set index [expr {$col * $rows + $row}] + set mod [lindex $list $index] + + if {$mod == ""} { + continue + } + set n [expr {$index +1}] + set mod [format "%2d) %-${max}s " $n $mod] + report $mod -nonewline + } + report "" + } + } } proc cmdModuleDisplay {mod} { - global env tcl_version ModulesCurrentModulefile + global env tcl_version ModulesCurrentModulefile - set modfile [getPathToModule $mod] - if {$modfile != ""} { + set modfile [getPathToModule $mod] + if {$modfile == ""} { + return + } pushModuleName [lindex $modfile 1] set modfile [lindex $modfile 0] - report\ - "-------------------------------------------------------------------" + report "-------------------------------------------------------------------" report "$modfile:\n" pushMode "display" execute-modulefile $modfile popMode popModuleName - report\ - "-------------------------------------------------------------------" - } + report "-------------------------------------------------------------------" } proc cmdModulePaths {mod {separator {}}} { - global env g_pathList flag_default_mf flag_default_dir g_def_separator g_debug + global env g_pathList flag_default_mf flag_default_dir + global g_def_separator g_debug - if {$g_debug} { - report "DEBUG cmdModulePaths: ($mod, $separator)" - } - - if {$separator == "" } { - set separator $g_def_separator - } - - if {[catch { - foreach dir [split $env(MODULEPATH) $separator] { - if {[file isdirectory $dir]} { - foreach mod2 [listModules $dir $mod 0 "" $flag_default_mf\ - $flag_default_dir] { - lappend g_pathList $mod2 - } - } + if {$g_debug} { + report "DEBUG cmdModulePaths: ($mod, $separator)" + } + + if {$separator == "" } { + set separator $g_def_separator + } + + if {[catch { + foreach dir [split $env(MODULEPATH) $separator] { + if {![file isdirectory $dir]} { + continue + } + foreach mod2 [listModules $dir $mod 0 "" $flag_default_mf $flag_default_dir] { + lappend g_pathList $mod2 + } + } + } errMsg]} { + reportWarning "ERROR: module paths $mod failed. $errMsg" } - } errMsg]} { - reportWarning "ERROR: module paths $mod failed. $errMsg" - } } proc cmdModulePath {mod} { - global env g_pathList ModulesCurrentModulefile g_debug + global env g_pathList ModulesCurrentModulefile g_debug - if {$g_debug} { - report "DEBUG cmdModulePath: ($mod)" - } - set modfile [getPathToModule $mod] - if {$modfile != ""} { + if {$g_debug} { + report "DEBUG cmdModulePath: ($mod)" + } + set modfile [getPathToModule $mod] + if {$modfile == ""} { + return + } set modfile [lindex $modfile 0] set ModulesCurrentModulefile $modfile set g_pathList $modfile - } } proc cmdModuleWhatIs {{mod {}}} { - cmdModuleSearch $mod {} + cmdModuleSearch $mod {} } proc cmdModuleApropos {{search {}}} { - cmdModuleSearch {} $search + cmdModuleSearch {} $search } proc cmdModuleSearch {{mod {}} {search {}}} { - global env tcl_version ModulesCurrentModulefile - global g_whatis g_def_separator g_debug + global env tcl_version ModulesCurrentModulefile + global g_whatis g_def_separator g_debug - - if {$g_debug} { - report "DEBUG cmdModuleSearch: ($mod, $search)" - } - if {$mod == ""} { - set mod "*" - } - foreach dir [split $env(MODULEPATH) $g_def_separator] { - if {[file isdirectory $dir]} { - report "----------- $dir ------------- " - set modlist [listModules $dir $mod 0 "" 0 0] - foreach mod2 $modlist { - set g_whatis "" - set modfile [getPathToModule $mod2] - if {$modfile != ""} { - pushMode "whatis" - pushModuleName [lindex $modfile 1] - set modfile [lindex $modfile 0] - execute-modulefile $modfile - popMode - popModuleName - if {$search =="" || [regexp -nocase $search $g_whatis]} { - report [format "%20s: %s" $mod2 $g_whatis] - } - } - } + if {$g_debug} { + report "DEBUG cmdModuleSearch: ($mod, $search)" + } + if {$mod == ""} { + set mod "*" + } + foreach dir [split $env(MODULEPATH) $g_def_separator] { + if {![file isdirectory $dir]} { + continue + } + report "----------- $dir ------------- " + set modlist [listModules $dir $mod 0 "" 0 0] + foreach mod2 $modlist { + set g_whatis "" + set modfile [getPathToModule $mod2] + if {$modfile == ""} { + continue + } + pushMode "whatis" + pushModuleName [lindex $modfile 1] + set modfile [lindex $modfile 0] + execute-modulefile $modfile + popMode + popModuleName + if {$search =="" || [regexp -nocase $search $g_whatis]} { + report [format "%20s: %s" $mod2 $g_whatis] + } + } } - } } proc cmdModuleSwitch {old {new {}}} { - global env g_debug g_loadedModulesGeneric g_loadedModules + global env g_debug g_loadedModulesGeneric g_loadedModules - if {$new == ""} { - set new $old - } elseif {[info exists g_loadedModules($new)]} { - set tmp $new - set new $old - set old $tmp - } + if {$new == ""} { + set new $old + } elseif {[info exists g_loadedModules($new)]} { + set tmp $new + set new $old + set old $tmp + } - if {![info exists g_loadedModules($old)] && - [info exists g_loadedModulesGeneric($old)]} { - set old "$old/$g_loadedModulesGeneric($old)" - } + if {![info exists g_loadedModules($old)] && + [info exists g_loadedModulesGeneric($old)]} { + set old "$old/$g_loadedModulesGeneric($old)" + } - if {$g_debug} { - report "DEBUG cmdModuleSwitch: new=\"$new\" old=\"$old\"" - } + if {$g_debug} { + report "DEBUG cmdModuleSwitch: new=\"$new\" old=\"$old\"" + } - cmdModuleUnload $old - cmdModuleLoad $new + cmdModuleUnload $old + cmdModuleLoad $new } proc cmdModuleSource {args} { - global env tcl_version g_loadedModules g_loadedModulesGeneric g_force g_debug + global env tcl_version g_loadedModules g_loadedModulesGeneric + gloabl g_force g_debug - if {$g_debug} { - report "DEBUG cmdModuleSource: $args" - } - foreach file $args { - if {[file exists $file]} { - pushMode "load" - pushModuleName $file - execute-modulefile $file - popModuleName - popMode - } else { - error "File $file does not exist" + if {$g_debug} { + report "DEBUG cmdModuleSource: $args" + } + foreach file $args { + if {![file exists $file]} { + error "File $file does not exist" + } + pushMode "load" + pushModuleName $file + execute-modulefile $file + popModuleName + popMode } - } } proc cmdModuleLoad {args} { - global env g_loadedModules g_loadedModulesGeneric g_force - global ModulesCurrentModulefile - global g_debug + global env g_loadedModules g_loadedModulesGeneric g_force + global ModulesCurrentModulefile + global g_debug - if {$g_debug} { - report "DEBUG cmdModuleLoad: loading $args" - } + if {$g_debug} { + report "DEBUG cmdModuleLoad: loading $args" + } - foreach mod $args { - set modfile [getPathToModule $mod] - if {$modfile != ""} { - set currentModule [lindex $modfile 1] - set modfile [lindex $modfile 0] - set ModulesCurrentModulefile $modfile + foreach mod $args { + set modfile [getPathToModule $mod] + if {$modfile == ""} { + continue + } + set currentModule [lindex $modfile 1] + set modfile [lindex $modfile 0] + set ModulesCurrentModulefile $modfile - if {$g_force || ! [info exists g_loadedModules($currentModule)]} { + if {! $g_force && [info exists g_loadedModules($currentModule)]} { + continue + } pushMode "load" pushModuleName $currentModule saveSettings if {[execute-modulefile $modfile]} { - restoreSettings + restoreSettings } else { - append-path LOADEDMODULES $currentModule - append-path _LMFILES_ $modfile - set g_loadedModules($currentModule) 1 - set genericModName [file dirname $mod] - - if {![info exists\ - g_loadedModulesGeneric($genericModName)]} { - set g_loadedModulesGeneric($genericModName) [file tail\ - $currentModule] - } + append-path LOADEDMODULES $currentModule + append-path _LMFILES_ $modfile + set g_loadedModules($currentModule) 1 + set genericModName [file dirname $mod] + + if {![info exists g_loadedModulesGeneric($genericModName)]} { + set g_loadedModulesGeneric($genericModName) [file tail $currentModule] + } } - + popMode popModuleName - } } - } } proc cmdModuleUnload {args} { @@ -2880,69 +2824,69 @@ proc cmdModuleInit {args} { } proc cmdModuleHelp {args} { - global done MODULES_CURRENT_VERSION + global done MODULES_CURRENT_VERSION - set done 0 - foreach arg $args { - if {$arg != ""} { - set modfile [getPathToModule $arg] + set done 0 + foreach arg $args { + if {$arg != ""} { + set modfile [getPathToModule $arg] - if {$modfile != ""} { - pushModuleName [lindex $modfile 1] - set modfile [lindex $modfile 0] - report\ - "-------------------------------------------------------------------" - report "Module Specific Help for $modfile:\n" - set mode "Help" - execute-modulefile $modfile 1 - popMode - popModuleName - report\ - "-------------------------------------------------------------------" - } - set done 1 + if {$modfile != ""} { + pushModuleName [lindex $modfile 1] + set modfile [lindex $modfile 0] + report\ + "-------------------------------------------------------------------" + report "Module Specific Help for $modfile:\n" + set mode "Help" + execute-modulefile $modfile 1 + popMode + popModuleName + report\ + "-------------------------------------------------------------------" + } + set done 1 + } } - } - if {$done == 0} { - report "Modules Release Tcl $MODULES_CURRENT_VERSION " 1 - report { Copyright GNU GPL v2 1991} - report {Usage: module [ command ]} + if {$done == 0} { + report "Modules Release Tcl $MODULES_CURRENT_VERSION " 1 + report { Copyright GNU GPL v2 1991} + report {Usage: module [ command ]} - report {Commands:} - report { list [switches] modulefile\ - [modulefile ...]} - report { display | show modulefile\ - [modulefile ...]} - report { add | load modulefile\ - [modulefile ...]} - report { purge | rm | unload modulefile\ - [modulefile ...]} - report { reload modulefile\ - [modulefile ...]} - report { switch | swap \ - [oldmodulefile] newmodulefile} - report { avail [switches] [modulefile\ - [modulefile ...]]} - report { aliases} - report { whatis [modulefile\ - [modulefile ...]]} - report { help [modulefile\ - [modulefile ...]]} - report { path modulefile} - report { paths modulefile} - report { initlist modulefile} - report { initadd modulefile} - report { initrm modulefile} - report { initclear modulefile} - report { initprepend modulefile} - report { use dir [dir ...]} - report { unuse dir [dir ...]} - report { source scriptfile} - report { apropos | keyword | search string} - report {Switches:} - report { -t terse format avail and list} - report { -l long format avail and list} - } + report {Commands:} + report { list [switches] modulefile\ + [modulefile ...]} + report { display | show modulefile\ + [modulefile ...]} + report { add | load modulefile\ + [modulefile ...]} + report { purge | rm | unload modulefile\ + [modulefile ...]} + report { reload modulefile\ + [modulefile ...]} + report { switch | swap \ + [oldmodulefile] newmodulefile} + report { avail [switches] [modulefile\ + [modulefile ...]]} + report { aliases} + report { whatis [modulefile\ + [modulefile ...]]} + report { help [modulefile\ + [modulefile ...]]} + report { path modulefile} + report { paths modulefile} + report { initlist modulefile} + report { initadd modulefile} + report { initrm modulefile} + report { initclear modulefile} + report { initprepend modulefile} + report { use dir [dir ...]} + report { unuse dir [dir ...]} + report { source scriptfile} + report { apropos | keyword | search string} + report {Switches:} + report { -t terse format avail and list} + report { -l long format avail and list} + } } @@ -2960,29 +2904,29 @@ if {$g_debug} { # Parse options set opt [lindex $argv 1] switch -regexp -- $opt { - {^(-deb|--deb)} { + {^(-deb|--deb)} { - if {!$g_debug} { - report "CALLING $argv0 $argv" + if {!$g_debug} { + report "CALLING $argv0 $argv" + } + + set g_debug 1 + report "DEBUG debug enabled" + + set argv [replaceFromList $argv $opt] + } + {^(--help|-h)} { + cmdModuleHelp + exit 0 + } + {^(-V|--ver)} { + report "Modules Release Tcl $MODULES_CURRENT_VERSION" + exit 0 + } + {^--} { + report "+(0):ERROR:0: Unrecognized option '$opt'" + exit -1 } - - set g_debug 1 - report "DEBUG debug enabled" - - set argv [replaceFromList $argv $opt] - } - {^(--help|-h)} { - cmdModuleHelp - exit 0 - } - {^(-V|--ver)} { - report "Modules Release Tcl $MODULES_CURRENT_VERSION" - exit 0 - } - {^--} { - report "+(0):ERROR:0: Unrecognized option '$opt'" - exit -1 - } } set g_shell [lindex $argv 0] @@ -2990,164 +2934,164 @@ set command [lindex $argv 1] set argv [lreplace $argv 0 1] switch -regexp -- $g_shell { - ^(sh|bash|ksh|zsh)$ { - set g_shellType sh - } - ^(cmd)$ { - set g_shellType cmd - } - ^(csh|tcsh)$ { - set g_shellType csh - } - ^(perl)$ { - set g_shellType perl - } - ^(python)$ { - set g_shellType python - } - ^(lisp)$ { - set g_shellType lisp - } - . { - error " +(0):ERROR:0: Unknown shell type \'($g_shell)\'" - } + ^(sh|bash|ksh|zsh)$ { + set g_shellType sh + } + ^(cmd)$ { + set g_shellType cmd + } + ^(csh|tcsh)$ { + set g_shellType csh + } + ^(perl)$ { + set g_shellType perl + } + ^(python)$ { + set g_shellType python + } + ^(lisp)$ { + set g_shellType lisp + } + . { + error " +(0):ERROR:0: Unknown shell type \'($g_shell)\'" + } } cacheCurrentModules # Find and execute any .modulerc file found in the module directories defined\ - in env(MODULESPATH) + in env(MODULESPATH) runModulerc # Resolve any aliased module names - safe to run nonmodule arguments if {$g_debug} { - report "DEBUG Resolving $argv" + report "DEBUG Resolving $argv" } if {[lsearch $argv "-t"] >= 0} { - set show_oneperline 1 - set argv [replaceFromList $argv "-t"] + set show_oneperline 1 + set argv [replaceFromList $argv "-t"] } if {[lsearch $argv "-l"] >= 0} { - set show_modtimes 1 - set argv [replaceFromList $argv "-l"] + set show_modtimes 1 + set argv [replaceFromList $argv "-l"] } set argv [resolveModuleVersionOrAlias $argv] if {$g_debug} { - report "DEBUG Resolved $argv" + report "DEBUG Resolved $argv" } if {[catch { - switch -regexp -- $command { - {^av} { - if {$argv != ""} { - foreach arg $argv { - cmdModuleAvail $arg + switch -regexp -- $command { + {^av} { + if {$argv != ""} { + foreach arg $argv { + cmdModuleAvail $arg + } + } else { + cmdModuleAvail + cmdModuleAliases + } } - } else { - cmdModuleAvail - cmdModuleAliases - } - } - {^al} { - cmdModuleAliases - } - {^li} { - cmdModuleList - } - {^(di|show)} { - foreach arg $argv { - cmdModuleDisplay $arg - } - } - {^(add|lo)} { - eval cmdModuleLoad $argv - renderSettings - } - {^source} { - eval cmdModuleSource $argv - renderSettings - } - {^paths} { - # HMS: We probably don't need the eval - eval cmdModulePaths $argv - renderSettings - } - {^path} { - # HMS: We probably don't need the eval - eval cmdModulePath $argv - renderSettings - } - {^pu} { - cmdModulePurge - renderSettings - } - {^sw} { - eval cmdModuleSwitch $argv - renderSettings - } - {^(rm|unlo)} { - eval cmdModuleUnload $argv - renderSettings - } - {^use$} { - eval cmdModuleUse $argv - renderSettings - } - {^unuse$} { - eval cmdModuleUnuse $argv - renderSettings - } - {^wh} { - if {$argv != ""} { - foreach arg $argv { - cmdModuleWhatIs $arg + {^al} { + cmdModuleAliases + } + {^li} { + cmdModuleList + } + {^(di|show)} { + foreach arg $argv { + cmdModuleDisplay $arg + } + } + {^(add|lo)} { + eval cmdModuleLoad $argv + renderSettings + } + {^source} { + eval cmdModuleSource $argv + renderSettings + } + {^paths} { + # HMS: We probably don't need the eval + eval cmdModulePaths $argv + renderSettings + } + {^path} { + # HMS: We probably don't need the eval + eval cmdModulePath $argv + renderSettings + } + {^pu} { + cmdModulePurge + renderSettings + } + {^sw} { + eval cmdModuleSwitch $argv + renderSettings + } + {^(rm|unlo)} { + eval cmdModuleUnload $argv + renderSettings + } + {^use$} { + eval cmdModuleUse $argv + renderSettings + } + {^unuse$} { + eval cmdModuleUnuse $argv + renderSettings + } + {^wh} { + if {$argv != ""} { + foreach arg $argv { + cmdModuleWhatIs $arg + } + } else { + cmdModuleWhatIs + } + } + {^(apropos|search|keyword)$} { + eval cmdModuleApropos $argv + } + {^debug$} { + eval cmdModuleDebug + } + {^rel} { + cmdModuleReload + renderSettings + } + {^init(add|lo)$} { + eval cmdModuleInit add $argv + } + {^initprepend$} { + eval cmdModuleInit prepend $argv + } + {^initswitch$} { + eval cmdModuleInit switch $argv + } + {^init(rm|unlo)$} { + eval cmdModuleInit rm $argv + } + {^initlist$} { + eval cmdModuleInit list $argv + } + {^initclear$} { + eval cmdModuleInit clear $argv + } + {^autoinit$} { + cmdModuleAutoinit + renderSettings + } + {^($|help)} { + cmdModuleHelp $argv + } + . { + reportWarning "ERROR: command '$command' not recognized" + cmdModuleHelp $argv } - } else { - cmdModuleWhatIs - } } - {^(apropos|search|keyword)$} { - eval cmdModuleApropos $argv - } - {^debug$} { - eval cmdModuleDebug - } - {^rel} { - cmdModuleReload - renderSettings - } - {^init(add|lo)$} { - eval cmdModuleInit add $argv - } - {^initprepend$} { - eval cmdModuleInit prepend $argv - } - {^initswitch$} { - eval cmdModuleInit switch $argv - } - {^init(rm|unlo)$} { - eval cmdModuleInit rm $argv - } - {^initlist$} { - eval cmdModuleInit list $argv - } - {^initclear$} { - eval cmdModuleInit clear $argv - } - {^autoinit$} { - cmdModuleAutoinit - renderSettings - } - {^($|help)} { - cmdModuleHelp $argv - } - . { - reportWarning "ERROR: command '$command' not recognized" - cmdModuleHelp $argv - } - } } errMsg ]} { - reportWarning "ERROR: $errMsg" + reportWarning "ERROR: $errMsg" } # ;;; Local Variables: ***