Edit - modulecmd.tcl

Edit: modulecmd.tcl

#!/usr/bin/tclsh
#
# MODULECMD.TCL, a pure TCL implementation of the module command
# Copyright (C) 2002-2004 Mark Lakata
# Copyright (C) 2004-2017 Kent Mein
# Copyright (C) 2016-2020 Xavier Delaruelle
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

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

#
# Some Global Variables.....
#
set error_count 0 ;# Start with 0 errors
set g_return_false 0 ;# False value is rendered if == 1
set g_autoInit 0
set g_inhibit_interp 0 ;# Modulefile interpretation disabled if == 1
set g_inhibit_errreport 0 ;# Non-critical error reporting disabled if == 1
set CSH_LIMIT 4000 ;# Workaround for commandline limits in csh
set reportfd stderr ;# File descriptor to use to report messages
set g_report_format plain ;# Output report format

# Configuration option properties (superseding environment variable, default
# value, is configuration lockable to default value, valid value list?,
# internal value representation?, proc to call to initialize option value
array set g_config_defs [list\
   contact {MODULECONTACT root@localhost 0}\
   auto_handling {MODULES_AUTO_HANDLING 0 0 {0 1}}\
   avail_indepth {MODULES_AVAIL_INDEPTH 1 0 {0 1}}\
   avail_report_dir_sym {{} 1 0}\
   avail_report_mfile_sym {{} 1 0}\
   collection_pin_version {MODULES_COLLECTION_PIN_VERSION 0 0 {0 1}}\
   collection_target {MODULES_COLLECTION_TARGET <undef> 0}\
   color {MODULES_COLOR never 0 {never auto always} {0 1 2} initConfColor}\
   colors {MODULES_COLORS {} 0 {} {} initConfColors}\
   extra_siteconfig {MODULES_SITECONFIG <undef> 1 {}}\
   home {MODULESHOME /usr/share/Modules 0}\
   icase {MODULES_ICASE never 0 {never search always}}\
   ignored_dirs {{} {CVS RCS SCCS .svn .git .SYNC .sos} 0}\
   locked_configs {{} {} 0}\
   ml {MODULES_ML 1 0 {0 1}}\
   pager {MODULES_PAGER {/usr/bin/less -eFKRX} 0}\
   rcfile {MODULERCFILE <undef> 0}\
   run_quarantine {MODULES_RUN_QUARANTINE <undef> 0}\
   silent_shell_debug {MODULES_SILENT_SHELL_DEBUG <undef> 0 {0 1}}\
   siteconfig {{} /etc/environment-modules/siteconfig.tcl 0}\
   tcl_ext_lib {{} /usr/lib64/libtclenvmodules.so 0}\
   term_background {MODULES_TERM_BACKGROUND dark 0 {dark light}}\
   unload_match_order {MODULES_UNLOAD_MATCH_ORDER returnlast 0\
      {returnlast returnfirst}}\
   implicit_default {MODULES_IMPLICIT_DEFAULT 1 1 {0 1}}\
   extended_default {MODULES_EXTENDED_DEFAULT 0 0 {0 1}}\
   advanced_version_spec {MODULES_ADVANCED_VERSION_SPEC 0 0 {0\
      1}}\
   search_match {MODULES_SEARCH_MATCH starts_with 0 {starts_with contains}}\
   set_shell_startup {MODULES_SET_SHELL_STARTUP 0 0 {0 1}}\
   verbosity {MODULES_VERBOSITY normal 0 {silent concise normal verbose\
      debug}}\
   wa_277 {MODULES_WA_277 0 0 {0 1}}\
]

proc isConfigLocked {option} {
   return [expr {[lsearch -exact [getConf locked_configs] $option] != -1}]
}

# Get configuration option value
proc getConf {option {valifundef {}}} {
   if {![info exists ::g_configs($option)]} {
      # fetch option properties (including its default value)
      lassign $::g_config_defs($option) envvar value islockable validvallist\
         intvallist initproc

# ensure option is not locked before superseding its default value
      if {!$islockable || ![isConfigLocked $option]} {
         # call specific proc to initialize config option if any
         if {$initproc ne {}} {
            set value [$initproc $envvar $value $validvallist $intvallist]
         } else {
            # overriden value coming from environment
            if {$envvar ne {} && [info exists ::env($envvar)]} {
               # ignore non-valid values
               if {[llength $validvallist] == 0 || [isInList $validvallist\
                  $::env($envvar)]} {
                  set value $::env($envvar)
               }
            }

# overriden value coming the command-line
            if {[info exists ::asked_$option]} {
               set value [set ::asked_$option]
            }

# convert value to its internal representation
            if {[llength $intvallist] > 0} {
               set value [lindex $intvallist [lsearch -exact $validvallist\
                  $value]]
            }
         }
      }

# return passed value if undefined and no value record
      if {$value eq {<undef>}} {
         set value $valifundef
      } else {
         setConf $option $value
      }
      return $value
   } else {
      return $::g_configs($option)
   }
}

# Set configuration option value
proc setConf {option value} {
   set ::g_configs($option) $value
   reportDebug "$option set to '$value'"
}

# Unset configuration option value if it is set
proc unsetConf {option} {
   if {[info exists ::g_configs($option)]} {
      unset ::g_configs($option)
      reportDebug "$option unset"
   }
}

# Append each passed value to the existing config option value list
proc lappendConf {option args} {
   # retrieve current value through getConf to initialize it if still undef
   set value [getConf $option]
   eval appendNoDupToList value $args
   setConf $option $value
}

# Source site config which can be used to define global procedures or
# settings. We first look for the global siteconfig, then if an extra
# siteconfig is defined and allowed, source that file if it exists
proc sourceSiteConfig {} {
   lappend siteconfiglist [getConf siteconfig]
   for {set i 0} {$i < [llength $siteconfiglist]} {incr i} {
      set siteconfig [lindex $siteconfiglist $i]
      if {[file readable $siteconfig]} {
         reportDebug "Source site configuration ($siteconfig)"
         if {[catch {uplevel 1 source $siteconfig} errMsg]} {
            set errMsg "Site configuration source failed\n"
            # issue line number is lost due to uplevel use
            append errMsg [formatErrStackTrace $::errorInfo $siteconfig {}]
            reportErrorAndExit $errMsg
         }
         if {$siteconfig eq [getConf siteconfig]} {
            set ::g_siteconfig_loaded 1
         } else {
            set ::g_extra_siteconfig_loaded 1
         }
      }
      # check on extra_siteconfig after initial siteconfig loaded in case
      # it inhibits this extra load
      if {$siteconfig eq [getConf siteconfig] && [getConf\
         extra_siteconfig] ne {}} {
         lappend siteconfiglist [getConf extra_siteconfig]
      }
   }
}

# Used to tell if a machine is running Windows or not
proc isWin {} {
   return [expr {$::tcl_platform(platform) eq {windows}}]
}

# Get default path separator
proc getPathSeparator {} {
   if {![info exists ::g_def_separator]} {
      set ::g_def_separator [expr {[isWin] ? {;} : {:}}]
   }

return $::g_def_separator
}

# Sub level separator to serialize a second level of info in env var
set ::g_sub1_separator &
# Sub sub level separator to serialize a third level of info in env var
set ::g_sub2_separator |

# Detect if terminal is attached to stderr message channel
proc isStderrTty {} {
   if {![info exists ::g_is_stderr_tty]} {
      set ::g_is_stderr_tty [expr {![catch {fconfigure stderr -mode}]}]
   }

return $::g_is_stderr_tty
}

# Provide columns number for output formatting
proc getTtyColumns {} {
   if {![info exists ::g_tty_columns]} {
      # determine col number from tty capabilites
      # tty info query depends on running OS
      switch -- $::tcl_platform(os) {
         SunOS {
            catch {regexp {columns = (\d+);} [exec stty] match cols} errMsg
         }
         {Windows NT} {
            catch {regexp {Columns:\s+(\d+)} [exec mode] match cols} errMsg
         }
         default {
            catch {set cols [lindex [exec stty size] 1]} errMsg
         }
      }
      # default size if tty cols cannot be found
      set ::g_tty_columns [expr {![info exists cols] || $cols eq {0} ? 80 :\
         $cols}]
   }

return $::g_tty_columns
}

# Get force mode
proc getForce {} {
   if {![info exists ::g_force]} {
      set force 0 ;# By-pass dependency consistency

# overriden value coming the command-line
      if {[info exists ::asked_force]} {
         set force $::asked_force
      }

set ::g_force $force
      reportDebug "force set to '$force'"
   }

return $::g_force
}

# Initialize Select Graphic Rendition table
proc initConfColors {envvar value validvallist intvallist} {
   # overriden value coming from environment
   if {[info exists ::env($envvar)]} {
      set colors_list $::env($envvar)
      if {[catch {
         # test overriden value could be set to a dummy array variable
         array set test_colors [split $colors_list {:=}]
      } errMsg ]} {
         # report issue as a debug message rather warning to avoid
         # disturbing user with a warning message in the middle of a
         # useful output as this table will be initialized at first use
         reportDebug "Ignore invalid value set in $envvar ($colors_list)"
         unset colors_list
      }
   }

# if no valid override set use default color theme for terminal
   # background color kind (light or dark)
   if {![info exists colors_list]} {
      if {[getConf term_background] eq {light}} {
         set colors_list {hi=1:db=2:se=2:er=31:wa=33:me=35:in=34:mp=1;34:di=34:al=36:sy=35:de=4:cm=32}
      } else {
         set colors_list {hi=1:db=2:se=2:er=91:wa=93:me=95:in=94:mp=1;94:di=94:al=96:sy=95:de=4:cm=92}
      }
      if {[catch {
         array set test_colors [split $colors_list {:=}]
      } errMsg ]} {
         reportDebug "Ignore invalid default [getConf term_background]\
            background colors ($colors_list)"
         # define an empty list if no valid value set
         set colors_list {}
      }
   }

# check each color defined and unset invalid codes
   set value {}
   foreach {elt col} [split $colors_list {:=}] {
      if {![regexp {^[\d;]+$} $col]} {
         reportDebug "Ignore invalid color code for '$elt' ($col)"
      } else {
         lappend value $elt=$col
      }
   }
   set value [join $value :]

# set SGR table as an array to easily access rendition for each key
   array unset ::g_colors
   array set ::g_colors [split $value {:=}]

return $value
}

# Initialize color configuration value
proc initConfColor {envvar value validvallist intvallist} {
   # overriden value coming from environment via standard variable
   # https://no-color.org/ and https://bixense.com/clicolors/
   if {[info exists ::env(NO_COLOR)]} {
      set value never
   } elseif {[info exists ::env(CLICOLOR)]} {
      if {$::env(CLICOLOR) eq {0}} {
         set value never
      } else {
         set value auto
      }
   } elseif {[info exists ::env(CLICOLOR_FORCE)] && $::env(CLICOLOR_FORCE)\
      ne {0}} {
      set value always
   }

# overriden value coming from environment via Modules-specific variable
   if {$envvar ne {} && [info exists ::env($envvar)]} {
      # ignore non-valid values
      if {[llength $validvallist] == 0 || [isInList $validvallist\
         $::env($envvar)]} {
         set value $::env($envvar)
      }
   }

# overriden value coming the command-line
   if {[info exists ::asked_color]} {
      set value [set ::asked_color]
   }

# convert value to its internal representation
   if {[llength $intvallist] > 0} {
      set value [lindex $intvallist [lsearch -exact $validvallist $value]]
   }

# disable color mode if no terminal attached except if 'always' asked
   if {$value != 0 && (![isStderrTty] || $value == 2)} {
      incr value -1
   }

# initialize color theme if color mode enabled
   getConf colors

return $value
}

# Is currently set verbosity level is equal or higher than level passed as arg
proc isVerbosityLevel {name} {
   return [expr {[lsearch -exact [lindex $::g_config_defs(verbosity) 3]\
      [getConf verbosity]] >= [lsearch -exact [lindex\
      $::g_config_defs(verbosity) 3] $name]}]
}

# Is match performed in a case sensitive or insensitive manner
proc isIcase {} {
   # depending on current sub-command, list values that equal to a case
   # insensitive match enablement
   lappend enabledValList always
   if {[isInList [list avail whatis search paths] [currentCommandName]]} {
      lappend enabledValList search
   }
   return [isInList $enabledValList [getConf icase]]
}

proc raiseErrorCount {} {
   incr ::error_count
}

proc renderFalse {} {
   reportDebug called.

if {[info exists ::g_false_rendered]} {
      reportDebug {false already rendered}
   } elseif {[info exists ::g_shellType]} {
      # setup flag to render only once
      set ::g_false_rendered 1

# render a false value most of the time through a variable assignement
      # that will be looked at in the shell module function calling
      # modulecmd.tcl to return in turns a boolean status. Except for python
      # and cmake, the value assigned to variable is also returned as the
      # entire rendering status
      switch -- $::g_shellType {
         sh - csh - fish {
            # no need to set a variable on real shells as last statement
            # result can easily be checked
            puts stdout {test 0 = 1;}
         }
         tcl {
            puts stdout {set _mlstatus 0;}
         }
         cmd {
            puts stdout {set errorlevel=1}
         }
         perl {
            puts stdout {{ no strict 'vars'; $_mlstatus = 0; }}
         }
         python {
            puts stdout {_mlstatus = False}
         }
         ruby {
            puts stdout {_mlstatus = false}
         }
         lisp {
            puts stdout {nil}
         }
         cmake {
            puts stdout {set(_mlstatus FALSE)}
         }
         r {
            puts stdout {mlstatus <- FALSE}
         }
      }
   }
}

proc renderTrue {} {
   reportDebug called.

# render a true value most of the time through a variable assignement that
   # will be looked at in the shell module function calling modulecmd.tcl to
   # return in turns a boolean status. Except for python and cmake, the
   # value assigned to variable is also returned as the full rendering status
   switch -- $::g_shellType {
      sh - csh - fish {
         # no need to set a variable on real shells as last statement
         # result can easily be checked
         puts stdout {test 0;}
      }
      tcl {
         puts stdout {set _mlstatus 1;}
      }
      cmd {
         puts stdout {set errorlevel=0}
      }
      perl {
         puts stdout {{ no strict 'vars'; $_mlstatus = 1; }}
      }
      python {
         puts stdout {_mlstatus = True}
      }
      ruby {
         puts stdout {_mlstatus = true}
      }
      lisp {
         puts stdout {t}
      }
      cmake {
         puts stdout {set(_mlstatus TRUE)}
      }
      r {
         puts stdout {mlstatus <- TRUE}
      }
   }
}

proc renderText {text} {
   reportDebug "called ($text)."

# render a text value most of the time through a variable assignement that
   # will be looked at in the shell module function calling modulecmd.tcl to
   # return in turns a string value.
   switch -- $::g_shellType {
      sh - csh - fish {
         foreach word $text {
            # no need to set a variable on real shells, echoing text will make
            # it available as result
            puts stdout "echo '$word';"
         }
      }
      tcl {
         puts stdout "set _mlstatus \"$text\";"
      }
      cmd {
         foreach word $text {
            puts stdout "echo $word"
         }
      }
      perl {
         puts stdout "{ no strict 'vars'; \$_mlstatus = '$text'; }"
      }
      python {
         puts stdout "_mlstatus = '$text'"
      }
      ruby {
         puts stdout "_mlstatus = '$text'"
      }
      lisp {
         puts stdout "(message \"$text\")"
      }
      cmake {
         puts stdout "set(_mlstatus \"$text\")"
      }
      r {
         puts stdout "mlstatus <- '$text'"
      }
   }
}

#
# Debug, Info, Warnings and Error message handling.
#

# save message when report is not currently initialized as we do not
# know yet if debug mode is enabled or not
proc reportDebug {message {showcaller 1}} {
   # display caller name as prefix
   set prefix [expr {$showcaller && [info level] > 1 ? "[lindex [info level\
      -1] 0]: " : {}}]
   lappend ::errreport_buffer [list reportDebug $prefix$message 0]
}

# regular procedure to use once error report is initialized
proc __reportDebug {message {showcaller 1}} {
   # display active interp details if not the main one
   set prefix [currentDebugMsgPrefix]
   # display caller name as prefix
   if {$showcaller && [info level] > 1} {
      append prefix "[lindex [info level -1] 0]: "
   }
   report [sgr db "DEBUG $prefix$message"] 0 1
}

# alternative procedure used when debug is disabled
proc __reportDebugNop {args} {}

proc reportWarning {message {recordtop 0}} {
   reportError $message $recordtop WARNING wa 0
}

proc reportError {message {recordtop 0} {severity ERROR} {sgrkey er}\
   {raisecnt 1}} {
   lappend ::errreport_buffer [list reportError $message $recordtop $severity\
      $sgrkey $raisecnt]
}

proc __reportError {message {recordtop 0} {severity ERROR} {sgrkey er}\
   {raisecnt 1}} {
   # if report disabled, also disable error raise to get a coherent
   # behavior (if no message printed, no error code change)
   if {!$::g_inhibit_errreport} {
      if {$raisecnt} {
         raiseErrorCount
      }
      set msgsgr "[sgr $sgrkey $severity]: $message"
      # record message to report it later on if a record id is found
      if {[currentMsgRecordId] ne {}} {
         recordMessage $msgsgr $recordtop
      # skip message report if silent
      } elseif {[isVerbosityLevel concise]} {
         # save error messages to render them all together in JSON format
         if {[isReportFormat json]} {
            lappend ::g_report_erralist $severity $message
         } else {
            report $msgsgr 0 0 1
         }
      }
   }
}

# throw known error (call error with 'known error' code)
proc knerror {message {code MODULES_ERR_KNOWN}} {
   error $message {} $code
}

# save message if report is not yet initialized
proc reportErrorAndExit {message} {
   lappend ::errreport_buffer [list reportErrorAndExit $message]
}

# regular procedure to use once error report is initialized
proc __reportErrorAndExit {message} {
   raiseErrorCount
   renderFalse
   error $message {} MODULES_ERR_RENDERED
}

proc reportInternalBug {message {modfile {}}} {
   if {$modfile ne {}} {
      append message "\nIn '$modfile'"
   }
   append message "\nPlease contact <[getConf contact]>"
   reportError $message 0 {Module ERROR} me
}

proc reportInfo {message {title INFO}} {
   if {[isVerbosityLevel normal]} {
      # use reportError for conveniance but there is no error here
      reportError $message 0 $title in 0
   }
}

# is currently active message record id at top level
proc isMsgRecordIdTop {} {
   return [expr {[llength $::g_msgRecordIdStack] eq 1}]
}

# record messages on the eventual additional module evaluations that have
# occurred during the current evaluation
proc reportModuleEval {} {
   set evalid [currentEvalId]
   array set contexttitle {conun {Unloading conflict} reqlo {Loading\
      requirement} depre {Reloading dependent} depun {Unloading dependent}\
      urequn {Unloading useless requirement}}

if {[info exists ::g_moduleEval($evalid)]} {
      foreach contextevallist $::g_moduleEval($evalid) {
         set modlist [lassign $contextevallist context]
         # skip context with no description title
         if {[info exists contexttitle($context)]} {
            reportInfo [join $modlist] $contexttitle($context)
         }
      }
      # purge list in case same evaluation is re-done afterward
      unset ::g_moduleEval($evalid)
   }
}

# render messages related to current record id under an header block
proc reportMsgRecord {header} {
   set recid [currentMsgRecordId]
   if {[info exists ::g_msgRecord($recid)]} {
      # skip message report if silent
      if {[isVerbosityLevel concise]} {
         set tty_cols [getTtyColumns]
         set padding {  }

set dispmsg $header
         foreach msg $::g_msgRecord($recid) {
            # split lines if too large for terminal
            set first 1
            set max_idx [expr {$tty_cols - [string length $padding]}]
            set linelist [list]
            foreach line [split $msg \n] {
               set lineadd {}
               while {$lineadd ne $line} {
                  set line_max_idx $max_idx
                  # sgr tags consume no length
                  set eidx 0
                  while {[set sidx [string first "\033\[" $line $eidx]] !=\
                     -1} {
                     set eidx [string first m $line $sidx]
                     incr line_max_idx [expr {1 + $eidx - $sidx}]
                  }

# no split if no whitespace found to slice
                  if {[string length $line] > $line_max_idx && [set cut_idx\
                     [string last { } $line $line_max_idx]] != -1} {
                     set lineadd [string range $line 0 [expr {$cut_idx-1}]]
                     set line [string range $line [expr {$cut_idx+1}] end]
                  } else {
                     set lineadd $line
                  }
                  lappend linelist $lineadd
                  if {$first} {
                     set first 0
                     incr max_idx -[string length $padding]
                  }
               }
            }

# display each line
            set first 1
            foreach line $linelist {
               append dispmsg \n
               if {$first} {
                  set first 0
               } else {
                  append dispmsg $padding
               }
               append dispmsg $padding$line
            }
         }
         reportSeparateNextContent
         report $dispmsg
         reportSeparateNextContent
      }

# purge message list in case same evaluation is re-done afterward
      unset ::g_msgRecord($recid)
   # report header if no other specific msg to output in verbose mode or in
   # normal verbosity mode if currently processing a cmd which triggers
   # multiple module evaluations that cannot be guessed by the user
   } elseif {[isVerbosityLevel verbose] || ([isVerbosityLevel normal] && (\
      [ongoingCommandName restore] || [ongoingCommandName source]))} {
      report $header
   }
}

# separate next content produced if any
proc reportSeparateNextContent {} {
   lappend ::errreport_buffer [list reportSeparateNextContent]
}

# regular procedure to use once error report is initialized
proc __reportSeparateNextContent {} {
   # hold or apply
   if {[isReportHeld]} {
      lappend ::g_holdReport([currentReportHoldId]) [list\
         reportSeparateNextContent]
   } else {
      set ::g_report_sep_next 1
   }
}

proc isReportFormat {format} {
   return [expr {$::g_report_format eq $format}]
}

# save message for block rendering
proc recordMessage {message {recordtop 0}} {
   lappend ::g_msgRecord([expr {$recordtop ? [topMsgRecordId] :\
      [currentMsgRecordId]}]) $message
}

# filter and format error stack trace to only report useful content
proc formatErrStackTrace {errmsg loc {cmdlist {}}} {
   set headstr "\n    while executing\n"
   set splitstr "\n    invoked from within\n"
   set splitstrlen [string length $splitstr]
   set aftheadidx [string first $headstr $errmsg]
   if {$aftheadidx != -1} {
      incr aftheadidx [string length $headstr]
   }

# get name of invalid command name to maintain it in error stack trace
   if {[string equal -length 22 {invalid command name "} $errmsg]} {
      set unkcmd [lindex [split [string range $errmsg 0 $aftheadidx] {"}] 1]
   } else {
      set unkcmd {}
   }

# get list of modulecmd.tcl internal procedure to filter out from stack
   # skip this when no interp command list is provided
   if {[llength $cmdlist] > 0} {
      lassign [getDiffBetweenList [concat [info commands] [info procs]]\
         $cmdlist] filtercmdlist keepcmdlist
   } else {
      set filtercmdlist {}
   }

# define commands to filter out from bottom of stack
   set filtercmdendlist [list {eval $modcontent} "source $loc" {uplevel 1\
      source $siteconfig}]

# filter out modulecmd internal references at beginning of stack
   set internals 1
   while {$internals && $aftheadidx != -1} {
      # fetch erroneous command and its caller
      set stackelt [string range $errmsg $aftheadidx [string first\
         $splitstr $errmsg $aftheadidx]]
      lassign [split [lindex [split $stackelt {"}] 1]] cmd1 cmd2
      set cmdcaller [lindex [split [string range $stackelt [string last\
         {(procedure } $stackelt] end] {"}] 1]
      if {$cmd1 eq {eval}} {
         set cmd1 $cmd2
      }

# filter out stack element refering to or called by an unknown procedure
      # (ie. a modulecmd.tcl internal procedure)
      if {[string index $cmd1 0] ne {$} && $cmd1 ne $unkcmd && ([isInList\
         $filtercmdlist $cmdcaller] || [isInList $filtercmdlist $cmd1])} {
         set errmsg [string replace $errmsg $aftheadidx [expr {[string first\
            $splitstr $errmsg] + $splitstrlen - 1}]]
      } else {
         set internals 0
      }
   }

# filter out modulecmd internal references at end of stack
   set internals 1
   while {$internals} {
      set beffootidx [string last $splitstr $errmsg]
      set stackelt [string range $errmsg $beffootidx end]
      set cmd [lindex [split $stackelt {"}] 1]

if {[isInList $filtercmdendlist $cmd]} {
         set errmsg [string replace $errmsg $beffootidx end]
      } else {
         set internals 0
      }
   }

# replace error location at end of stack
   set lastnl [string last \n $errmsg]
   set lastline [string range $errmsg [expr {$lastnl + 1}] end]
   if {[string match {    ("eval" body line*} $lastline]} {
      set errmsg [string replace $errmsg $lastnl [expr {$lastnl + [string\
         length "    (\"eval\" body line"]}] "\n    (file \"$loc\" line"]
   } elseif {![string match {    (file *} $lastline]} {
      # add error location at end of stack
      append errmsg "\n    (file \"$loc\")"
   }

return $errmsg
}

# Select Graphic Rendition of a string with passed sgr key (if color enabled)
proc sgr {sgrkey str} {
   if {[getConf color] && [info exists ::g_colors($sgrkey)]} {
      set sgrset $::g_colors($sgrkey)
      # if render bold or faint just reset that attribute, not all
      if {$sgrset == 1 || $sgrset == 2} {
         set sgrreset 22
      } else {
         set sgrreset 0
      }
      set str "\033\[${sgrset}m$str\033\[${sgrreset}m"
   }
   return $str
}

# save message if report is not yet initialized
proc report {message {nonewline 0} {immed 0} {padnl 0}} {
   lappend ::errreport_buffer [list report $message $nonewline $immed $padnl]
}

# regular procedure to use once error report is initialized
proc __report {message {nonewline 0} {immed 0} {padnl 0}} {
   # hold or print output
   if {!$immed && [isReportHeld]} {
      lappend ::g_holdReport([currentReportHoldId]) [list report $message\
         $nonewline $immed $padnl]
   } else {
      if {![info exists ::g_already_report]} {
         set ::g_already_report 1
         # start pager at first call and only if enabled
         if {$::start_pager} {
            startPager
         }
         # startup content in case of structured output format
         if {[isReportFormat json]} {
            report \{ 1
         }
      # produce blank line prior message if asked to
      } elseif {[info exists ::g_report_sep_next]} {
         unset ::g_report_sep_next
         report [expr {[isReportFormat json] ? {,} : {}}]
      }
      # prefix msg lines after first one with 2 spaces
      if {$padnl} {
         set first 1
         foreach line [split $message \n] {
            if {$first} {
               set first 0
            } else {
               append padmsg "\n  "
            }
            append padmsg $line
         }
         set message $padmsg
      }

# protect from issue with fd, just ignore it
      catch {
         if {$nonewline} {
            puts -nonewline $::reportfd $message
         } else {
            puts $::reportfd $message
         }
      }
   }
}

# report error the correct way depending of its type
proc reportIssue {issuetype issuemsg {issuefile {}}} {
   switch -- $issuetype {
      invalid {
         reportInternalBug $issuemsg $issuefile
      }
      default {
         reportError $issuemsg
      }
   }
}

# report defined command (used in display evaluation mode)
proc reportCmd {cmd args} {
   set extratab [expr {[string length $cmd] < 8 ? "\t" : {}}]
   # only brace empty arguments or those containing whitespace
   set cmdargs {}
   foreach cmdarg $args {
      if {$cmdargs ne {}} {
         append cmdargs { }
      }
      if {$cmdarg eq {} || [string first { } $cmdarg] > -1} {
         append cmdargs "{$cmdarg}"
      } else {
         append cmdargs $cmdarg
      }
   }
   report [sgr cm $cmd]$extratab\t$cmdargs

# empty string returns if command result is another command input
   return {}
}

# report defined command (called as an execution trace)
proc reportCmdTrace {cmdstring args} {
   eval reportCmd $cmdstring
}

proc reportVersion {} {
   report {Modules Release 4.5.2\
      (2020-07-30)}
}

# disable error reporting (non-critical report only) unless debug enabled
proc inhibitErrorReport {} {
   if {![isVerbosityLevel debug]} {
      set ::g_inhibit_errreport 1
   }
}

proc reenableErrorReport {} {
   set ::g_inhibit_errreport 0
}

proc isErrorReportInhibited {} {
   return $::g_inhibit_errreport
}

# init error report and output buffered messages
proc initErrorReport {} {
   # ensure init is done only once
   if {![info exists ::g_init_error_report]} {
      set ::g_init_error_report 1
      # determine message paging configuration and enablement
      initPager

# ask for color init now as debug mode has already fire lines to render
      # and we want them to be reported first (not the color init lines)
      if {[isVerbosityLevel debug]} {
         getConf color
      }

# replace report procedures used to bufferize messages until error
      # report being initialized by regular report procedures
      rename ::reportDebug {}
      if {[isVerbosityLevel debug]} {
         rename ::__reportDebug ::reportDebug
      } else {
         # set a disabled version if debug is disabled
         rename ::__reportDebugNop ::reportDebug
      }
      rename ::reportError {}
      rename ::__reportError ::reportError
      rename ::reportErrorAndExit {}
      rename ::__reportErrorAndExit ::reportErrorAndExit
      rename ::reportSeparateNextContent {}
      rename ::__reportSeparateNextContent ::reportSeparateNextContent
      rename ::report {}
      rename ::__report ::report

# now error report is init output every message saved in buffer
      foreach errreport $::errreport_buffer {
         eval $errreport
      }
   }
}

# drop or report held messages
proc releaseHeldReport {args} {
   foreach {holdid action} $args {
      if {[info exists ::g_holdReport($holdid)]} {
         if {$action eq {report}} {
            foreach repcall $::g_holdReport($holdid) {
               eval $repcall
            }
         }
         unset ::g_holdReport($holdid)
      }
   }
}

# exit in a clean manner by closing interaction with external components
proc cleanupAndExit {code} {
   # finish output document if json format enabled
   if {[isReportFormat json]} {
      # render error messages all together
      if {[info exists ::g_report_erralist]} {
         # ignite report first to get eventual error message from report
         # initialization in order 'foreach' got all messages prior firing
         report "\"errors\": \[" 1
         foreach {sev msg} $::g_report_erralist {
            # split message in lines
            lappend dispmsglist "\n{ \"severity\": \"$sev\", \"message\": \[\
               \"[join [split [charEscaped $msg \"] \n] {", "}]\" \] }"
         }
         report "[join $dispmsglist ,] \]"
      }
      # inhibit next content separator if output is ending
      if {[info exists ::g_report_sep_next]} {
         unset ::g_report_sep_next
      }
      report \}
   }

# close pager if enabled
   if {$::reportfd ne {stderr}} {
      catch {flush $::reportfd}
      catch {close $::reportfd}
   }

exit $code
}

# init configuration for output paging to prepare for startup
proc initPager {} {
   set pager [getConf pager]
   # empty or 'cat' pager command means no-pager
   set no_cmds [list {} cat]
   # default pager enablement depends on pager command value
   set ::use_pager [notInList $no_cmds [file tail [lindex $pager 0]]]
   set init_use_pager [notInList $no_cmds [file tail [lindex\
      $::g_config_defs(pager) 1]]]

# paging may have been enabled or disabled from the command-line
   if {[info exists ::asked_use_pager]} {
      # asked enablement could only nullify a previous asked disablement
      # as it requires a valid pager command configuration, which by default
      # enables pagination
      if {!$::asked_use_pager && $::use_pager} {
         set ::use_pager 0
      }
      set asked $::asked_use_pager
   } else {
      set asked -
   }

# some module command may also turn off pager
   if {$::command eq {clear} || ($::command eq {ml} && [lindex $::otherargv\
      0] eq {clear})} {
      set ::use_pager 0
   }

# start paging if enabled and if error stream is attached to a terminal
   set is_tty [isStderrTty]
   if {$is_tty && $::use_pager} {
      reportDebug "start pager (asked_use_pager=$asked, cmd='$pager')"
      set ::start_pager 1
   } else {
      reportDebug "no pager start (is_tty=$is_tty, mod_cmd='$::command',\
         use_pager=$::use_pager, asked_use_pager=$asked, cmd='$pager')"
      set ::start_pager 0
   }
}

# start pager pipe process with defined configuration
proc startPager {} {
   if {[catch {
      set ::reportfd [open "|[getConf pager] >@stderr 2>@stderr" w]
      fconfigure $::reportfd -buffering line -blocking 1 -buffersize 65536
   } errMsg]} {
      reportWarning $errMsg
   }
}

# helper procedures to format various messages
proc getHintUnFirstMsg {modlist} {
   return "HINT: Might try \"module unload [join $modlist]\" first."
}

proc getHintLoFirstMsg {modlist} {
   if {[llength $modlist] > 1} {
      set oneof {at least one of }
      set mod modules
   } else {
      set oneof {}
      set mod module
   }
   return "HINT: ${oneof}the following $mod must be loaded first: $modlist"
}

proc getErrConflictMsg {mod conlist} {
   return "$mod cannot be loaded due to a conflict.\n[getHintUnFirstMsg\
      $conlist]"
}

proc getErrPrereqMsg {mod prelist {load 1}} {
   lassign [if {$load} {list {} missing [getHintLoFirstMsg $prelist]}\
      {list un a [getHintUnFirstMsg $prelist]}] un mis hintmsg
   return "$mod cannot be ${un}loaded due to $mis prereq.\n$hintmsg"
}

proc getErrReqLoMsg {prelist} {
   return "Load of requirement '[join $prelist {' or '}]' failed"
}

proc getReqNotLoadedMsg {prelist} {
   return "Requirement '[join $prelist {' or '}]' is not loaded"
}

proc getDepLoadedMsg {prelist} {
   set is [expr {[llength $prelist] > 1 ? {are} : {is}}]
   return "Dependent '[join $prelist {' and '}]' $is loaded"
}

proc getErrConUnMsg {conlist} {
   return "Unload of conflicting '[join $conlist {' and '}]' failed"
}

proc getConIsLoadedMsg {conlist {loading 0}} {
   set is [expr {[llength $conlist] > 1 ? {are} : {is}}]
   set loaded [expr {$loading ? {loading} : {loaded}}]
   return "Conflicting '[join $conlist {' and '}]' $is $loaded"
}

########################################################################
# Use a slave TCL interpreter to execute modulefiles
#

# dummy proc to disable modulefile commands on some evaluation modes
proc nop {args} {}

# dummy proc for commands available on other Modules flavor but not here
proc nimp {cmd args} {
   reportWarning "'$cmd' command not implemented"
}

proc get-env {var {valifunset {}}} {
   # return current value if exists and not cleared
   if {[info exists ::env($var)] && ![info exists ::g_clearedEnvVars($var)]} {
      return $::env($var)
   } else {
      return $valifunset
   }
}

proc set-env {var val} {
   set mode [currentMode]
   reportDebug "$var=$val"
   interp-sync-env set $var $val

# variable is not cleared anymore if set again
   if {[info exists ::g_clearedEnvVars($var)]} {
      unset ::g_clearedEnvVars($var)
   }

# propagate variable setup to shell environment on load and unload mode
   if {$mode eq {load} || $mode eq {unload}} {
      set ::g_stateEnvVars($var) new
   }
}

proc reset-to-unset-env {var {val {}}} {
   interp-sync-env set $var $val
   # set var as cleared if val is empty
   if {$val eq {}} {
      set ::g_clearedEnvVars($var) 1
   }
}

proc unset-env {var {internal 0} {val {}}} {
   set mode [currentMode]
   reportDebug "$var (internal=$internal, val=$val)"

# clear value instead of unset it not to break variable later reference
   # in modulefile. clear whether variable set or not to get a later usage
   # consistent behavior whatever env is setup
   if {!$internal} {
      reset-to-unset-env $var $val
   # internal variables (like ref counter var) are purely unset if they exists
   } elseif {[info exists ::env($var)]} {
      interp-sync-env unset $var
      set intwasset 1
   }

# propagate deletion in any case if variable is public and for internal
   # one only if variable was set
   if {($mode eq {load} || $mode eq {unload}) && (!$internal ||\
      [info exists intwasset])} {
      set ::g_stateEnvVars($var) del
   }
}

# synchronize environment variable change over all started sub interpreters
proc interp-sync-env {op var {val {}}} {
   set envvar ::env($var)

# apply operation to main interpreter
   switch -- $op {
      set { set $envvar $val }
      unset { unset $envvar }
   }

# apply operation to each sub-interpreters if not found autosynced
   if {[llength [interp slaves]] > 0} {
      reportDebug "$op var='$envvar', val='$val' on interp(s) [interp slaves]"

foreach itrp [interp slaves] {
         switch -- $op {
            set {
               # no value pre-check on Windows platform as an empty value set
               # means unsetting variable which lead querying value to error
               if {[isWin] || ![interp eval $itrp [list info exists $envvar]]\
                  || [interp eval $itrp [list set $envvar]] ne $val} {
                  interp eval $itrp [list set $envvar $val]
               }
            }
            unset {
               if {[interp eval $itrp [list info exists $envvar]]} {
                  interp eval $itrp [list unset $envvar]
               }
            }
         }
      }
   }
}

# Initialize list of interp alias commands to define for given evaluation mode
proc initModfileModeAliases {mode aliasesVN aliasesPassArgVN tracesVN} {
   global g_modfilePerModeAliases
   upvar #0 $aliasesVN aliases
   upvar #0 $aliasesPassArgVN aliasesPassArg
   upvar #0 $tracesVN traces

if {![info exists g_modfilePerModeAliases]} {
      set ::g_modfileBaseAliases [list getenv getenv is-loaded is-loaded\
         is-saved is-saved is-used is-used is-avail is-avail uname uname\
         module-info module-info exit exitModfileCmd reportCmdTrace\
         reportCmdTrace reportInternalBug reportInternalBug reportWarning\
         reportWarning reportError reportError raiseErrorCount\
         raiseErrorCount report report isVerbosityLevel isVerbosityLevel\
         isWin isWin puts putsModfileCmd readModuleContent readModuleContent\
         formatErrStackTrace formatErrStackTrace]

# list of alias commands whose target procedure is adapted according to
      # the evaluation mode
      set ::g_modfileEvalModes {load unload display help test whatis}
      array set g_modfilePerModeAliases {
append-path    {append-path    remove-path    append-path    append-path    append-path    edit-path-wh  }
chdir          {chdir          nop            reportCmd      nop            nop            nop           }
conflict       {conflict       nop            reportCmd      nop            nop            nop           }
module         {module         module         reportCmd      nop            nop            nop           }
module-alias   {module-alias   module-alias   module-alias   module-alias   module-alias   module-alias  }
module-log     {nimp           nimp           reportCmd      nop            nop            nop           }
module-trace   {nimp           nimp           reportCmd      nop            nop            nop           }
module-user    {nimp           nimp           reportCmd      nop            nop            nop           }
module-verbosity {nimp         nimp           reportCmd      nop            nop            nop           }
module-version {module-version module-version module-version module-version module-version module-version}
module-virtual {module-virtual module-virtual module-virtual module-virtual module-virtual module-virtual}
module-whatis  {nop            nop            reportCmd      nop            nop            module-whatis }
prepend-path   {prepend-path   remove-path    prepend-path   prepend-path   prepend-path   edit-path-wh  }
prereq         {prereq         nop            reportCmd      nop            nop            nop           }
remove-path    {remove-path    remove-path-un remove-path    remove-path    remove-path    edit-path-wh  }
set-alias      {set-alias      set-alias-un   reportCmd      nop            nop            nop           }
set-function   {set-function   set-function-un reportCmd     nop            nop            nop           }
setenv         {setenv         setenv-un      setenv         setenv         setenv         setenv-wh     }
system         {system         system         reportCmd      nop            nop            nop           }
unset-alias    {unset-alias    nop            reportCmd      nop            nop            nop           }
unset-function {unset-function nop            reportCmd      nop            nop            nop           }
unsetenv       {unsetenv       unsetenv-un    unsetenv       unsetenv       unsetenv       setenv-wh     }
x-resource     {x-resource     x-resource     reportCmd      nop            nop            nop           }
      }
   }

# alias commands where interpreter ref should be passed as argument
   array set aliasesPassArg [list puts __itrp__]

# initialize list with all commands not dependent of the evaluation mode
   array set aliases $::g_modfileBaseAliases

# add alias commands whose target command vary depending on the eval mode
   set modeidx [lsearch -exact $::g_modfileEvalModes $mode]
   foreach alias [array names g_modfilePerModeAliases] {
      set aliastarget [set aliases($alias) [lindex\
         $g_modfilePerModeAliases($alias) $modeidx]]
      # some target procedures need command name as first arg
      if {$aliastarget eq {reportCmd} || $aliastarget eq {nimp}} {
         set aliasesPassArg($alias) $alias
      # associate a trace command if per-mode alias command is not reportCmd
      # in display mode
      } elseif {$mode eq {display}} {
         set traces($alias) reportCmdTrace
      }
   }
}

proc execute-modulefile {modfile modname modspec {must_have_cookie 1}} {
   pushModuleFile $modfile
   pushModuleName $modname
   pushSpecifiedName $modspec
   set mode [currentMode]
   pushDebugMsgPrefix [getEvalModuleStackDepth] $mode $modname

# skip modulefile if interpretation has been inhibited
   if {$::g_inhibit_interp} {
      reportDebug "skipping $modfile"
      return 1
   }

reportDebug "sourcing $modfile"

if {![info exists ::g_modfileUntrackVars]} {
      # list variable that should not be tracked for saving
      array set ::g_modfileUntrackVars [list ModulesCurrentModulefile 1\
         must_have_cookie 1 modcontent 1 env 1]

# commands that should be renamed before aliases setup
      array set ::g_modfileRenameCmds [list puts _puts]
   }
   # dedicate an interpreter per mode and per level of interpretation to have
   # a dedicated interpreter in case of cascaded multi-mode interpretations
   set itrp __modfile_${mode}_[getEvalModuleStackDepth]

# evaluation mode-specific configuration
   set dumpCommandsVN g_modfile${mode}Commands
   set aliasesVN g_modfile${mode}Aliases
   set aliasesPassArgVN g_modfile${mode}AliasesPassArg
   set tracesVN g_modfile${mode}Traces
   if {![info exists ::$aliasesVN]} {
      initModfileModeAliases $mode $aliasesVN $aliasesPassArgVN $tracesVN
   }

# create modulefile interpreter at first interpretation
   if {![interp exists $itrp]} {
      reportDebug "creating interp $itrp"
      interp create $itrp

# dump initial interpreter state to restore it before each modulefile
      # interpretation. use same dump state for all modes/levels
      if {![info exists ::g_modfileVars]} {
         dumpInterpState $itrp g_modfileVars g_modfileArrayVars\
            g_modfileUntrackVars g_modfileProcs
      }

# interp has just been created
      set fresh 1
   } else {
      set fresh 0
   }

# reset interp state command before each interpretation
   resetInterpState $itrp $fresh g_modfileVars g_modfileArrayVars\
      g_modfileUntrackVars g_modfileProcs $aliasesVN $aliasesPassArgVN\
      $tracesVN g_modfileRenameCmds $dumpCommandsVN

# reset modulefile-specific variable before each interpretation
   interp eval $itrp set ::ModulesCurrentModulefile "{$modfile}"
   interp eval $itrp set must_have_cookie $must_have_cookie

set errorVal [interp eval $itrp {
      set modcontent [readModuleContent $::ModulesCurrentModulefile 1\
         $must_have_cookie]
      if {$modcontent eq {}} {
         return 1
      }
      info script $::ModulesCurrentModulefile
      # eval then call for specific proc depending mode under same catch
      set sourceFailed [catch {
         eval $modcontent
         switch -- [module-info mode] {
            help {
               if {[info procs ModulesHelp] eq {ModulesHelp}} {
                  ModulesHelp
               } else {
                  reportWarning "Unable to find ModulesHelp in\
                     $::ModulesCurrentModulefile."
               }
            }
            display {
               if {[info procs ModulesDisplay] eq {ModulesDisplay}} {
                  ModulesDisplay
               }
            }
            test {
               if {[info procs ModulesTest] eq {ModulesTest}} {
                  if {[string is true -strict [ModulesTest]]} {
                     report {Test result: PASS}
                  } else {
                     report {Test result: FAIL}
                     raiseErrorCount
                  }
               } else {
                  reportWarning "Unable to find ModulesTest in\
                     $::ModulesCurrentModulefile."
               }
            }
         }
      } errorMsg]
      if {$sourceFailed} {
         # no error in case of "continue" command
         # catch continue even if called outside of a loop
         if {$errorMsg eq {invoked "continue" outside of a loop}\
            || $sourceFailed == 4} {
            unset errorMsg
            return 0
         # catch break even if called outside of a loop
         } elseif {$errorMsg eq {invoked "break" outside of a loop}\
            || ($errorMsg eq {} && (![info exists ::errorInfo]\
            || $::errorInfo eq {}))} {
            unset errorMsg
            # report load/unload evaluation break if verbosity level >= normal
            if {([module-info mode load] || [module-info mode unload]) &&\
               [isVerbosityLevel normal]} {
               reportError {Module evaluation aborted}
            } else {
               raiseErrorCount
            }
            return 1
         } elseif {$errorCode eq {MODULES_ERR_SUBFAILED}} {
            # error counter and message already handled, just return error
            return 1
         } elseif {$errorCode eq {MODULES_ERR_GLOBALTOP}} {
            reportError $errorMsg 1
            return 1
         } elseif {$errorCode eq {MODULES_ERR_GLOBAL}} {
            reportError $errorMsg
            return 1
         } else {
            # format stack trace to report modulefile information only
            reportInternalBug [formatErrStackTrace $::errorInfo\
               $::ModulesCurrentModulefile [concat [info procs] [info\
               commands]]]
            return 1
         }
      } else {
         unset errorMsg
         return 0
      }
   }]

reportDebug "exiting $modfile"
   popDebugMsgPrefix
   popSpecifiedName
   popModuleName
   popModuleFile

return $errorVal
}

# Smaller subset than main module load... This function runs modulerc and
# .version files
proc execute-modulerc {modfile modname modspec} {
   pushModuleFile $modfile
   # push name to be found by module-alias and version
   pushModuleName $modname
   pushSpecifiedName $modspec
   set ::ModulesVersion {}
   pushDebugMsgPrefix [getEvalModuleStackDepth] $modname

if {![info exists ::g_modrcUntrackVars]} {
      # list variable that should not be tracked for saving
      array set ::g_modrcUntrackVars [list ModulesCurrentModulefile 1\
         ModulesVersion 1 modcontent 1 env 1]

# commands that should be renamed before aliases setup
      array set ::g_modrcRenameCmds [list]

# list interpreter alias commands to define
      array set ::g_modrcAliases [list uname uname system system chdir\
         nop is-loaded is-loaded module-version module-version module-alias\
         module-alias module-virtual module-virtual module nop module-info\
         module-info module-trace nop module-verbosity nop module-user nop\
         module-log nop reportInternalBug reportInternalBug setModulesVersion\
         setModulesVersion readModuleContent readModuleContent\
         formatErrStackTrace formatErrStackTrace]

# alias commands where an argument should be passed
      array set ::g_modrcAliasesPassArg [list]

# trace commands that should be associated to aliases
      array set ::g_modrcAliasesTraces [list]
   }

# dedicate an interpreter per level of interpretation to have in case of
   # cascaded interpretations a specific interpreter per level
   set itrp __modrc_[getEvalModuleStackDepth]

reportDebug "sourcing $modfile"
   # create modulerc interpreter at first interpretation
   if {![interp exists $itrp]} {
      reportDebug "creating interp $itrp"
      interp create $itrp

# dump initial interpreter state to restore it before each modulerc
      # interpreation. use same dump state for all levels
      if {![info exists ::g_modrcVars]} {
         dumpInterpState $itrp g_modrcVars g_modrcArrayVars\
            g_modrcUntrackVars g_modrcProcs
      }

# interp has just been created
      set fresh 1
   } else {
      set fresh 0
   }

# reset interp state command before each interpretation
   resetInterpState $itrp $fresh g_modrcVars g_modrcArrayVars\
      g_modrcUntrackVars g_modrcProcs g_modrcAliases g_modrcAliasesPassArg\
      g_modrcAliasesTraces g_modrcRenameCmds g_modrcCommands

interp eval $itrp set ::ModulesCurrentModulefile "{$modfile}"
   interp eval $itrp {set ::ModulesVersion {}}

set errorVal [interp eval $itrp {
      set modcontent [readModuleContent $::ModulesCurrentModulefile]
      if {$modcontent eq {}} {
         # simply skip rc file, no exit on error here
         return 1
      }
      info script $::ModulesCurrentModulefile
      if [catch {eval $modcontent} errorMsg] {
         # format stack trace to report modulerc information only
         reportInternalBug [formatErrStackTrace $::errorInfo\
            $::ModulesCurrentModulefile [concat [info procs] [info commands]]]
         return 1
      } else {
         # pass ModulesVersion value to master interp
         if {[info exists ::ModulesVersion]} {
            setModulesVersion $::ModulesVersion
         }
         return 0
      }
   }]

# default version set via ModulesVersion variable in .version file
   # override previously defined default version for modname
   lassign [getModuleNameVersion] mod modname modversion
   if {$modversion eq {.version} && $::ModulesVersion ne {}} {
      # ModulesVersion should target an element in current directory
      if {[string first / $::ModulesVersion] == -1} {
         setModuleResolution $modname/default $modname/$::ModulesVersion\
            default
      } else {
         reportError "Invalid ModulesVersion '$::ModulesVersion' defined"
      }
   }

popDebugMsgPrefix
   popSpecifiedName
   popModuleName
   popModuleFile

return $::ModulesVersion
}

# Save list of the defined procedure and the global variables with their
# associated values set in slave interpreter passed as argument. Global
# structures are used to save these information and the name of these
# structures are provided as argument.
proc dumpInterpState {itrp dumpVarsVN dumpArrayVarsVN untrackVarsVN\
   dumpProcsVN} {
   upvar #0 $dumpVarsVN dumpVars
   upvar #0 $dumpArrayVarsVN dumpArrayVars
   upvar #0 $untrackVarsVN untrackVars
   upvar #0 $dumpProcsVN dumpProcs

regexp {^__[a-z]+} $itrp itrpkind
   # save name and value for any other global variables
   foreach var [$itrp eval {info globals}] {
      if {![info exists untrackVars($var)]} {
         reportDebug "saving for $itrpkind var $var"
         if {[$itrp eval array exists ::$var]} {
            set dumpVars($var) [$itrp eval array get ::$var]
            set dumpArrayVars($var) 1
         } else {
            set dumpVars($var) [$itrp eval set ::$var]
         }
      }
   }

# save name of every defined procedures
   foreach var [$itrp eval {info procs}] {
      set dumpProcs($var) 1
   }
   reportDebug "saving for $itrpkind proc list [array names dumpProcs]"
}

# Define commands to be known by slave interpreter.
proc initInterpCommands {itrp fresh aliasesVN aliasesPassArgVN tracesVN\
   renameCmdsVN} {
   upvar #0 $aliasesVN aliases
   upvar #0 $aliasesPassArgVN aliasesPassArg
   upvar #0 $tracesVN traces
   upvar #0 $renameCmdsVN renameCmds

# rename some commands on freshly created interp before aliases defined
   # below overwrite them
   if {$fresh} {
      foreach cmd [array names renameCmds] {
         $itrp eval rename $cmd $renameCmds($cmd)
      }
   }

# set interpreter alias commands each time to guaranty them being
   # defined and not overridden by modulefile or modulerc content
   foreach alias [array names aliases] {
      if {[info exists aliasesPassArg($alias)]} {
         set aliasarg $aliasesPassArg($alias)
         # pass current itrp reference on special keyword
         if {$aliasarg eq {__itrp__}} {
            set aliasarg $itrp
         }
         interp alias $itrp $alias {} $aliases($alias) $aliasarg
      } else {
         interp alias $itrp $alias {} $aliases($alias)
      }
   }

foreach alias [array names traces] {
      interp eval $itrp [list trace add execution $alias leave\
         $traces($alias)]
   }
}

# Restore initial setup of slave interpreter passed as argument based on
# global structure previously filled with initial list of defined procedure
# and values of global variable.
proc resetInterpState {itrp fresh dumpVarsVN dumpArrayVarsVN untrackVarsVN\
   dumpProcsVN aliasesVN aliasesPassArgVN tracesVN renameCmdsVN\
   dumpCommandsVN} {
   upvar #0 $dumpVarsVN dumpVars
   upvar #0 $dumpArrayVarsVN dumpArrayVars
   upvar #0 $untrackVarsVN untrackVars
   upvar #0 $dumpProcsVN dumpProcs
   upvar #0 $dumpCommandsVN dumpCommands

# look at list of defined procedures and delete those not part of the
   # initial state list. do not check if they have been altered as no vital
   # procedures lied there. note that if a Tcl command has been overridden
   # by a proc, it will be removed here and command will also disappear
   foreach var [$itrp eval {info procs}] {
      if {![info exists dumpProcs($var)]} {
         reportDebug "removing on $itrp proc $var"
         $itrp eval [list rename $var {}]
      }
   }

# rename some commands and set aliases on interpreter
   initInterpCommands $itrp $fresh $aliasesVN $aliasesPassArgVN $tracesVN\
      $renameCmdsVN

# dump interpreter command list here on first time as aliases should be
   # set prior to be found on this list for correct match
   if {![info exists dumpCommands]} {
      set dumpCommands [$itrp eval {info commands}]
      reportDebug "saving for $itrp command list $dumpCommands"
   # if current interpreter command list does not match initial list it
   # means that at least one command has been altered so we need to recreate
   # interpreter to guaranty proper functioning
   } elseif {$dumpCommands ne [$itrp eval {info commands}]} {
      reportDebug "missing command(s), recreating interp $itrp"
      interp delete $itrp
      interp create $itrp
      initInterpCommands $itrp 1 $aliasesVN $aliasesPassArgVN $tracesVN\
         $renameCmdsVN
   }

# check every global variables currently set and correct them to restore
   # initial interpreter state. work on variables at the very end to ensure
   # procedures and commands are correctly defined
   foreach var [$itrp eval {info globals}] {
      if {![info exists untrackVars($var)]} {
         if {![info exists dumpVars($var)]} {
            reportDebug "removing on $itrp var $var"
            $itrp eval unset ::$var
         } elseif {![info exists dumpArrayVars($var)]} {
            if {$dumpVars($var) ne [$itrp eval set ::$var]} {
               reportDebug "restoring on $itrp var $var"
               if {[llength $dumpVars($var)] > 1} {
                  # restore value as list
                  $itrp eval set ::$var [list $dumpVars($var)]
               } else {
                  # brace value to be able to restore empty string
                  $itrp eval set ::$var "{$dumpVars($var)}"
               }
            }
         } else {
            if {$dumpVars($var) ne [$itrp eval array get ::$var]} {
               reportDebug "restoring on $itrp var $var"
               $itrp eval array set ::$var [list $dumpVars($var)]
            }
         }
      }
   }
}

########################################################################
# commands run from inside a module file
#

proc module-info {what {more {}}} {
   set mode [currentMode]

reportDebug "$what $more"

switch -- $what {
      mode {
         if {$more ne {}} {
            set command [currentCommandName]
            return [expr {$mode eq $more || ($more eq {remove} && $mode eq \
               {unload}) || ($more eq {switch} && $command eq {switch})}]
         } else {
            return $mode
         }
      }
      command {
         set command [currentCommandName]
         if {$more eq {}} {
            return $command
         } else {
            return [expr {$command eq $more}]
         }
      }
      name {
         return [currentModuleName]
      }
      specified {
         return [currentSpecifiedName]
      }
      shell {
         if {$more ne {}} {
            return [expr {$::g_shell eq $more}]
         } else {
            return $::g_shell
         }
      }
      flags {
         # C-version specific option, not relevant for Tcl-version but return
         # a zero integer value to avoid breaking modulefiles using it
         return 0
      }
      shelltype {
         if {$more ne {}} {
            return [expr {$::g_shellType eq $more}]
         } else {
            return $::g_shellType
         }
      }
      user {
         # C-version specific option, not relevant for Tcl-version but return
         # an empty value or false to avoid breaking modulefiles using it
         if {$more ne {}} {
            return 0
         } else {
            return {}
         }
      }
      alias {
         set ret [resolveModuleVersionOrAlias $more [isIcase]]
         if {$ret ne $more} {
            return $ret
         } else {
            return {}
         }
      }
      trace {
         return {}
      }
      tracepat {
         return {}
      }
      type {
         return Tcl
      }
      symbols {
         lassign [getModuleNameVersion $more 1] mod modname modversion
         set tag_list [getVersAliasList $mod]
         # if querying special symbol "default" but nothing found registered
         # on it, look at symbol registered on bare module name in case there
         # are symbols registered on it but no default symbol set yet to link
         # to them
         if {[llength $tag_list] == 0 && $modversion eq {default}} {
            set tag_list [getVersAliasList $modname]
         }
         return [join $tag_list :]
      }
      version {
         lassign [getModuleNameVersion $more 1] mod
         return [resolveModuleVersionOrAlias $mod [isIcase]]
      }
      loaded {
         lassign [getModuleNameVersion $more 1] mod
         return [getLoadedMatchingName $mod returnall]
      }
      default {
         knerror "module-info $what not supported"
         return {}
      }
   }
}

proc module-whatis {args} {
   set message [join $args]
   reportDebug $message
   lappend ::g_whatis $message

return {}
}

# convert environment variable references in string to their values
# every local variable is prefixed by '0' to ensure they will not be
# overwritten through variable reference resolution process
proc resolvStringWithEnv {0str} {
   # fetch variable references in string
   set 0match_list [regexp -all -inline {\$[{]?([A-Za-z_][A-Za-z0-9_]*)[}]?}\
      ${0str}]
   if {[llength ${0match_list}] > 0} {
      # put in local scope every environment variable referred in string
      for {set 0i 1} {${0i} < [llength ${0match_list}]} {incr 0i 2} {
         set 0varname [lindex ${0match_list} ${0i}]
         if {![info exists ${0varname}]} {
            set ${0varname} [get-env ${0varname}]
         }
      }
      # resolv variable reference with values (now in local scope)
      set 0res [subst -nobackslashes -nocommands ${0str}]
   } else {
      set 0res ${0str}
   }

reportDebug "'${0str}' resolved to '${0res}'"

return ${0res}
}

# deduce modulepath from modulefile and module name
proc getModulepathFromModuleName {modfile modname} {
   return [string range $modfile 0 end-[string length /$modname]]
}

# deduce module name from modulefile and modulepath
proc getModuleNameFromModulepath {modfile modpath} {
   return [string range $modfile [string length $modpath/] end]
}

# extract module name from modulefile and currently enabled modulepaths
proc findModuleNameFromModulefile {modfile} {
   set ret {}

foreach modpath [getModulePathList] {
      if {[string first $modpath/ $modfile/] == 0} {
         set ret [getModuleNameFromModulepath $modfile $modpath]
         break
      }
   }
   return $ret
}

# extract modulepath from modulefile and currently enabled modulepaths
proc findModulepathFromModulefile {modfile} {
   set ret {}

foreach modpath [getModulePathList] {
      if {[string first $modpath/ $modfile/] == 0} {
         set ret $modpath
         break
      }
   }
   return $ret
}

# Determine with a name provided as argument the corresponding module name,
# version and name/version. Module name is guessed from current module name
# when shorthand version notation is used. Both name and version are guessed
# from current module if name provided is empty. If 'name_relative_tocur' is
# enabled then name argument may be interpreted as a name relative to the
# current modulefile directory (useful for module-version and module-alias
# for instance).
proc getModuleNameVersion {{name {}} {name_relative_tocur 0}} {
   set curmod [currentModuleName]
   set curmodname [file dirname $curmod]
   set curmodversion [file tail $curmod]

if {$name eq {}} {
      set name $curmodname
      set version $curmodversion
   # check for shorthand version notation like "/version" or "./version"
   # only if we are currently interpreting a modulefile or modulerc
   } elseif {$curmod ne {} && [regexp {^\.?\/(.*)$} $name match version]} {
      # if we cannot distinguish a module name, raise error when shorthand
      # version notation is used
      if {$::ModulesCurrentModulefile ne $curmod && $curmod ne {.modulerc}} {
         # name is the name of current module directory
         set name $curmodname
      } else {
         reportError "Invalid modulename '$name' found"
         return {}
      }
   } else {
      set name [string trimright $name /]
      set version [file tail $name]
      if {$name eq $version} {
         set version {}
      } else {
         set name [file dirname $name]
      }
      # name may correspond to last part of current module
      # if so name is replaced by current module name
      if {$name_relative_tocur && [file tail $curmodname] eq $name} {
         set name $curmodname
      }
   }

if {$version eq {}} {
      set mod $name
   } else {
      set mod $name/$version
   }

return [list $mod $name $version]
}

# Register alias or symbolic version deep resolution in a global array that
# can be used thereafter to get in one query the actual modulefile behind
# a virtual name. Also consolidate a global array that in the same manner
# list all the symbols held by modulefiles.
proc setModuleResolution {mod target {symver {}} {override_res_path 1}\
   {auto_symver 0}} {
   global g_moduleResolved g_resolvedHash g_resolvedPath g_symbolHash

# find end-point module and register step-by-step path to get to it
   set res $target
   lappend res_path $res
   while {$mod ne $res && [info exists g_resolvedPath($res)]} {
      set res $g_resolvedPath($res)
      lappend res_path $res
   }

# error if resolution end on initial module
   if {$mod eq $res} {
      reportError "Resolution loop on '$res' detected"
      return 0
   }

# module name will be useful when registering symbol
   if {$symver ne {}} {
      lassign [getModuleNameVersion $mod] modfull modname
   }

# change default symbol owner if previously given; auto symbol are defined
   # only if no default is pre-existing
   if {$symver eq {default} && !$auto_symver} {
      # alternative name "modname" is set when mod = "modname/default" both
      # names will be registered to be known for queries and resolution defs
      set modalt $modname

if {[info exists g_moduleResolved($mod)]} {
         set prev $g_moduleResolved($mod)
         # there may not be a default in case of auto symbol
         if {[info exists g_symbolHash($prev)] && [set idx [lsearch -exact\
            $g_symbolHash($prev) default]] != -1} {
            reportDebug "remove symbol 'default' from '$prev'"
            set g_symbolHash($prev) [lreplace $g_symbolHash($prev) $idx $idx]
         }
      }
   }

# register end-point resolution
   reportDebug "$mod resolved to $res"
   set g_moduleResolved($mod) $res
   # set first element of resolution path only if not already set or
   # scratching enabled, no change when propagating symbol along res path
   if {$override_res_path || ![info exists g_resolvedPath($mod)]} {
      set g_resolvedPath($mod) $target
   }
   lappend g_resolvedHash($res) $mod

# also register resolution on alternative name if any
   if {[info exists modalt]} {
      reportDebug "$modalt resolved to $res"
      set g_moduleResolved($modalt) $res
      if {$override_res_path || ![info exists g_resolvedPath($modalt)]} {
         set g_resolvedPath($modalt) $target
      }
      lappend g_resolvedHash($res) $modalt
      # register name alternative to know their existence
      set ::g_moduleAltName($modalt) $mod
      set ::g_moduleAltName($mod) $modalt
   }

# if other modules were pointing to this one, adapt resolution end-point
   set relmod_list {}
   if {[info exists g_resolvedHash($mod)]} {
      set relmod_list $g_resolvedHash($mod)
      unset g_resolvedHash($mod)
   }
   # also adapt resolution for modules pointing to the alternative name
   if {[info exists modalt] && [info exists g_resolvedHash($modalt)]} {
      set relmod_list [concat $relmod_list $g_resolvedHash($modalt)]
      unset g_resolvedHash($modalt)
   }
   foreach relmod $relmod_list {
      set g_moduleResolved($relmod) $res
      reportDebug "$relmod now resolved to $res"
      lappend g_resolvedHash($res) $relmod
   }

# register and propagate symbols to the resolution path, execption made for
   # auto symbol which are stored separately and not propagated
   if {[info exists g_symbolHash($mod)]} {
      set sym_list $g_symbolHash($mod)
   } else {
      set sym_list {}
   }
   if {$symver ne {} && $auto_symver} {
      reportDebug "define auto symbolic version '$mod' targeting $target"
      set ::g_autoSymbol($mod) $target
   } elseif {$symver ne {} && !$auto_symver} {
      # merge symbol definitions in case of alternative name
      if {[info exists modalt] && [info exists g_symbolHash($modalt)]} {
         set sym_list [lsort -dictionary -unique [concat $sym_list\
            $g_symbolHash($modalt)]]
         reportDebug "set symbols '$sym_list' to $mod and $modalt"
         set g_symbolHash($mod) $sym_list
         set g_symbolHash($modalt) $sym_list
      }

# dictionary-sort symbols and remove eventual duplicates
      set sym_list [lsort -dictionary -unique [concat $sym_list\
         [list $symver]]]

# propagate symbols in g_symbolHash and g_moduleVersion toward the
      # resolution path, handle that locally if we still work on same
      # modulename, call for a proper resolution as soon as we change of
      # module to get this new resolution registered
      foreach modres $res_path {
         lassign [getModuleNameVersion $modres] modfull modresname
         if {$modname eq $modresname} {
            if {[info exists g_symbolHash($modres)]} {
               set modres_sym_list [lsort -dictionary -unique [concat\
                  $g_symbolHash($modres) $sym_list]]
            } else {
               set modres_sym_list $sym_list
            }
            # sync symbols of alternative name if any
            if {[info exists ::g_moduleAltName($modres)]} {
               set altmodres $::g_moduleAltName($modres)
               reportDebug "set symbols '$modres_sym_list' to $modres and\
                  $altmodres"
               set g_symbolHash($altmodres) $modres_sym_list
            } else {
               reportDebug "set symbols '$modres_sym_list' to $modres"
            }
            set g_symbolHash($modres) $modres_sym_list

# register symbolic version for querying in g_moduleVersion
            foreach symelt $sym_list {
               set modvers $modresname/$symelt
               reportDebug "module-version $modvers = $modres"
               set ::g_moduleVersion($modvers) $modres
               set ::g_sourceVersion($modvers) $::ModulesCurrentModulefile
            }
         # as we change of module name a proper resolution call should be
         # made (see below) and will handle the rest of the resolution path
         } else {
            set need_set_res 1
            break
         }
      }
   # when registering an alias, existing symbols on alias source name should
   # be broadcast along the resolution path with a proper resolution call
   # (see below)
   } else {
      lassign [getModuleNameVersion $target] modres modresname
      set need_set_res 1
   }

# resolution needed to broadcast symbols along resolution path without
   # altering initial path already set for these symbols
   if {[info exists need_set_res]} {
      foreach symelt $sym_list {
         set modvers $modresname/$symelt
         reportDebug "set resolution for $modvers"
         setModuleResolution $modvers $modres $symelt 0
      }
   }

return 1
}

# retrieve all names that resolve to passed mod
proc getAllModuleResolvedName {mod {flag_autosym 0}} {
   set namelist {}
   set resmodlist {}
   set icase [isIcase]
   defineModEqProc $icase [getConf extended_default]

# get parent directories of mod
   foreach modelt [split $mod /] {
      if {[info exists modroot]} {
         append modroot /
      }
      append modroot $modelt
      lappend resmodlist $modroot
   }

# add additionnaly all the altnames set on directories, parents of mod
   # or on distant directories whose default version resolves to mod
   for {set i 0} {$i < [llength $resmodlist]} {incr i 1} {
      set modelt [getArrayKey ::g_resolvedHash [lindex $resmodlist $i] $icase]
      if {[info exists ::g_resolvedHash($modelt)]} {
         foreach resmod $::g_resolvedHash($modelt) {
            # if modelt is not a parent directory of mod, check its resolution
            # points to mod (directly for alias/sym or indirectly for dir
            # whose default version bridge resolution toward mod)
            if {[modEq $modelt $mod eqstart] || $::g_moduleResolved($resmod)\
               eq $mod || [lindex [getPathToModule\
               $::g_moduleResolved($resmod) {} 0] 1] eq $mod} {
               # prefix automatically generated symbols with 'as|' if asked
               if {$flag_autosym && [info exists ::g_autoSymbol($resmod)]} {
                  appendNoDupToList namelist as|$resmod
               } else {
                  appendNoDupToList namelist $resmod
               }

unset modroot
               foreach reselt [split [file dirname $resmod] /] {
                  if {[info exists modroot]} {
                     append modroot /
                  }
                  append modroot $reselt
                  appendNoDupToList resmodlist $modroot
               }
            }
         }
      }
   }
   return $namelist
}

# Specifies a default or alias version for a module that points to an 
# existing module version Note that aliases defaults are stored by the
# short module name (not the full path) so aliases and defaults from one
# directory will apply to modules of the same name found in other
# directories.
proc module-version {args} {
   reportDebug $args
   lassign [getModuleNameVersion [lindex $args 0] 1] mod modname modversion

# go for registration only if valid modulename
   if {$mod ne {}} {
      foreach version [lrange $args 1 end] {
         set aliasversion $modname/$version
         # do not alter a previously defined alias version
         if {![info exists ::g_moduleVersion($aliasversion)]} {
            setModuleResolution $aliasversion $mod $version
         } else {
            reportWarning "Symbolic version '$aliasversion' already defined"
         }
      }
   }

return {}
}

proc module-alias {args} {
   lassign [getModuleNameVersion [lindex $args 0]] alias
   lassign [getModuleNameVersion [lindex $args 1] 1] mod

reportDebug "$alias = $mod"

if {[setModuleResolution $alias $mod]} {
      set ::g_moduleAlias($alias) $mod
      set ::g_sourceAlias($alias) $::ModulesCurrentModulefile
   }

return {}
}

proc module-virtual {args} {
   lassign [getModuleNameVersion [lindex $args 0]] mod
   set modfile [getAbsolutePath [lindex $args 1]]

reportDebug "$mod = $modfile"

set ::g_moduleVirtual($mod) $modfile
   set ::g_sourceVirtual($mod) $::ModulesCurrentModulefile

return {}
}

proc module {command args} {
   set mode [currentMode]
   reportDebug "cmd='$command', args='$args'"

# guess if called from top level
   set topcall [expr {[getEvalModuleStackDepth] == 0}]
   set tryhelpmsg [expr {$topcall ? "\nTry 'module --help' for more\
      information." : {}}]
   if {$topcall} {
      set msgprefix {}
   } else {
      set msgprefix {module: }
   }

# resolve and check command name
   lassign [parseModuleCommandName $command help] command cmdvalid cmdempty
   # clear other args if no command name supplied
   if {$cmdempty} {
      set args {}
   }
   # raise error if supplied command is not known
   if {!$cmdvalid} {
      knerror "${msgprefix}Invalid command '$command'$tryhelpmsg"
   }

# parse options, do that globally to ignore options not related to a given
   # module sub-command (exclude them from arg list)
   lassign [eval parseModuleCommandArgs $command $args] show_oneperline\
      show_mtime show_filter search_filter search_match dump_state args

# parse module version specification
   if {[isInList [list avail paths whatis load unload switch help test\
      display path is-avail] $command]} {
      set args [eval parseModuleVersionSpecifier 0 $args]
   }

if {!$topcall} {
      # some commands can only be called from top level, not within modulefile
      switch -- $command {
         path - paths - autoinit - help - prepend-path - append-path -\
         remove-path - is-loaded - is-saved - is-used - is-avail -\
         info-loaded - clear {
            knerror "${msgprefix}Command '$command' not supported$tryhelpmsg"
         }
      }
      # other commands can only be called from modulefile evaluated from
      # command acting as top-level context (source and autoinit)
      if {([getEvalModuleStackDepth] > 1 || [notInList [list source autoinit]\
         [currentCommandName]]) && $command eq {config}} {
         knerror "${msgprefix}Command '$command' not supported$tryhelpmsg"
      }
   }

# argument number check
   switch -- $command {
      unload - source - display - initadd - initprepend - initrm - test -\
      is-avail {
         if {[llength $args] == 0} {
            set argnberr 1
         }
      }
      reload - aliases - list - purge - savelist - initlist - initclear -\
      autoinit {
         if {[llength $args] != 0} {
            set argnberr 1
         }
      }
      switch {
         if {[llength $args] == 0 || [llength $args] > 2} {
            set argnberr 1
         }
      }
      path - paths - info-loaded {
         if {[llength $args] != 1} {
            set argnberr 1
         }
      }
      search - save - restore - saverm - saveshow - clear {
         if {[llength $args] > 1} {
            set argnberr 1
         }
      }
      initswitch {
         if {[llength $args] != 2} {
            set argnberr 1
         }
      }
      prepend-path - append-path - remove-path {
         if {[llength $args] < 2} {
            set argnberr 1
         }
      }
      config {
         if {[llength $args] > 2} {
            set argnberr 1
         }
      }
   }
   if {[info exists argnberr]} {
      knerror "Unexpected number of args for '$command' command$tryhelpmsg"
   }

# define if modfile should always be fully read even for validity check
   pushAlwaysReadFullFile [expr {[isInList [list path paths list avail\
      aliases] $command]} ? 0 : 1]
   pushCommandName $command

if {$topcall} {
      # Find and execute any global rc file found
      runModulerc
   }

switch -- $command {
      load {
         # ignore flag used in collection to track non-user asked state
         set args [replaceFromList $args --notuasked]
         # no error raised on empty argument list to cope with
         # initadd command that may expect this behavior
         if {[llength $args] > 0} {
            set ret 0
            # if top command is source, consider module load commands made
            # within sourced file evaluation as top load command
            if {$topcall || ([getEvalModuleStackDepth] == 1 && (
               [aboveCommandName] eq {source} || [aboveCommandName] eq\
               {autoinit}))} {
               set ret [eval cmdModuleLoad load 1 $args]
            } elseif {$mode eq {load}} {
               # load here if no auto mode, done through prereq elsewhere
               # inhibited if currently in DepRe context
               if {![getConf auto_handling] && [currentModuleEvalContext] ne\
                  {depre}} {
                  # attempt load of not already loaded modules
                  foreach arg $args {
                     if {![is-loaded $arg] && ![is-loading $arg]} {
                        lappend modlist $arg
                     }
                  }
                  if {[info exists modlist]} {
                     set ret [eval cmdModuleLoad reqlo 0 $modlist]
                     # ignore obtained error if force mode enabled
                     if {[getForce]} {
                        set ret 0
                     }
                  }
               }
               # register modulefiles to load as individual prereqs
               foreach arg $args {
                  prereq $arg
               }
            # mods unload is handled via UReqUn mechanism when auto enabled
            # also unloads are triggered by ongoing reload, purge or
            # restore commands
            } elseif {![getConf auto_handling] && [notInList [list purge\
               reload restore] [aboveCommandName]]} {
               # on unload mode, unload mods in reverse order, if loaded
               # prior this mod, if not user asked and not required by
               # other loaded mods
               set modlist [getLoadedModuleList]
               set modidx [lsearch -exact $modlist [currentModuleName]]
               if {$modidx != 0} {
                  set priormodlist [lrange $modlist 0 $modidx]
                  foreach arg [lreverse $args] {
                     if {[set unmod [getLoadedMatchingName $arg {} 0\
                        $priormodlist]] ne {}} {
                        if {[cmdModuleUnload urequn match 1 0 1 1 $unmod]} {
                           reportWarning "Unload of useless requirement\
                              $unmod failed" 1
                        }
                     }
                  }
               }
            }
            # sub-module interpretation failed, raise error
            if {$ret && !$topcall} {
               knerror {} MODULES_ERR_SUBFAILED
            }
         }
      }
      unload {
         # if top command is source, consider module load commands made
         # within sourced file evaluation as top load command
         if {$topcall || ([getEvalModuleStackDepth] == 1 && (
            [aboveCommandName] eq {source} || [aboveCommandName] eq\
            {autoinit}))} {
            set ret [eval cmdModuleUnload unload match 1 0 0 0 $args]
         } elseif {$mode eq {load}} {
            # unload mods only on load mode, nothing done on unload mode as
            # the registered conflict guarantees the target module cannot
            # be loaded unless forced
            # do not unload module required by others even in force mode
            set ret [eval cmdModuleUnload conun match 0 0 0 1 $args]

# register modulefiles to unload as individual conflicts
            foreach arg $args {
               # do not break on error yet, go through the whole modfile
               # evaluation in case conflict is solved later on
               catch {conflict $arg}
            }
            # sub-module interpretation failed, raise error
            if {$ret} {
               knerror {} MODULES_ERR_SUBFAILED
            }
         }
      }
      reload {
         cmdModuleReload
      }
      use {
         if {$topcall || $mode eq {load}} {
            eval cmdModuleUse $args
         } else {
            eval cmdModuleUnuse $args
         }
      }
      unuse {
         eval cmdModuleUnuse $args
      }
      source {
         if {$topcall || $mode eq {load}} {
            eval cmdModuleSource $args
         } else {
            # on unload mode, unsource script in reverse order
            eval cmdModuleUnsource [lreverse $args]
         }
      }
      switch {
         # pass 'user asked state' to switch procedure
         set uasked [expr {$topcall || ([getEvalModuleStackDepth] == 1 &&\
            ([aboveCommandName] eq {source} || [aboveCommandName] eq\
            {autoinit}))}]
         if {$uasked} {
            eval cmdModuleSwitch $uasked $args
         } else {
            # CAUTION: it is not recommended to use the `switch`
            # sub-command in modulefiles as this command is intended for
            # the command-line for a 2in1 operation. Could be removed from
            # the modulefile scope in a future release. Use `module unload`
            # and `module load` commands in modulefiles instead.

switch -- $mode {
               load {
                  eval cmdModuleSwitch $uasked $args
               }
               unload {
                  # find what has been asked for unload and load
                  lassign $args swunmod swlomod
                  if {$swlomod eq {} && $swunmod ne {}} {
                     set swlomod $swunmod
                  }

# apply same mechanisms than for 'module load' and
                  # 'module unload' for an unload evaluation: nothing done
                  # for switched-off module and unload of switched-on
                  # module. If auto handling is enabled switched-on module
                  # is handled via UReqUn mechanism. Also unloads are
                  # triggered by ongoing reload, purge or restore commands
                  if {![getConf auto_handling] && $swlomod ne {} &&\
                     [notInList [list purge reload restore]\
                     [aboveCommandName]]} {
                     # unload mod if it was loaded prior this mod, not user
                     # asked and not required by another loaded module
                     set modlist [getLoadedModuleList]
                     set modidx [lsearch -exact $modlist [currentModuleName]]
                     if {$modidx != 0} {
                        set priormodlist [lrange $modlist 0 $modidx]
                        if {[set unmod [getLoadedMatchingName $swlomod {} 0\
                           $priormodlist]] ne {}} {
                           if {[cmdModuleUnload urequn match 1 0 1 1 $unmod]} {
                              reportWarning "Unload of useless requirement\
                                 $unmod failed" 1
                           }
                        }
                     }
                  }
               }
            }
         }
      }
      display {
         eval cmdModuleDisplay $args
      }
      avail {
         eval cmdModuleAvail $show_oneperline $show_mtime "{$show_filter}"\
            "{$search_filter}" "{$search_match}" $args
      }
      aliases {
         cmdModuleAliases
      }
      path {
         eval cmdModulePath $args
      }
      paths {
         eval cmdModulePaths $args
      }
      list {
         cmdModuleList $show_oneperline $show_mtime
      }
      whatis {
         if {$args ne {}} {
            foreach arg $args {
               cmdModuleWhatIs $arg
            }
         } else {
            cmdModuleWhatIs
         }
      }
      search {
         eval cmdModuleApropos $args
      }
      purge {
         eval cmdModulePurge
      }
      save {
         eval cmdModuleSave $args
      }
      restore {
         eval cmdModuleRestore $args
      }
      saverm {
         eval cmdModuleSaverm $args
      }
      saveshow {
         eval cmdModuleSaveshow $args
      }
      savelist {
         cmdModuleSavelist $show_oneperline $show_mtime
      }
      initadd {
         eval cmdModuleInit add $args
      }
      initprepend {
         eval cmdModuleInit prepend $args
      }
      initswitch {
         eval cmdModuleInit switch $args
      }
      initrm {
         eval cmdModuleInit rm $args
      }
      initlist {
         eval cmdModuleInit list $args
      }
      initclear {
         eval cmdModuleInit clear $args
      }
      autoinit {
         cmdModuleAutoinit
      }
      clear {
         # ensure empty string is correctly passed
         eval cmdModuleClear "{$args}"
      }
      config {
         eval cmdModuleConfig $dump_state $args
      }
      help {
         eval cmdModuleHelp $args
      }
      test {
         eval cmdModuleTest $args
      }
      prepend-path - append-path - remove-path - is-loaded - is-saved -\
      is-used - is-avail {
         eval cmdModuleResurface $command $args
      }
      info-loaded {
         eval cmdModuleResurface module-info loaded $args
      }
   }
   popCommandName
   popAlwaysReadFullFile

# if called from top level render settings if any
   if {$topcall} {
      renderSettings
   }

return {}
}

proc ml {args} {
   # ml cannot be called within modulefile, top level only
   if {[getEvalModuleStackDepth] > 0} {
      knerror {Command 'ml' not supported}
   }

# filter out all known options from argument list to guess command name
   # without them in the way
   lassign [eval parseModuleCommandArgs ml $args] show_oneperline\
      show_mtime show_filter search_filter search_match dump_state fargs

# determine if first argument is a known module sub-command
   lassign [parseModuleCommandName [lindex $fargs 0] list] command cmdvalid\
      cmdempty

if {$cmdempty} {
      # consider empty string supplied as first argument as module name
      if {[llength $fargs] > 0} {
         set cmdvalid 0
      }
      set margs $args
   } else {
      # first argument was command name
      set margs [lrange $args 1 end]
   }

# directly call module procedure if sub-command spotted as first argument
   # or no argument supplied
   if {$cmdvalid} {
      eval module $command $margs
   } else {
      # no need to look for option arguments as they have already been parsed
      # in main procedure (error has already been raised for badly written
      # argument like '-' or '--')

# parse specified module and get list of mods to unload and mods to load
      lassign [eval parseModuleVersionSpecifier 1 $fargs] modunlist modlolist

# define if modfile should always be fully read even for validity check
      pushAlwaysReadFullFile 1
      pushCommandName ml

# Find and execute any global rc file found
      runModulerc

set ret 0
      pushSettings

# first unload specified modules
      if {[llength $modunlist] > 0} {
         set ret [eval cmdModuleUnload unload match 1 0 0 0 $modunlist]
      }
      # then load other modules unless unload phase failed
      if {!$ret && [llength $modlolist] > 0} {
         set ret [eval cmdModuleLoad load 1 $modlolist]
      }

# rollback changes if any load or unload failed
      if {$ret} {
         restoreSettings
      }
      popSettings

popCommandName
      popAlwaysReadFullFile

renderSettings
   }

return {}
}

proc getModshareVarName {var} {
   # specific modshare variable for DYLD-related variables as a suffixed
   # variable will lead to warning messages with this tool
   if {[string range $var 0 4] eq {DYLD_}} {
      return MODULES_MODSHARE_${var}
   } else {
      return ${var}_modshare
   }
}

proc setenv {var val} {
   reportDebug "var='$var', val='$val'"

# clean any previously defined reference counter array
   unset-env [getModshareVarName $var] 1

# Set the variable for later use during the modulefile evaluation
   set-env $var $val

return {}
}

# undo setenv in unload mode
proc setenv-un {var val} {
   reportDebug "var='$var', val='$val'"

# clean any existing reference counter array
   unset-env [getModshareVarName $var] 1

# Add variable to the list of variable to unset in shell output code but
   # set it in interp context as done on load mode for later use during the
   # modulefile evaluation
   unset-env $var 0 $val

return {}
}

# optimized setenv/unsetenv for whatis mode: init env variable with an empty
# value if undefined. do not care about value, just avoid variable to be
# undefined for later use during the modulefile evaluation
proc setenv-wh {var args} {
   if {![info exists ::env($var)]} {
      reportDebug "var='$var', val=''"
      set ::env($var) {}
   }
   return {}
}

proc getenv {var {valifundef _UNDEFINED_}} {
   reportDebug "var='$var', valifundef='$valifundef'"

if {[currentMode] ne {display}} {
      return [get-env $var $valifundef]
   } else {
      return "\$$var"
   }
}

proc unsetenv {var {val {}}} {
   reportDebug "var='$var', val='$val'"

# clean any existing reference counter array
   unset-env [getModshareVarName $var] 1

# Set the variable for later use during the modulefile evaluation
   unset-env $var

return {}
}

# undo unsetenv in unload mode
proc unsetenv-un {var {val {}}} {
   if {$val ne {}} {
      return [setenv $var $val]
   } else {
      return [unsetenv $var]
   }
}

proc chdir {dir} {
   reportDebug $dir

if {[file exists $dir] && [file isdirectory $dir]} {
      set ::g_changeDir $dir
   } else {
      # report issue but does not treat it as an error to have the
      # same behavior as C-version
      reportWarning "Cannot chdir to '$dir' for '[currentModuleName]'"
   }

return {}
}

# superseed exit command to handle it if called within a modulefile
# rather than exiting the whole process
proc exitModfileCmd {{code 0}} {
   set mode [currentMode]

reportDebug ($code)

if {$mode eq {load}} {
      reportDebug {Inhibit next modulefile interpretations}
      set ::g_inhibit_interp 1
   }

# break to gently end interpretation of current modulefile
   return -code break
}

# enables slave interp to return ModulesVersion value to the master interp
proc setModulesVersion {val} {
   set ::ModulesVersion $val
}

# supersede puts command to catch content sent to stdout/stderr within
# modulefile in order to correctly send stderr content (if a pager has been
# enabled) or postpone content channel send after rendering on stdout the
# relative environment changes required by the modulefile
proc putsModfileCmd {itrp args} {
   reportDebug "$args (itrp=$itrp)"

# determine if puts call targets the stdout or stderr channel
   switch -- [llength $args] {
      1 {
         set deferPuts 1
      }
      2 {
         switch -- [lindex $args 0] {
            -nonewline - stdout {
               set deferPuts 1
            }
            stderr {
               set reportArgs [list [lindex $args 1]]
            }
         }
      }
      3 {
         if {[lindex $args 0] eq {-nonewline}} {
            switch -- [lindex $args 1] {
               stdout {
                  set deferPuts 1
               }
               stderr {
                  set reportArgs [list [lindex $args 2] 1]
               }
            }
         } else {
            set wrongNumArgs 1
         }
      }
      default {
         set wrongNumArgs 1
      }
   }

# raise error if bad argument number detected, do this here rather in _puts
   # not to confuse people with an error reported by an internal name (_puts)
   if {[info exists wrongNumArgs]} {
      knerror {wrong # args: should be "puts ?-nonewline? ?channelId? string"}
   # defer puts if it targets stdout (see renderSettings)
   } elseif {[info exists deferPuts]} {
      lappend ::g_stdoutPuts $args
   # if it targets stderr call report, which knows what channel to use
   } elseif {[info exists reportArgs]} {
      # report message only if not silent
      if {[isVerbosityLevel concise]} {
         eval report $reportArgs
      }
   # pass to real puts command if not related to stdout and do that in modfile
   # interpreter context to get access to eventual specific channel
   } else {
      # re-throw error as a known error for accurate stack trace print
      if {[catch {$itrp eval _puts $args} errMsg]} {
         knerror $errMsg MODULES_ERR_CUSTOM
      }
   }
}

########################################################################
# path fiddling
#
proc getReferenceCountArray {var separator} {
   # get reference counter set in environment
   set sharevar [getModshareVarName $var]
   array set refcount {}
   if {[info exists ::env($sharevar)]} {
      set modsharelist [psplit $::env($sharevar) [getPathSeparator]]
      # ignore environment ref count variable if malformed
      if {([llength $modsharelist] % 2) == 0} {
         array set refcount $modsharelist
      } else {
         reportDebug "Reference counter value in '$sharevar' is malformed\
            ($modsharelist)"
      }
   }

array set countarr {}
   if {[info exists ::env($var)]} {
      # do not skip a bare empty path entry that can also be found in
      # reference counter array (sometimes var is cleared by setting it
      # empty not unsetting it, ignore var in this case)
      if {$::env($var) eq {} && [info exists refcount()]} {
         lappend eltlist {}
      } else {
         set eltlist [split $::env($var) $separator]
      }

# just go thought the elements of the variable, which means additional
      # elements part of the reference counter variable will be ignored
      foreach elt $eltlist {
         # no reference counter, means value has been set once
         if {![info exists refcount($elt)]} {
            set count 1
         # bad reference counter value is ignored
         } elseif {![string is digit -strict $refcount($elt)]} {
            reportDebug "Reference counter value for '$elt' in '$sharevar' is\
               erroneous ($refcount($elt))"
            set count 1
         } else {
            set count $refcount($elt)
         }
         set countarr($elt) $count
      }
   }

set count_list [array get countarr]
   reportDebug "(var=$var, delim=$separator) got '$count_list'"

return $count_list
}

proc unload-path {args} {
   reportDebug ($args)

lassign [eval parsePathCommandArgs unload-path $args] separator\
      allow_dup idx_val var path_list

array set countarr [getReferenceCountArray $var $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) eq\
      {del}} {
      return {}
   }

# save initial variable content to match index arguments
   set dir_list [split [get-env $var] $separator]
   # detect if empty env value means empty path entry
   if {[llength $dir_list] == 0 && [info exists countarr()]} {
      lappend dir_list {}
   }

# build list of index to remove from variable
   set del_idx_list [list]
   foreach dir $path_list {
      # retrieve dir value if working on an index list
      if {$idx_val} {
         set idx $dir
         # go to next index if this one is not part of the existing range
         # needed to distinguish an empty value to an out-of-bound value
         if {$idx < 0 || $idx >= [llength $dir_list]} {
            continue
         } else {
            set dir [lindex $dir_list $idx]
         }
      }

# update reference counter array
      if {[info exists countarr($dir)]} {
         incr countarr($dir) -1
         set newcount $countarr($dir)
         if {$countarr($dir) <= 0} {
            unset countarr($dir)
         }
      } else {
         set newcount 0
      }

# get all entry indexes corresponding to dir
      set found_idx_list [lsearch -all -exact $dir_list $dir]

# remove all found entries
      if {$newcount <= 0} {
         # only remove passed position in --index mode
         if {$idx_val} {
            lappend del_idx_list $idx
         } else {
            set del_idx_list [concat $del_idx_list $found_idx_list]
         }
      # if multiple entries found remove the extra entries compared to new
      # reference counter
      } elseif {[llength $found_idx_list] > $newcount} {
         # only remove passed position in --index mode
         if {$idx_val} {
            lappend del_idx_list $idx
         } else {
            # delete extra entries, starting from end of the list (on a path
            # variable, entries at the end have less priority than those at
            # the start)
            set del_idx_list [concat $del_idx_list [lrange $found_idx_list\
               $newcount end]]
         }
      }
   }

# update variable if some element need to be removed
   if {[llength $del_idx_list] > 0} {
      set del_idx_list [lsort -integer -unique $del_idx_list]
      set newpath [list]
      set nbelem [llength $dir_list]
      # rebuild list of element without indexes set for deletion
      for {set i 0} {$i < $nbelem} {incr i} {
         if {[notInList $del_idx_list $i]} {
            lappend newpath [lindex $dir_list $i]
         }
      }
   } else {
      set newpath $dir_list
   }

# set env variable and corresponding reference counter in any case
   if {[llength $newpath] == 0} {
      unset-env $var
   } else {
      set-env $var [join $newpath $separator]
   }

set sharevar [getModshareVarName $var]
   if {[array size countarr] > 0} {
      set-env $sharevar [pjoin [array get countarr] [getPathSeparator]]
   } else {
      unset-env $sharevar 1
   }
   return {}
}

proc add-path {pos args} {
   reportDebug "($args) pos=$pos"

lassign [eval parsePathCommandArgs add-path $args] separator allow_dup\
      idx_val var path_list

set sharevar [getModshareVarName $var]
   array set countarr [getReferenceCountArray $var $separator]

if {$pos eq {prepend}} {
      set path_list [lreverse $path_list]
   }

set val [get-env $var]

foreach dir $path_list {
      if {![info exists countarr($dir)] || $allow_dup} {
         # ignore env var set empty if no empty entry found in reference
         # counter array (sometimes var is cleared by setting it empty not
         # unsetting it)
         if {$val ne {} || [info exists countarr()]} {
            set val [expr {$pos eq {prepend} ? "$dir$separator$val" :\
               "$val$separator$dir"}]
         } else {
            set val $dir
         }
      }
      if {[info exists countarr($dir)]} {
         incr countarr($dir)
      } else {
         set countarr($dir) 1
      }
   }

set-env $var $val
   set-env $sharevar [pjoin [array get countarr] [getPathSeparator]]

return {}
}

# analyze argument list passed to a path command to set default value or raise
# error in case some attributes are missing
proc parsePathCommandArgs {cmd args} {
   # parse argument list
   set next_is_delim 0
   set allow_dup 0
   set idx_val 0
   foreach arg $args {
      # everything passed after variable name is considered a value
      if {[info exists var]} {
         # set multiple passed values in a list
         lappend val_raw_list $arg
      } else {
         switch -glob -- $arg {
            --index {
               if {$cmd eq {add-path}} {
                  reportWarning "--index option has no effect on $cmd"
               } else {
                  set idx_val 1
               }
            }
            --duplicates {
               if {$cmd eq {unload-path}} {
                  reportWarning "--duplicates option has no effect on $cmd"
               } else {
                  set allow_dup 1
               }
            }
            -d - -delim - --delim {
               set next_is_delim 1
            }
            --delim=* {
               set delim [string range $arg 8 end]
            }
            -* {
               knerror "invalid option '$arg' for $cmd"
            }
            default {
               if {$next_is_delim} {
                  set delim $arg
                  set next_is_delim 0
               } else {
                  set var $arg
               }
            }
         }
      }
   }

# adapt with default value or raise error if some arguments are missing
   if {![info exists delim]} {
      set delim [getPathSeparator]
   } elseif {$delim eq {}} {
      knerror "$cmd should get a non-empty path delimiter"
   }
   if {![info exists var]} {
      knerror "$cmd should get an environment variable name"
   } elseif {$var eq {}} {
      knerror "$cmd should get a valid environment variable name"
   }
   if {![info exists val_raw_list]} {
      knerror "$cmd should get a value for environment variable $var"
   }

# set list of value to add
   set val_list [list]
   foreach val $val_raw_list {
      # check passed indexes are numbers
      if {$idx_val && ![string is integer -strict $val]} {
         knerror "$cmd should get valid number as index value"
      }

switch -- $val \
         {} {
            # add empty entry in list
            lappend val_list {}
         } \
         $delim {
            knerror "$cmd cannot handle path equals to separator string"
         } \
         default {
            # split passed value with delimiter
            set val_list [concat $val_list [split $val $delim]]
         }
   }

reportDebug "(delim=$delim, allow_dup=$allow_dup, idx_val=$idx_val,\
      var=$var, val=$val_list, nbval=[llength $val_list])"

return [list $delim $allow_dup $idx_val $var $val_list]
}

proc prepend-path {args} {
   reportDebug $args

# Set the variable for later use during the modulefile evaluation
   eval add-path prepend $args

return {}
}

proc append-path {args} {
   reportDebug $args

# Set the variable for later use during the modulefile evaluation
   eval add-path append $args

return {}
}

proc remove-path {args} {
   reportDebug $args

# Set the variable for later use during the modulefile evaluation
   eval unload-path $args

return {}
}

# undo remove-path in unload mode
proc remove-path-un {args} {
   # clear variable if it does not exist on unload mode for later use
   # during the modulefile evaluation
   lassign [eval parsePathCommandArgs unload-path $args] separator\
      allow_dup idx_val var path_list
   if {![info exists ::env($var)]} {
      reset-to-unset-env $var
   }
}

# optimized *-path for whatis mode: init env variable with an empty value if
# undefined. do not care about value, just avoid variable to be undefined for
# later use during the modulefile evaluation
proc edit-path-wh {args} {
   reportDebug $args

# get variable name
   lassign [eval parsePathCommandArgs edit-path-wh $args] separator\
      allow_dup idx_val var path_list

if {![info exists ::env($var)]} {
      set ::env($var) {}
   }

return {}
}

proc set-alias {alias what} {
   reportDebug "alias='$alias', val='$what'"

set ::g_Aliases($alias) $what
   set ::g_stateAliases($alias) new

return {}
}

# undo set-alias in unload mode
proc set-alias-un {alias what} {
   return [unset-alias $alias]
}

proc unset-alias {alias} {
   reportDebug alias='$alias'

set ::g_Aliases($alias) {}
   set ::g_stateAliases($alias) del

return {}
}

proc set-function {function what} {
   reportDebug "function='$function', val='$what'"

set ::g_Functions($function) $what
   set ::g_stateFunctions($function) new

return {}
}

# undo set-function in unload mode
proc set-function-un {function what} {
   return [unset-function $function]
}

proc unset-function {function} {
   reportDebug function='$function'

set ::g_Functions($function) {}
   set ::g_stateFunctions($function) del

return {}
}

proc is-loaded {args} {
   reportDebug $args
   # parse module version specification
   set args [eval parseModuleVersionSpecifier 0 $args]

foreach mod $args {
      if {[getLoadedMatchingName $mod returnfirst] ne {}} {
         return 1
      }
   }
   # is something loaded whatever it is?
   return [expr {[llength $args] == 0 && [llength [getLoadedModuleList]] > 0}]
}

proc is-loading {args} {
   reportDebug $args

foreach mod $args {
      if {[getLoadedMatchingName $mod returnfirst 1] ne {}} {
         return 1
      }
   }
   # is something else loading whatever it is?
   return [expr {[llength $args] == 0 && [llength [getLoadingModuleList]] >1}]
}

proc conflict {args} {
   reportDebug $args
   set currentModule [currentModuleName]
   # get module short name if loaded by its full pathname
   if {[set isfullpath [isModuleFullPath $currentModule]]} {
      set currentSModule [findModuleNameFromModulefile $currentModule]
   }
   defineModEqProc [isIcase] [getConf extended_default]

# parse module version specification
   set args [eval parseModuleVersionSpecifier 0 $args]

# register conflict list
   eval setLoadedConflict "{$currentModule}" $args

foreach mod $args {
      # if the conflict module is loading and it does not correspond to
      # currently evaluated module, we cannot proceed
      set isloading [expr {![doesModuleMatchesName $currentModule $mod] &&\
         (!$isfullpath || ![doesModuleMatchesName $currentSModule $mod]) &&\
         [is-loading $mod]}]
      # if the conflicting module is loaded, we cannot either
      if {[is-loaded $mod] || $isloading} {
         set retisconun [isModuleEvaluated conun $currentModule $mod]
         # report message on currently evaluated module message block
         if {![set retiseval [isModuleEvaluated any $currentModule $mod]] ||\
            [currentMsgRecordId] ne [topMsgRecordId] || !$retisconun} {
            # more appropriate msg if an eval was attempted or is by-passed
            set msg [expr {$retiseval || [getForce] ? [getConIsLoadedMsg\
               [list $mod] $isloading] : [getErrConflictMsg $currentModule\
               $mod]}]

# still proceed if force mode enabled
            if {[getForce]} {
               reportWarning $msg
               # indicate message has already been reported
               lappend ::report_conflict($currentModule) $mod
            } else {
               knerror $msg MODULES_ERR_GLOBAL
            }
         }
      }
   }

return {}
}

proc prereq {args} {
   reportDebug $args
   set currentModule [currentModuleName]

# parse module version specification
   set args [eval parseModuleVersionSpecifier 0 $args]

# register prereq list (sets of optional prereq are registered as list)
   setLoadedPrereq $currentModule $args

# if dependency resolving is enabled try to load prereq
   if {[getConf auto_handling] && ![eval is-loaded $args] && ![eval\
      is-loading $args]} {
      set imax [llength $args]
      set prereqloaded 0
      # if prereq list specified, try to load first then
      # try next if load of first module not successful
      for {set i 0} {$i<$imax && $prereqloaded==0} {incr i 1} {
         set arg [lindex $args $i]

# hold output of each evaluation until they are all done to drop
         # those that failed if one succeed
         set curholdid load-$i-$arg
         pushReportHoldId $curholdid
         if {[catch {cmdModuleLoad reqlo 0 $arg} errorMsg]} {
            # if an error is raised, release output and rethrow the error
            # (could be raised if no modulepath defined for instance)
            popReportHoldId
            lappend holdidlist $curholdid report
            eval releaseHeldReport $holdidlist
            knerror $errorMsg
         }
         popReportHoldId

if {[is-loaded $arg]} {
            set prereqloaded 1
            # set previous reports to be dropped as this one succeed
            if {[info exists holdidlist]} {
               foreach {holdid action} $holdidlist {
                  lappend newholdidlist $holdid drop
               }
               set holdidlist $newholdidlist
            }
         }
         lappend holdidlist $curholdid report
      }
      # output held messages
      eval releaseHeldReport $holdidlist
   }

if {![eval is-loaded $args] && ![eval is-loading $args]} {
      set retisreqlo [eval isModuleEvaluated reqlo "{$currentModule}" $args]
      # report message on currently evaluated module message block
      if {![set retiseval [eval isModuleEvaluated any "{$currentModule}"\
         $args]] || [currentMsgRecordId] ne [topMsgRecordId] ||\
         !$retisreqlo} {

# more appropriate msg if an evaluation was attempted or is by-passed
         set msg [expr {$retiseval || [getForce] ? [getReqNotLoadedMsg $args]\
            : [getErrPrereqMsg $currentModule $args]}]
         # still proceed if force mode enabled
         if {[getForce]} {
            reportWarning $msg
         # no error raise if done later
         } elseif {$retisreqlo} {
            reportError $msg
         } else {
            knerror $msg MODULES_ERR_GLOBAL
         }
      }

# raise reqlo-specific msg to top level if attempted
      if {$retisreqlo} {
         set msg [getErrReqLoMsg $args]
         if {[getForce]} {
            reportWarning $msg 1
         } else {
            knerror $msg MODULES_ERR_GLOBALTOP
         }
      }
   }

return {}
}

proc x-resource {resource {value {}}} {
   reportDebug "($resource, $value)"

# sometimes x-resource value may be provided within resource name
   # as the "x-resource {Ileaf.popup.saveUnder: True}" example provided
   # in manpage. so here is an attempt to extract real resource name and
   # value from resource argument
   if {[string length $value] == 0 && ![file exists $resource]} {
      # look first for a space character as delimiter, then for a colon
      set sepapos [string first { } $resource]
      if { $sepapos == -1 } {
         set sepapos [string first : $resource]
      }

if { $sepapos > -1 } {
         set value [string range $resource [expr {$sepapos + 1}] end]
         set resource [string range $resource 0 [expr {$sepapos - 1}]]
         reportDebug "corrected ($resource, $value)"
      } else {
         # if not a file and no value provided x-resource cannot be
         # recorded as it will produce an error when passed to xrdb
         reportWarning "x-resource $resource is not a valid string or file"
         return {}
      }
   }

# check current environment can handle X11 resource edition elsewhere exit
   if {[catch {runCommand xrdb -query} errMsg]} {
      knerror "X11 resources cannot be edited, issue spotted\n[sgr er\
         ERROR]: $errMsg" MODULES_ERR_GLOBAL
   }

# if a resource does hold an empty value in g_newXResources or
   # g_delXResources arrays, it means this is a resource file to parse
   if {[currentMode] eq {load}} {
      set ::g_newXResources($resource) $value
   } else {
      set ::g_delXResources($resource) $value
   }

return {}
}

proc uname {what} {
   set result {}

reportDebug $what

if {! [info exists ::unameCache($what)]} {
      switch -- $what {
         sysname {
            set result $::tcl_platform(os)
         }
         machine {
            set result $::tcl_platform(machine)
         }
         nodename - node {
            set result [runCommand uname -n]
         }
         release {
            set result $::tcl_platform(osVersion)
         }
         domain {
            set result [runCommand domainname]
         }
         version {
            set result [runCommand uname -v]
         }
         default {
            knerror "uname $what not supported"
         }
      }
      set ::unameCache($what) $result
   }

return $::unameCache($what)
}

# run shell command
proc system {args} {
   reportDebug $args

set mode [currentMode]
   set status {}

switch -- $mode {
      load - unload {
         # run through the appropriate shell
         if {[isWin]} {
            set shell cmd.exe
            set shellarg /c
         } else {
            set shell /bin/sh
            set shellarg -c
         }

if {[catch {exec >&@stderr $shell $shellarg [join $args]}]} {
             # non-zero exit status, get it:
             set status [lindex $::errorCode 2]
         } else {
             # exit status was 0
             set status 0
         }
      }
   }

return $status
}

# test at least one of the collections passed as argument exists
proc is-saved {args} {
   reportDebug $args

foreach coll $args {
      lassign [getCollectionFilename $coll] collfile colldesc
      if {[file exists $collfile]} {
         return 1
      }
   }
   # is something saved whatever it is?
   return [expr {[llength $args] == 0 && [llength [findCollections]] > 0}]
}

# test at least one of the directories passed as argument is set in MODULEPATH
proc is-used {args} {
   reportDebug $args

set modpathlist [getModulePathList]
   foreach path $args {
      # transform given path in an absolute path to compare with dirs
      # registered in the MODULEPATH env var which are returned absolute.
      set abspath [getAbsolutePath $path]
      if {[isInList $modpathlist $abspath]} {
         return 1
      }
   }
   # is something used whatever it is?
   return [expr {[llength $args] == 0 && [llength $modpathlist] > 0}]
}

# test at least one of the modulefiles passed as argument exists
proc is-avail {args} {
   reportDebug $args
   set ret 0

# disable error reporting to avoid modulefile errors
   # to pollute result. Only if not already inhibited
   set alreadyinhibit [isErrorReportInhibited]
   if {!$alreadyinhibit} {
      inhibitErrorReport
   }

foreach mod $args {
      lassign [getPathToModule $mod] modfile modname
      if {$modfile ne {}} {
         set ret 1
         break
      }
   }

# re-enable only is it was disabled from this procedure
   if {!$alreadyinhibit} {
      reenableErrorReport
   }
   return $ret
}

########################################################################
# internal module procedures
#
set g_modeStack {}

proc currentMode {} {
   return [lindex $::g_modeStack end]
}

proc pushMode {mode} {
   lappend ::g_modeStack $mode
}

proc popMode {} {
   set ::g_modeStack [lrange $::g_modeStack 0 end-1]
}

set g_moduleNameStack {}

proc currentModuleName {} {
   return [lindex $::g_moduleNameStack end]
}

proc pushModuleName {moduleName} {
   lappend ::g_moduleNameStack $moduleName
}

proc popModuleName {} {
   set ::g_moduleNameStack [lrange $::g_moduleNameStack 0 end-1]
}

# get number of either modulefile/modulerc currently being evaluated
proc getEvalModuleStackDepth {} {
   return [llength $::g_moduleNameStack]
}

set g_moduleFileStack {}

proc pushModuleFile {modfile} {
   lappend ::g_moduleFileStack $modfile
   set ::ModulesCurrentModulefile $modfile
}

proc popModuleFile {} {
   set ::g_moduleFileStack [lrange $::g_moduleFileStack 0 end-1]
   set ::ModulesCurrentModulefile [lindex $::g_moduleFileStack end]
}

set g_specifiedNameStack {}

proc currentSpecifiedName {} {
   return [lindex $::g_specifiedNameStack end]
}

proc pushSpecifiedName {specifiedName} {
   lappend ::g_specifiedNameStack $specifiedName
}

proc popSpecifiedName {} {
   set ::g_specifiedNameStack [lrange $::g_specifiedNameStack 0 end-1]
}

set g_commandNameStack {}

proc currentCommandName {} {
   return [lindex $::g_commandNameStack end]
}

proc aboveCommandName {} {
   return [lindex $::g_commandNameStack end-1]
}

proc pushCommandName {commandName} {
   lappend ::g_commandNameStack $commandName
}

proc popCommandName {} {
   set ::g_commandNameStack [lrange $::g_commandNameStack 0 end-1]
}

proc ongoingCommandName {commandName} {
   return [expr {[lsearch -exact $::g_commandNameStack $commandName] != -1}]
}

# stack of report holder unique identifiers
set g_reportHoldIdStack {}

proc isReportHeld {} {
   return [expr {[llength $::g_reportHoldIdStack] > 0}]
}

proc currentReportHoldId {} {
   return [lindex $::g_reportHoldIdStack end]
}

proc pushReportHoldId {holdid} {
   lappend ::g_reportHoldIdStack $holdid
}

proc popReportHoldId {} {
   set ::g_reportHoldIdStack [lrange $::g_reportHoldIdStack 0 end-1]
}

# stack of message recording/eval unique identifiers
set g_evalIdStack {}
set g_msgRecordIdStack {}

proc currentMsgRecordId {} {
   return [lindex $::g_msgRecordIdStack end]
}

proc currentEvalId {} {
   return [lindex $::g_evalIdStack end]
}

proc topMsgRecordId {} {
   return [lindex $::g_msgRecordIdStack 0]
}

proc topEvalId {} {
   return [lindex $::g_evalIdStack 0]
}

proc pushMsgRecordId {recid {setmsgid 1}} {
   lappend ::g_evalIdStack $recid
   if {$setmsgid} {
      lappend ::g_msgRecordIdStack $recid
   }
}

proc popMsgRecordId {{setmsgid 1}} {
   set ::g_evalIdStack [lrange $::g_evalIdStack 0 end-1]
   if {$setmsgid} {
      set ::g_msgRecordIdStack [lrange $::g_msgRecordIdStack 0 end-1]
   }
}

proc clearAllMsgRecordId {} {
   set ::g_evalIdStack {}
   set ::g_msgRecordIdStack {}
}

# stack of prefixes clarifying debug message entries
set g_debugMsgPrefixStack {}

proc currentDebugMsgPrefix {} {
   return [lindex $::g_debugMsgPrefixStack end]
}

proc pushDebugMsgPrefix {args} {
   lappend ::g_debugMsgPrefixStack "\[#[join $args :]\] "
}

proc popDebugMsgPrefix {} {
   set ::g_debugMsgPrefixStack [lrange $::g_debugMsgPrefixStack 0 end-1]
}

# gather for the current top evaluation the information on all evaluations
# happening under its umbrella
proc registerModuleEval {context mod {unset 0} {failedcontext {}}} {
   set evalid [topEvalId]
   set contextset 0

# add mod to existing evaluation context list
   if {[info exists ::g_moduleEval($evalid)]} {
      for {set i 0} {$i < [llength $::g_moduleEval($evalid)]} {incr i 1} {
         set contextevallist [lindex $::g_moduleEval($evalid) $i]
         if {[lindex $contextevallist 0] eq $context} {
            if {$unset} {
               set contextevallist [replaceFromList $contextevallist $mod]
            } else {
               lappend contextevallist $mod
            }
            set ::g_moduleEval($evalid) [expr {[llength $contextevallist] > 1\
               ? [lreplace $::g_moduleEval($evalid) $i $i $contextevallist]\
               : [lreplace $::g_moduleEval($evalid) $i $i]}]
            set contextset 1
            break
         }
      }
   }

# add mod to new evaluation context list
   if {!$unset && !$contextset} {
      lappend ::g_moduleEval($evalid) [list $context $mod]
   }

# add mod to failed evaluation list
   if {$unset} {
      lappend ::g_moduleFailedEval($evalid) $failedcontext $mod
   }
}

# get context of currently evaluated module
proc currentModuleEvalContext {} {
   return [lindex $::g_moduleEvalAttempt([currentModuleName]) end]
}

# record module evaluation attempt and corresponding context
proc registerModuleEvalAttempt {context mod} {
   appendNoDupToList ::g_moduleEvalAttempt($mod) $context
}

proc unregisterModuleEvalAttempt {context mod} {
   set ::g_moduleEvalAttempt($mod) [replaceFromList\
      $::g_moduleEvalAttempt($mod) $context]
}

# is at least one module passed as argument evaluated in passed context
proc isModuleEvaluated {context exclmod args} {
   set ret 0
   set icase [isIcase]
   # look at all evaluated mod except excluded one (currently evaluated mod)
   foreach evalmod [lsearch -all -inline -not [array names\
      ::g_moduleEvalAttempt] $exclmod] {
      set evalmatch 0
      # test arguments against all names of evaluated module
      foreach mod [concat [list $evalmod] [getAllModuleResolvedName\
         $evalmod]] {
         foreach name $args {
            if {[modEq $name $mod eqstart]} {
               set evalmatch 1
               if {$context eq {any} || [isInList\
                  $::g_moduleEvalAttempt($evalmod) $context]} {
                  set ret 1
               }
               break
            }
         }
         if {$evalmatch} {
            break
         }
      }
      if {$ret} {
         break
      }
   }
   return $ret
}

# was passed mod already evaluated for context and failed
proc isModuleEvalFailed {context mod} {
   set ret 0
   set evalid [topEvalId]
   if {[info exists ::g_moduleFailedEval($evalid)]} {
      foreach {curcon curmod} $::g_moduleFailedEval($evalid) {
         if {$context eq $curcon && $mod eq $curmod} {
            set ret 1
            break
         }
      }
   }
   return $ret
}

# stack of flag defining whether a modfile should be always fully read or not
# even for validity check, which is useful in case a file need to be read
# multiple times as a full read will make file content cached thus file will
# be read only once
set g_alwaysReadFullFileStack {}

proc currentAlwaysReadFullFile {} {
   return [lindex $::g_alwaysReadFullFileStack end]
}

proc pushAlwaysReadFullFile {alwaysReadFullFile} {
   lappend ::g_alwaysReadFullFileStack $alwaysReadFullFile
}

proc popAlwaysReadFullFile {} {
   set ::g_alwaysReadFullFileStack [lrange $::g_alwaysReadFullFileStack 0\
      end-1]
}

# return list of currently loading modules in stack
proc getLoadingModuleList {} {
   set modlist [list]
   for {set i 0} {$i < [llength $::g_moduleNameStack]} {incr i 1} {
      if {[lindex $::g_modeStack $i] eq {load}} {
         lappend modlist [lindex $::g_moduleNameStack $i]
      }
   }
   return $modlist
}

# return list of currently loading modulefiles in stack
proc getLoadingModuleFileList {} {
   set modlist [list]
   for {set i 0} {$i < [llength $::g_moduleFileStack]} {incr i 1} {
      if {[lindex $::g_modeStack $i] eq {load}} {
         lappend modlist [lindex $::g_moduleFileStack $i]
      }
   }
   return $modlist
}

# return list of currently unloading modules in stack
proc getUnloadingModuleList {} {
   set modlist [list]
   for {set i 0} {$i < [llength $::g_moduleNameStack]} {incr i 1} {
      if {[lindex $::g_modeStack $i] eq {unload}} {
         lappend modlist [lindex $::g_moduleNameStack $i]
      }
   }
   return $modlist
}
# return list of loaded modules by parsing LOADEDMODULES env variable
proc getLoadedModuleList {{filter_empty 1}} {
   set modlist [list]
   foreach mod [split [get-env LOADEDMODULES] [getPathSeparator]] {
      # ignore empty element
      if {$mod ne {} || !$filter_empty} {
         lappend modlist $mod
      }
   }
   return $modlist
}

# return list of loaded module files by parsing _LMFILES_ env variable
proc getLoadedModuleFileList {} {
   set modfilelist [list]
   foreach modfile [split [get-env _LMFILES_] [getPathSeparator]] {
      # ignore empty element
      if {$modfile ne {}} {
         lappend modfilelist $modfile
      }
   }
   return $modfilelist
}

# return list of loaded module declared conflict by parsing MODULES_LMCONFLICT
proc getLoadedModuleConflictList {} {
   set modconlist [list]
   foreach modconser [split [get-env MODULES_LMCONFLICT] [getPathSeparator]] {
      # recover range specifier ':' from its serialized form '<'
      set conlist [split [string map {< :} $modconser] $::g_sub1_separator]
      # ignore empty element (1 is meaningless as first elt is loaded mod)
      if {[llength $conlist] > 1} {
         lappend modconlist $conlist
      }
   }
   return $modconlist
}

# return list of loaded module declared prereq by parsing MODULES_LMPREREQ
proc getLoadedModulePrereqList {} {
   set modprelist [list]
   foreach modpreser [split [get-env MODULES_LMPREREQ] [getPathSeparator]] {
      # recover range specifier ':' from its serialized form '<'
      set prelist [split [string map {< :} $modpreser] $::g_sub1_separator]
      # ignore empty element (1 is meaningless as first elt is loaded mod)
      if {[llength $prelist] > 1} {
         set modpre {}
         # keep first arg as string and other args as lists
         foreach pre $prelist {
            if {[llength $modpre] == 0} {
               lappend modpre $pre
            } else {
               lappend modpre [split $pre $::g_sub2_separator]
            }
         }

lappend modprelist $modpre
      }
   }
   return $modprelist
}

# return list of loaded module asked by user by parsing MODULES_LMNOTUASKED
proc getLoadedModuleNotUserAskedList {} {
   set nuaskedlist [list]
   foreach mod [split [get-env MODULES_LMNOTUASKED] [getPathSeparator]] {
      # ignore empty element
      if {$mod ne {}} {
         lappend nuaskedlist $mod
      }
   }
   return $nuaskedlist
}

# return list of loaded module declared altnames by parsing MODULES_LMALTNAME
proc getLoadedModuleAltnameList {} {
   set modaltlist [list]
   foreach modaltser [split [get-env MODULES_LMALTNAME] [getPathSeparator]] {
      set altlist [split $modaltser $::g_sub1_separator]
      # ignore empty element (1 is meaningless as first elt is loaded mod)
      if {[llength $altlist] > 1} {
         lappend modaltlist $altlist
      }
   }
   return $modaltlist
}

# sort passed module list following both loaded and dependency orders
proc sortModulePerLoadedAndDepOrder {modlist {nporeq 0} {loading 0}} {
   # sort per loaded order
   set sortlist {}
   if {[llength $modlist] > 0} {
      foreach lmmod [getLoadedModuleList] {
         if {[isInList $modlist $lmmod]} {
            lappend sortlist $lmmod
         }
      }
      # also sort eventual loading modules if asked
      if {$loading} {
         foreach loadingmod [lreverse [getLoadingModuleList]] {
            if {[isInList $modlist $loadingmod]} {
               lappend sortlist $loadingmod
            }
         }
      }
   }

# then refine sort with dependencies between loaded modules: a dependent
   # module should be placed prior the loaded module requiring it
   set reqListVar [expr {$nporeq ? {::g_moduleNPODepend} :\
      {::g_moduleDepend}}]
   set i 0
   set imax [llength $sortlist]
   while {$i < $imax} {
      set mod [lindex $sortlist $i]
      set jmin $imax

if {[info exists ${reqListVar}($mod)]} {
         # goes over all dependend modules to find the first one in the loaded
         # order list located after requiring mod
         foreach lmmodlist [set ${reqListVar}($mod)] {
            foreach lmmod $lmmodlist {
               set j [lsearch -exact $sortlist $lmmod]
               if {$j > $i && $j < $jmin} {
                  set jmin $j
                  set jminmod $lmmod
               }
            }
         }
      }

# move first dependent module found after currently inspected mod right
      # before it
      if {$jmin != $imax} {
         set sortlist [linsert [lreplace $sortlist $jmin $jmin] $i $jminmod]
      # or go to next element in list if current element has not been changed
      } else {
         incr i
      }
   }

return $sortlist
}

# return list of module paths by parsing MODULEPATH env variable
# behavior param enables to exit in error when no MODULEPATH env variable
# is set. by default an empty list is returned if no MODULEPATH set
# resolv_var param tells if environement variable references in path elements
# should be resolved or passed as-is in result list
# set_abs param applies an absolute path name convertion to path elements
# if enabled
proc getModulePathList {{behavior returnempty} {resolv_var 1} {set_abs 1}} {
   if {[info exists ::env(MODULEPATH)]} {
      set modpathlist [list]
      foreach modpath [split $::env(MODULEPATH) [getPathSeparator]] {
         # ignore empty element
         if {$modpath ne {}} {
            if {$resolv_var} {
               set modpath [resolvStringWithEnv $modpath]
            }
            if {$set_abs} {
               set modpath [getAbsolutePath $modpath]
            }
            appendNoDupToList modpathlist $modpath
         }
      }
      return $modpathlist
   } elseif {$behavior eq {exiterronundef}} {
      reportErrorAndExit {No module path defined}
   } else {
      return {}
   }
}

# test if two modules share the same root name
proc isSameModuleRoot {mod1 mod2} {
   set mod1split [split $mod1 /]
   set mod2split [split $mod2 /]

return [expr {[lindex $mod1split 0] eq [lindex $mod2split 0]}]
}

# test if one module name from module specification is hidden
proc isModuleSpecHidden {modspec} {
   set ret 0
   foreach mod [getAllModulesFromVersSpec $modspec] {
      if {[isModuleHidden $mod]} {
         set ret 1
         break
      }
   }
   return $ret
}

# test if one element in module name has a leading "dot" making this module
# a hidden module
proc isModuleHidden {mod} {
   foreach elt [split $mod /] {
      if {[string index $elt 0] eq {.}} {
         return 1
      }
   }
   return 0
}

# check if module name is specified as a full pathname (not a name relative
# to a modulepath)
proc isModuleFullPath {mod} {
   return [regexp {^(|\.|\.\.)/} $mod]
}

# check if a module corresponds to a virtual module (module name
# does not corresponds to end of the modulefile name)
proc isModuleVirtual {mod modfile} {
   return [expr {[string first $mod $modfile end-[string length $mod]] == -1}]
}

# Return the full pathname and modulename to the module.
# Resolve aliases and default versions if the module name is something like
# "name/version" or just "name" (find default version).
proc getPathToModule {mod {indir {}} {report_issue 1} {look_loaded no}\
   {excdir {}}} {
   reportDebug "finding '$mod' in '$indir' (report_issue=$report_issue,\
      look_loaded=$look_loaded, excdir='$excdir')"

if {$mod eq {}} {
      set retlist [list {} 0 none {Invalid empty module name}]
   # try first to look at loaded modules if enabled to find maching module
   # or to find a closest match (used when switching with single name arg)
   } elseif {$look_loaded ne {no}} {
      switch -- $look_loaded {
         match {set getLoadedNameProc getLoadedMatchingName}
         close {set getLoadedNameProc getLoadedWithClosestName}
      }
      set retlist [if {[set lm [$getLoadedNameProc $mod]] ne {}} {list\
         [getModulefileFromLoadedModule $lm] $lm} {list {} $mod notloaded}]
   # Check for $mod specified as a full pathname
   } elseif {[isModuleFullPath $mod]} {
      set mod [getAbsolutePath $mod]
      # note that a raw filename as an argument returns the full
      # path as the module name
      lassign [checkValidModule $mod] check_valid check_msg
      switch -- $check_valid {
         true {
            set retlist [list $mod $mod]
         }
         invalid - accesserr {
            set retlist [list {} $mod $check_valid $check_msg $mod]
         }
      }
   } else {
      set dir_list [expr {$indir ne {} ? $indir : [getModulePathList\
         exiterronundef]}]
      # remove excluded directories (already searched)
      foreach dir $excdir {
         set dir_list [replaceFromList $dir_list $dir]
      }

# extract one module name from query
      set modqe [getOneModuleFromVersSpec $mod]

set icase [isIcase]
      defineGetEqArrayKeyProc $icase [getConf extended_default] [getConf\
         implicit_default]
      set modroot [lindex [split $modqe /] 0]
      # determine if we need to get hidden modules
      set fetch_hidden [isModuleSpecHidden $mod]

# Now search for $mod in module paths
      foreach dir $dir_list {
         # get list of modules related to the root of searched module to get
         # in one call a complete list of any module kind (file, alias, etc)
         # related to search to be able to then determine in this proc the
         # correct module to return without restarting new searches
         array unset mod_list
         array set mod_list [getModules $dir $modroot 0 rc_defs_included\
            $fetch_hidden]

set prevmod {}
         set mod_res {}
         # loop to resolve correct modulefile in case specified mod is a
         # directory that should be analyzed to get default mod in it
         while {$prevmod ne $mod} {
            set mod [getEqArrayKey mod_list $mod]
            set prevmod $mod
            if {[info exists mod_list($mod)]} {
               switch -- [lindex $mod_list($mod) 0] {
                  alias - version {
                     set newmod [resolveModuleVersionOrAlias $mod $icase]
                     # continue search on newmod if module from same root and
                     # not hidden (if hidden search disabled) as mod_list
                     # already contains everything related to this root module
                     if {[isSameModuleRoot $mod $newmod] && ($fetch_hidden ||\
                        ![isModuleHidden $newmod])} {
                        set mod $newmod
                        # indicate an alias or a symbol was solved
                        set mod_res $newmod
                     # elsewhere restart search on new modulename, constrained
                     # to specified dir if set
                     } else {
                        return [getPathToModule $newmod $indir $report_issue]
                     }
                  }
                  directory {
                     # is implicit default disabled and none explicitly set?
                     if {[lindex $mod_list($mod) 1] eq {}} {
                        set retlist [list {} $mod none "No default version\
                           defined for '$mod'"]
                     } else {
                        # Move to default element in directory
                        set mod $mod/[lindex $mod_list($mod) 1]
                        # restart search if default element is hidden and
                        # hidden elements were not searched
                        if {!$fetch_hidden && [isModuleHidden $mod]} {
                           return [getPathToModule $mod $indir $report_issue]
                        }
                     }
                  }
                  modulefile {
                     # If mod was a file in this path, return that file
                     set retlist [list $dir/$mod $mod]
                  }
                  virtual {
                     # return virtual name with file it targets
                     set retlist [list [lindex $mod_list($mod) 2] $mod]
                  }
                  invalid - accesserr {
                     # may found mod but issue, so end search with error
                     set retlist [concat [list {} $mod] $mod_list($mod)]
                  }
               }
            }
         }
         # break loop if found something (valid or invalid module)
         # elsewhere go to next path
         if {[info exists retlist]} {
            break
         # found nothing after solving a matching alias or symbol
         } elseif {$mod_res eq $mod} {
            lappend excdir $dir
            # look for this name in the other module paths, so restart
            # directory search from first dir in list to ensure precedence
            return [getPathToModule $mod $indir $report_issue no $excdir]
         }
      }
   }

# set result if nothing found
   if {![info exists retlist]} {
      set retlist [list {} $mod none "Unable to locate a modulefile for\
         '$mod'"]
   }
   if {[lindex $retlist 0] ne {}} {
      reportDebug "found '[lindex $retlist 0]' as '[lindex $retlist 1]'"
   # no error if we look at loaded modules and passed mod not found loaded
   } elseif {[lindex $retlist 2] ne {notloaded} && $report_issue} {
      eval reportIssue [lrange $retlist 2 4]
   }
   return $retlist
}

proc isModuleLoaded {mod} {
   cacheCurrentModules

return [info exists ::g_loadedModules($mod)]
}

proc getModulefileFromLoadedModule {mod} {
   if {[isModuleLoaded $mod]} {
      return $::g_loadedModules($mod)
   } else {
      return {}
   }
}

proc isModulefileLoaded {modfile} {
   cacheCurrentModules

return [info exists ::g_loadedModuleFiles($modfile)]
}

proc getModuleFromLoadedModulefile {modfile {idx all}} {
   if {[isModulefileLoaded $modfile]} {
      if {$idx eq {all}} {
         return $::g_loadedModuleFiles($modfile)
      } else {
         return [lindex $::g_loadedModuleFiles($modfile) $idx]
      }
   } else {
      return {}
   }
}

proc isModuleLoading {mod} {
   return [isInList [getLoadingModuleList] $mod]
}

proc isModulefileLoading {modfile} {
   return [isInList [getLoadingModuleFileList] $modfile]
}

proc getModuleFromLoadingModulefile {modfile {idx all}} {
   if {[isModulefileLoading $modfile]} {
      set loadingmodlist [getLoadingModuleList]
      foreach i [lsearch -all -exact [getLoadingModuleFileList] $modfile] {
         lappend modlist [lindex $loadingmodlist $i]
      }

if {$idx eq {all}} {
         return $modlist
      } else {
         return [lindex $modlist $idx]
      }
   } else {
      return {}
   }
}

proc setLoadedModule {mod modfile uasked} {
   set ::g_loadedModules($mod) $modfile
   # a loaded modfile may correspond to multiple loaded virtual modules
   lappend ::g_loadedModuleFiles($modfile) $mod
   # record if mod has been asked by user
   if {$uasked} {
      set ::g_loadedModuleUasked($mod) 1
   }
   # build dependency chain
   setModuleDependency $mod
}

proc unsetLoadedModule {mod modfile} {
   unset ::g_loadedModules($mod)
   # a loaded modfile may correspond to multiple loaded virtual modules
   if {[llength $::g_loadedModuleFiles($modfile)] == 1} {
      unset ::g_loadedModuleFiles($modfile)
   } else {
      set ::g_loadedModuleFiles($modfile) [replaceFromList\
         $::g_loadedModuleFiles($modfile) $mod]
   }
   if {[info exists ::g_loadedModuleUasked($mod)]} {
      unset ::g_loadedModuleUasked($mod)
   }
   # update dependencies
   unsetModuleDependency $mod
}

# Define procedure to get how many parts between passed name and mod are equal
# Adapt procedure code whether icase is enabled or disabled
proc defineModStartNbProc {icase} {
   set procname modStartNbProc
   if {$icase} {
      append procname Icase
   }
   # define proc if not done yet or if it was defined for another context
   if {[info procs modStartNb] eq {} || $::g_modStartNb_proc ne $procname} {
      if {[info exists ::g_modStartNb_proc]} {
         rename ::modStartNb ::$::g_modStartNb_proc
      }
      rename ::$procname ::modStartNb
      set ::g_modStartNb_proc $procname
   }
}

# alternative definitions of modStartNb proc
proc modStartNbProc {mod name} {
   # first compare against name's parent chunk by chunk
   set modname [getModuleNameFromVersSpec $name]
   if {$modname eq {.}} {
      set i -1
      set imax -1
   } else {
      set namesplit [split $modname /]
      set modsplit [split $mod /]
      # min expr function is not supported in Tcl8.4 and earlier
      set imax [if {[llength $namesplit] < [llength $modsplit]} {llength\
         $namesplit} {llength $modsplit}]
      for {set i 0} {$i < $imax} {incr i} {
         if {![string equal [lindex $modsplit $i] [lindex $namesplit $i]]} {
            incr i -1
            break
         }
      }
   }
   # if name's parent matches check if full name also matches
   if {$i == $imax && [modEq $name $mod eqstart]} {
      incr i
   }
   return $i
}
proc modStartNbProcIcase {mod name} {
   set modname [getModuleNameFromVersSpec $name]
   if {$modname eq {.}} {
      set i -1
      set imax -1
   } else {
      set namesplit [split $modname /]
      set modsplit [split $mod /]
      set imax [if {[llength $namesplit] < [llength $modsplit]} {llength\
         $namesplit} {llength $modsplit}]
      for {set i 0} {$i < $imax} {incr i} {
         if {![string equal -nocase [lindex $modsplit $i] [lindex $namesplit\
            $i]]} {
            incr i -1
            break
         }
      }
   }
   if {$i == $imax && [modEq $name $mod eqstart]} {
      incr i
   }
   return $i
}

# check if name matches passed mod name or one of its alternative name
proc doesModuleMatchesName {mod name} {
   cacheCurrentModules
   set ret 0

# check if main or alternative names of loaded mod matches passed name
   foreach matchmod [concat [list $mod] [getLoadedAltname $mod]] {
      if {[modEq $name $matchmod eqstart]} {
         set ret 1
         break
      }
   }
   return $ret
}

# check if name matches one name of passed loading mod (main or alternative)
proc doesLoadingModuleMatchesName {mod name} {
   set ret 0

# check if main or alternative names of loading mod matches passed name
   # directly look at all resolved names structure as alternative names for
   # loading modules are not yet registered elsewhere
   foreach matchmod [concat [list $mod] [getAllModuleResolvedName $mod]] {
      if {[modEq $name $matchmod eqstart]} {
         set ret 1
         break
      }
   }
   return $ret
}

# return the currently loaded module whose name is the closest to the
# name passed as argument. if no loaded module match at least one part
# of the passed name, an empty string is returned.
proc getLoadedWithClosestName {name} {
   set ret {}
   set retmax 0

if {[isModuleFullPath $name]} {
      set fullname [getAbsolutePath $name]
      # if module is passed as full modulefile path name, get corresponding
      # short name from used modulepaths
      if {[set shortname [findModuleNameFromModulefile $fullname]] ne {}} {
         set nametosplit $shortname
      # or look at lmfile names to return the eventual exact match
      } else {
         # module may be loaded with its full path name
         if {[isModuleLoaded $fullname]} {
            set ret $fullname
         # or name corresponds to the _lmfiles_ entry of a virtual modules in
         # which case lastly loaded virtual module is returned
         } elseif {[isModulefileLoaded $fullname]} {
            set ret [getModuleFromLoadedModulefile $fullname end]
         }
      }
   } else {
      set nametosplit $name
   }

if {[info exists nametosplit]} {
      cacheCurrentModules
      set icase [isIcase]
      defineModStartNbProc $icase
      defineModEqProc $icase [getConf extended_default]
      # compare name to each currently loaded module name
      foreach mod [getLoadedModuleList] {
         # if module loaded as fullpath but test name not, try to get loaded
         # mod short name (with currently used modulepaths) to compare it
         if {[isModuleFullPath $mod] && [set modname\
            [findModuleNameFromModulefile $mod]] ne {}} {
            # no alt name to retrieve if module has been loaded full path
            set matchmodlist [list $modname]
         } else {
            # add alternative names of mod to the matching list
            set matchmodlist [concat [list $mod] [getLoadedAltname $mod]]
         }

# compare each element of the name to find closest answer. in case of
         # equality, last loaded module will be returned as it overwrites
         # previously found value
         foreach matchmod $matchmodlist {
            if {[set i [modStartNb $matchmod $nametosplit]] >= $retmax} {
               set retmax $i
               set ret $mod
               break
            }
         }
      }
   }

reportDebug "'$ret' closest to '$name'"
   return $ret
}

# return the currently loaded module whose name is equal or include the name
# passed as argument. if no loaded module match, an empty string is returned.
# loading: look at currently loading modules instead of loaded if loading == 1
# lmlist: only take into account passed loaded module list not all loaded mods
proc getLoadedMatchingName {name {behavior {}} {loading 0} {lmlist {}}} {
   set ret {}
   set retmax 0
   # get default behavior from unload_match_order config
   if {$behavior eq {}} {
      set behavior [getConf unload_match_order]
   }

# use loading-specific procedures instead of loaded-specific ones
   if {$loading} {
      set isModulefileLoaded isModulefileLoading
      set getModuleFromLoadedModulefile getModuleFromLoadingModulefile
      set getLoadedModuleList getLoadingModuleList
      set doesModuleMatchesName doesLoadingModuleMatchesName
   } else {
      set isModulefileLoaded isModulefileLoaded
      set getModuleFromLoadedModulefile getModuleFromLoadedModulefile
      set getLoadedModuleList getLoadedModuleList
      set doesModuleMatchesName doesModuleMatchesName
   }

# fetch currently loaded/loading module name is no list provided
   if {[llength $lmlist] == 0} {
      set lmlist [$getLoadedModuleList]
   }

# if module is passed as full modulefile path name, look at lmfile names
   # to return the eventual exact match
   if {[isModuleFullPath $name]} {
      set mod [getAbsolutePath $name]
      # if module is loaded with its full path name loadedmodules entry is
      # equivalent to _lmfiles_ corresponding entry so only check _lmfiles_
      if {[$isModulefileLoaded $mod]} {
         # a loaded modfile may correspond to multiple loaded virtual modules
         switch -- $behavior {
            returnlast {
               # the last loaded/loading module will be returned
               set ret [$getModuleFromLoadedModulefile $mod end]
            }
            returnfirst {
               # the first loaded/loading module will be returned
               set ret [$getModuleFromLoadedModulefile $mod 0]
            }
            returnall {
               # all loaded/loading modules will be returned
               set ret [$getModuleFromLoadedModulefile $mod]
            }
         }
      }
   } elseif {$name ne {}} {
      defineModEqProc [isIcase] [getConf extended_default]
      # compare name to each currently loaded/loading module name, if multiple
      # mod match name:
      foreach mod $lmlist {
         # if module loaded as fullpath but test name not, try to get loaded
         # mod short name (with currently used modulepaths) to compare it
         if {[isModuleFullPath $mod] && [set modname\
            [findModuleNameFromModulefile $mod]] ne {}} {
            set matchmod $modname
         } else {
            set matchmod $mod
         }
         if {[$doesModuleMatchesName $matchmod $name]} {
            switch -- $behavior {
               returnlast {
                  # the last loaded module will be returned
                  set ret $mod
               }
               returnfirst {
                  # the first loaded module will be returned
                  set ret $mod
                  break
               }
               returnall {
                  # all loaded modules will be returned
                  lappend ret $mod
               }
            }
         }
      }
   }

reportDebug "'$ret' matches '$name'"
   return $ret
}

proc setLoadedConflict {mod args} {
   eval appendNoDupToList "{::g_loadedModuleConflict($mod)}" $args
}

proc unsetLoadedConflict {mod} {
   if {[info exists ::g_loadedModuleConflict($mod)]} {
      unset ::g_loadedModuleConflict($mod)
   }
}

proc getLoadedConflict {mod {serialized 0}} {
   set ret {}

if {[info exists ::g_loadedModuleConflict($mod)]} {
      if {$serialized} {
         # get conflict info as a string that can be registered in an env var
         # translate range specifier ':' into '<' to distinguish from path sep
         set ret [string map {: <} [join [concat [list $mod]\
            $::g_loadedModuleConflict($mod)] $::g_sub1_separator]]
      } else {
         set ret $::g_loadedModuleConflict($mod)
      }
   }

return $ret
}

proc doesModuleConflict {mod} {
   set does 0
   set modconlist {}
   set moddecconlist {}
   defineModEqProc [isIcase] [getConf extended_default]
   # get module short name if loaded by its full pathname
   if {[set isfullpath [isModuleFullPath $mod]]} {
      set smod [findModuleNameFromModulefile $mod]
   }

# check if any loaded module has declared a conflict
   foreach modcon [array names ::g_loadedModuleConflict] {
      # look if some loaded or loading modules correspond to conflict defined
      # by mod
      if {$modcon eq $mod || ($isfullpath && $modcon eq $smod)} {
         foreach withmod $::g_loadedModuleConflict($modcon) {
            # skip own reflexive conflict (look at mod main and alternative
            # names) and those already known
            if {![doesModuleMatchesName $mod $withmod] && (!$isfullpath ||\
               ![doesModuleMatchesName $smod $withmod]) && ([set lmmodlist\
               [getLoadedMatchingName $withmod returnall]] ne {} || [set\
               lmmodlist [getLoadedMatchingName $withmod returnall 1]] ne {})} {
               # multiple loaded module may match conflict declared name
               foreach lmmod $lmmodlist {
                  appendNoDupToList modconlist $lmmod
               }
               appendNoDupToList moddecconlist $withmod
               set does 1
            }
         }
      # other loaded module declared conflicts (skipping those already known)
      } elseif {[notInList $modconlist $modcon]} {
         foreach withmod $::g_loadedModuleConflict($modcon) {
            # check if mod or one of its alt name match conflict
            if {[doesModuleMatchesName $mod $withmod] || ($isfullpath &&\
               [doesModuleMatchesName $smod $withmod])} {
               lappend modconlist $modcon
               lappend moddecconlist $modcon
               set does 1
               break
            }
         }
      }
   }

reportDebug "'$mod' conflicts with '$modconlist' (declared as '$moddecconlist')"
   return [list $does $modconlist $moddecconlist]
}

proc setLoadedPrereq {mod args} {
   eval appendNoDupToList "{::g_loadedModulePrereq($mod)}" $args
}

proc unsetLoadedPrereq {mod} {
   if {[info exists ::g_loadedModulePrereq($mod)]} {
      unset ::g_loadedModulePrereq($mod)
   }
}

proc getLoadedPrereq {mod {serialized 0}} {
   set ret {}

if {[info exists ::g_loadedModulePrereq($mod)]} {
      if {$serialized} {
         # get prereq info as a string that can be registered in an env var
         foreach pre $::g_loadedModulePrereq($mod) {
            lappend modpre [join $pre $::g_sub2_separator]
         }
         # translate range specifier ':' into '<' to distinguish from path sep
         set ret [string map {: <} [join [concat [list $mod] $modpre]\
            $::g_sub1_separator]]
      } else {
         set ret $::g_loadedModulePrereq($mod)
      }
   }

return $ret
}

proc setLoadedAltname {mod args} {
   foreach arg $args {
      if {[string range $arg 0 2] eq {as|}} {
         appendNoDupToList ::g_loadedModuleAutoAltname($mod) [string range\
            $arg 3 end]
      } else {
         appendNoDupToList ::g_loadedModuleAltname($mod) $arg
      }
   }
}

proc unsetLoadedAltname {mod} {
   if {[info exists ::g_loadedModuleAltname($mod)]} {
      unset ::g_loadedModuleAltname($mod)
   }
   if {[info exists ::g_loadedModuleAutoAltname($mod)]} {
      unset ::g_loadedModuleAutoAltname($mod)
   }
}

proc getLoadedAltname {mod {serialized 0}} {
   set ret {}

if {[info exists ::g_loadedModuleAltname($mod)]} {
      set ret $::g_loadedModuleAltname($mod)
   }
   if {[info exists ::g_loadedModuleAutoAltname($mod)]} {
      if {$serialized} {
         # add a 'as|' prefix to each auto sym to distinguish them when
         # serialized
         foreach altname $::g_loadedModuleAutoAltname($mod) {
            lappend ret as|$altname
         }
      } else {
         set ret [concat $ret $::g_loadedModuleAutoAltname($mod)]
      }
   }

if {$ret ne {} && $serialized} {
      # get altname info as a string that can be registered in an env var
      set ret [join [concat [list $mod] $ret] $::g_sub1_separator]
   }

return $ret
}

proc isModuleUserAsked {mod} {
   cacheCurrentModules

return [info exists ::g_loadedModuleUasked($mod)]
}

# register conflict violation state between loaded modules
proc setModuleConflictViolation {mod modconlist} {
   reportDebug "set conflict violation state for '$mod'"
   set ::g_conflictViolation($mod) $modconlist
   # also update violation state for loaded mod conflicting with mod
   foreach lmmod $modconlist {
      if {[appendNoDupToList ::g_conflictViolation($lmmod) $mod]} {
         reportDebug "set/update conflict violation state for '$lmmod'"
      }
   }
}

# unregister conflict violation state between modules
proc unsetModuleConflictViolation {mod} {
   if {[info exists ::g_conflictViolation($mod)]} {
      # also update violation state for loaded mod conflicting with mod
      foreach lmmod $::g_conflictViolation($mod) {
         set convio [replaceFromList\
            $::g_conflictViolation($lmmod) $mod]
         reportDebug "unset/update conflict violation state for '$lmmod'"
         if {[llength $convio] == 0} {
            unset ::g_conflictViolation($lmmod)
         } else {
            set ::g_conflictViolation($lmmod) $convio
         }
      }
      reportDebug "unset conflict violation state for '$mod'"
      unset ::g_conflictViolation($mod)
   }
}

# build dependency chain between loaded modules based on registered prereqs
proc setModuleDependency {mod} {
   set modlist [getLoadedModuleList]
   defineModEqProc [isIcase] [getConf extended_default]
   # only look at modules loaded prior current one to find requirements,
   # modules loaded afterward are unmet dependencies as dependents have
   # not been reloaded after them
   set modidx [lsearch -exact $modlist $mod]
   set modnpolist [lrange $modlist [expr {$modidx + 1}] end]
   set modlist [lrange $modlist 0 $modidx]
   # reverse list to get closest match if returning lastly loaded module
   if {[getConf unload_match_order] eq {returnlast}} {
      set modlist [lreverse $modlist]
   }
   set deplist {}
   set depnpolist {}

foreach prereq [getLoadedPrereq $mod] {
      # get corresponding loaded module for each element of the prereq order
      set lmprelist {}
      set lmnpolist {}
      foreach modpre $prereq {
         set lmfound {}
         foreach lmmod $modlist {
            if {[doesModuleMatchesName $lmmod $modpre]} {
               set lmfound $lmmod
               break
            }
         }

# register an unmet dependency/requirement if no loaded mod matches
         if {$lmfound eq {}} {
            reportDebug "set an unmet requirement on '$modpre' for '$mod'"
            lappend ::g_moduleUnmetDep($mod) $modpre
            lappend ::g_unmetDepHash($modpre) $mod
         # add matching mod elsewhere
         } else {
            appendNoDupToList lmprelist $lmfound
            appendNoDupToList lmnpolist $lmfound
         }

# look if requirement can be found in the No Particular Order list
         foreach lmmod $modnpolist {
            if {[doesModuleMatchesName $lmmod $modpre]} {
               appendNoDupToList lmnpolist $lmmod
               break
            }
         }
      }

switch -- [llength $lmprelist] {
         0 {
            # prereq not satisfied
            reportDebug "set prereq violation state for '$mod'"
            lappend ::g_prereqViolation($mod) $prereq
         }
         1 {
            set lmmod [lindex $lmprelist 0]
            lappend deplist [list $lmmod]
            # set 'is depended by' relations
            lappend ::g_dependHash($lmmod) [list $mod]
         }
         default {
            lappend deplist $lmprelist
            # many modules in prereq list, means they all set an optional dep
            foreach lmmod $lmprelist {
               lappend ::g_dependHash($lmmod) [list $mod 1]
            }
         }
      }

# build 'is depended by' relations not taking loading order into account
      switch -- [llength $lmnpolist] {
         0 {
            # even on No Particular Order mode, prereq is not satisfied
            reportDebug "set NPO prereq violation state for '$mod'"
            lappend ::g_prereqNPOViolation($mod) $prereq
         }
         1 {
            set lmmod [lindex $lmnpolist 0]
            lappend depnpolist [list $lmmod]
            # set 'is depended by' relations
            lappend ::g_dependNPOHash($lmmod) [list $mod]
         }
         default {
            lappend depnpolist $lmnpolist
            # many modules in prereq list, means they all set an optional dep
            foreach lmmod $lmnpolist {
               lappend ::g_dependNPOHash($lmmod) [list $mod 1]
            }
         }
      }
   }

# conflict not satisfied
   lassign [doesModuleConflict $mod] doescon modconlist
   if {$doescon} {
      setModuleConflictViolation $mod $modconlist
   }

# update eventual registered unmet dependencies
   foreach modpre [array names ::g_unmetDepHash] {
      if {[doesModuleMatchesName $mod $modpre]} {
         reportDebug "refresh requirements targetting '$modpre'"
         foreach lmmod $::g_unmetDepHash($modpre) {
            if {[isInList [getDependentLoadedModuleList [list $lmmod] 0 0]\
               $mod]} {
               reportDebug "skip deps refresh for '$lmmod' as dep cycle\
                  detected with '$mod'"

# remove dependency link in no particular order structs to
               # avoid cycle first in 'is depended by' struct
               if {[info exists ::g_dependNPOHash($mod)]} {
                  set depmodlist $::g_dependNPOHash($mod)
                  for {set i 0} {$i < [llength $depmodlist]} {incr i 1} {
                     if {[lindex [lindex $depmodlist $i] 0] eq $lmmod} {
                        set depmodlist [lreplace $depmodlist $i $i]
                        break
                     }
                  }
                  set ::g_dependNPOHash($mod) $depmodlist
                  reportDebug "update NPO dependent of '$mod' to\
                     '$depmodlist'"
               }
               # then update 'depend on' struct
               set lmmoddepnpolist {}
               foreach depmodlist $::g_moduleNPODepend($lmmod) {
                  if {[set depidx [lsearch -exact $depmodlist $mod]] != -1} {
                     set depmodlist [lreplace $depmodlist $depidx $depidx]
                     # implies to update consistenly alternate requirement or
                     # violation state if no alternative loaded
                     switch -- [llength $depmodlist] {
                        0 {
                           # do not know exact prereq name, so use correspond.
                           # loaded module matching it
                           lappend ::g_prereqNPOViolation($lmmod) $mod
                           reportDebug "set NPO prereq violation state for\
                              '$lmmod'"
                        }
                        1 {
                           # update alternate loaded mod which became a strong
                           # requirement
                           set altmod [lindex $depmodlist 0]
                           set ::g_dependNPOHash($altmod) [replaceFromList\
                              $::g_dependNPOHash($altmod) [list $lmmod 1]\
                              $lmmod]
                           reportDebug "update NPO dependent of '$altmod' to\
                              '$::g_dependNPOHash($altmod)'"
                        }
                     }
                  }
                  lappend lmmoddepnpolist $depmodlist
               }
               reportDebug "update NPO requirement of '$lmmod' to\
                  '$lmmoddepnpolist'"
               set ::g_moduleNPODepend($lmmod) $lmmoddepnpolist
            } else {
               # refresh actual dependencies of targetting mod
               unsetModuleDependency $lmmod
               setModuleDependency $lmmod
            }
         }
      }
   }

# set 'depends on' relation
   reportDebug "set requirements of '$mod' to '$deplist'"
   set ::g_moduleDepend($mod) $deplist
   reportDebug "set NPO requirements of '$mod' to '$depnpolist'"
   set ::g_moduleNPODepend($mod) $depnpolist
}

# update dependency chain when unloading module
proc unsetModuleDependency {mod} {
   foreach lmmodlist $::g_moduleDepend($mod) {
      set manymod [expr {[llength $lmmodlist] > 1 ? 1 : 0}]

# unset 'is depended by' mod relations
      foreach lmmod $lmmodlist {
         if {[info exists ::g_dependHash($lmmod)]} {
            if {$manymod} {
               set hashdep [list $mod 1]
            } else {
               set hashdep [list $mod]
            }
            set ::g_dependHash($lmmod) [replaceFromList\
               $::g_dependHash($lmmod) $hashdep]
            if {[llength $::g_dependHash($lmmod)] == 0} {
               unset ::g_dependHash($lmmod)
            }
         }
      }
   }
   # unset mod's 'depends on' relation
   reportDebug "unset requirements of '$mod'"
   unset ::g_moduleDepend($mod)

foreach lmmodlist $::g_moduleNPODepend($mod) {
      set manymod [expr {[llength $lmmodlist] > 1 ? 1 : 0}]

# unset 'is depended by' mod relations
      foreach lmmod $lmmodlist {
         if {[info exists ::g_dependNPOHash($lmmod)]} {
            if {$manymod} {
               set hashdep [list $mod 1]
            } else {
               set hashdep [list $mod]
            }
            set ::g_dependNPOHash($lmmod) [replaceFromList\
               $::g_dependNPOHash($lmmod) $hashdep]
            if {[llength $::g_dependNPOHash($lmmod)] == 0} {
               unset ::g_dependNPOHash($lmmod)
            }
         }
      }
   }
   # unset mod's No Particular Order 'depends on' relation
   reportDebug "unset NPO requirements of '$mod'"
   unset ::g_moduleNPODepend($mod)

# unset eventual violation states
   if {[info exists ::g_prereqViolation($mod)]} {
      reportDebug "unset prereq violation state for '$mod'"
      unset ::g_prereqViolation($mod)
   }
   if {[info exists ::g_prereqNPOViolation($mod)]} {
      reportDebug "unset NPO prereq violation state for '$mod'"
      unset ::g_prereqNPOViolation($mod)
   }
   unsetModuleConflictViolation $mod

# unset eventual registered unmet dependencies
   if {[info exists ::g_moduleUnmetDep($mod)]} {
      foreach ummod $::g_moduleUnmetDep($mod) {
         if {[info exists ::g_unmetDepHash($ummod)]} {
            set ::g_unmetDepHash($ummod) [replaceFromList\
               $::g_unmetDepHash($ummod) $mod]
            if {[llength $::g_unmetDepHash($ummod)] == 0} {
               unset ::g_unmetDepHash($ummod)
            }
         }
      }
      reportDebug "unset unmet requirements for '$mod'"
      unset ::g_moduleUnmetDep($mod)
   }

# unset mod's 'is depended by' relations
   set hashdeplist [getDirectDependentList $mod]
   if {[llength $hashdeplist] > 0} {
      reportDebug "refresh dependent of '$mod'"
      foreach lmmod $hashdeplist {
         # refresh actual dependencies of targetting mod
         unsetModuleDependency $lmmod
         setModuleDependency $lmmod
      }
   }
}

# returns if any loaded module (if passed mod is empty) or passed mod and all
# its requirement chain satisfy their loading constraints (prereq & conflict)
proc areModuleConstraintsSatisfied {{mod {}} {nporeq 0}} {
   set ret 1
   cacheCurrentModules

# are requirements loaded after their dependent included or not
   if {$nporeq} {
      set reqVioVar ::g_prereqNPOViolation
      set reqListVar ::g_moduleNPODepend
   } else {
      set reqVioVar ::g_prereqViolation
      set reqListVar ::g_moduleDepend
   }

# check if any loaded module violates its prereq or conflict constraints
   if {$mod eq {}} {
      if {[array size ::g_conflictViolation] > 0 || [array size\
         $reqVioVar] > 0} {
         set ret 0
      }
   } else {
      set fulllist [list $mod]
      for {set i 0} {$i < [llength $fulllist]} {incr i 1} {
         set depmod [lindex $fulllist $i]

# check if depmod violates its prereq or conflict constraints
         if {[info exists ::g_conflictViolation($depmod)] || [info exists\
            ${reqVioVar}($depmod)]} {
            # found violation among the requirement chain of mod so the
            # constraint of mod are not satisfied
            set ret 0
            break
         }
         # add requirements of depmod to the module to check list
         foreach lmmodlist [set ${reqListVar}($depmod)] {
            eval appendNoDupToList fulllist $lmmodlist
         }
      }
   }

return $ret
}

# return list of loaded modules having an unmet requirement on passed mod
# and their recursive dependent
proc getUnmetDependentLoadedModuleList {mod} {
   reportDebug "get dependent of upcoming loaded '$mod'"
   set unmetdeplist {}
   set depmodlist {}
   defineModEqProc [isIcase] [getConf extended_default]

# skip dependent analysis if mod has a conflict with a loaded module
   lassign [doesModuleConflict $mod] doescon modconlist
   if {!$doescon} {
      foreach ummod [array names ::g_unmetDepHash] {
         if {[doesModuleMatchesName $mod $ummod]} {
            foreach depmod $::g_unmetDepHash($ummod) {
               lappend depmodlist $depmod
               # temporarily remove prereq violation of depmod if mod
               # load solves it (no other prereq is missing)
               if {[info exists ::g_prereqViolation($depmod)]} {
                  foreach prereq $::g_prereqViolation($depmod) {
                     foreach modpre $prereq {
                        # also temporarily remove prereq violation for
                        # requirements loaded after dependent module
                        if {[doesModuleMatchesName $mod $modpre] ||\
                           [is-loaded $modpre]} {
                           # backup original violation to restore it later
                           if {![info exists preunvioarr($depmod)]} {
                              set preunvioarr($depmod)\
                                 $::g_prereqViolation($depmod)
                           }
                           # temporarily remove matching violation
                           set ::g_prereqViolation($depmod) [replaceFromList\
                              $::g_prereqViolation($depmod) $prereq]
                           if {[llength $::g_prereqViolation($depmod)] == 0} {
                              unset ::g_prereqViolation($depmod)
                           }
                           break
                        }
                     }
                  }
               }
            }
         }
      }
   }

# select dependent if all its constraint are now satisfied (after removing
   # eventual prereq violation toward mod)
   foreach depmod $depmodlist {
      if {[areModuleConstraintsSatisfied $depmod]} {
         appendNoDupToList unmetdeplist $depmod
      }
   }

# get dependent of dependent
   set deplist [getDependentLoadedModuleList $unmetdeplist 0 0 0 0 1]

# restore temporarily lift prereq violation
   if {[array exists preunvioarr]} {
      foreach depmod [array names preunvioarr] {
         set ::g_prereqViolation($depmod) $preunvioarr($depmod)
      }
   }

set sortlist [sortModulePerLoadedAndDepOrder [concat $unmetdeplist\
      $deplist]]
   reportDebug "got '$sortlist'"
   return $sortlist
}

# return list of loaded modules declaring a prereq on passed mod with
# distinction made with strong prereqs (no alternative loaded) or weak and
# also with prereq loaded after their dependent module
proc getDirectDependentList {mod {strong 0} {nporeq 0} {loading 0}\
   {othmodlist {}}} {
   set deplist {}

# include or not requirements loaded after their dependent
   if {$nporeq} {
      set depListVar ::g_dependNPOHash
      set reqListVar ::g_moduleNPODepend
   } else {
      set depListVar ::g_dependHash
      set reqListVar ::g_moduleDepend
   }

if {[info exists ${depListVar}($mod)]} {
      foreach depmod [set ${depListVar}($mod)] {
         set add 1
         # skip optional dependency if only looking for strong ones
         # look at an additionally processed mod list to determine if all
         # mods from a dependent list (composed of optional parts) are part
         # of the search, which means mod is not optional but strong dependent
         if {$strong && [llength $depmod] > 1} {
            foreach lmmodlist [set ${reqListVar}([lindex $depmod 0])] {
               if {[isInList $lmmodlist $mod]} {
                  foreach lmmod $lmmodlist {
                     # other mod part of the opt list is not there so mod
                     # is considered optional
                     if {[notInList $othmodlist $lmmod]} {
                        set add 0
                        break
                     }
                  }
                  break
               }
            }
         }

if {$add} {
            lappend deplist [lindex $depmod 0]
         }
      }
   }

# take currently loading modules into account if asked
   if {$loading} {
      set modlist [getLoadedModuleList]
      defineModEqProc [isIcase] [getConf extended_default]
      # reverse list to get closest match if returning lastly loaded module
      if {[getConf unload_match_order] eq {returnlast}} {
         set modlist [lreverse $modlist]
      }
      foreach loadingmod [getLoadingModuleList] {
         foreach prereq [getLoadedPrereq $loadingmod] {
            set lmprelist {}
            set moddep 0
            foreach modpre $prereq {
               foreach lmmod $modlist {
                  if {[doesModuleMatchesName $lmmod $modpre]} {
                     lappend lmprelist $lmmod
                     if {$lmmod eq $mod} {
                        set moddep 1
                     }
                     break
                  }
               }
            }
            if {$moddep && (!$strong || [llength $lmprelist] == 1)} {
               lappend deplist $loadingmod
               break
            }
         }
      }
   }

return $deplist
}

# gets the list of all loaded modules which are dependent of passed modlist
# ordered by load position. strong argument controls whether only the active
# dependent modules should be returned or also those that are optional. direct
# argument controls if only dependent module directly requiring passed mods
# should be returned or its full dependent tree. nporeq argument tells if
# requirement loaded after their dependent should be returned. sat_constraint
# argument controls whether only the loaded module satisfying their constraint
# should be part or not of the resulting list. being_unload argument controls
# whether loaded modules in conflict with one or multiple modules from modlist
# should be added to the dependent list as these modules are currently being
# unloaded and these conflicting loaded modules should be refreshed.
proc getDependentLoadedModuleList {modlist {strong 1} {direct 1} {nporeq 0}\
   {loading 1} {sat_constraint 0} {being_unload 0}} {
   reportDebug "get loaded mod dependent of '$modlist' (strong=$strong,\
      direct=$direct, nporeq=$nporeq, loading=$loading,\
      sat_constraint=$sat_constraint, being_unload=$being_unload)"

set deplist {}
   set fulllist $modlist
   # look at consistent requirements for unloading modules
   set unlonporeq [expr {$being_unload ? 0 : $nporeq}]
   foreach mod $modlist {
      # no duplicates or modules from query list
      eval appendNoDupToList fulllist [getDirectDependentList $mod $strong\
         $unlonporeq $loading $fulllist]
   }

if {$being_unload} {
      # invite modules in violation with mods to be part of the dependent list
      # with their own dependent modules as mod is being unloaded. Achieve so
      # by faking that conflict violation is gone
      foreach mod $modlist {
         lassign [doesModuleConflict $mod] doescon modconlist
         if {$doescon} {
            unsetModuleConflictViolation $mod
            set conunvioarr($mod) $modconlist
            eval appendNoDupToList fulllist $modconlist
         }
      }
   }
   set unloadingmodlist [getUnloadingModuleList]
   for {set i [llength $modlist]} {$i < [llength $fulllist]} {incr i 1} {
      set depmod [lindex $fulllist $i]

# skip already added mod or mod violating constraints if asked
      if {!$sat_constraint || [areModuleConstraintsSatisfied $depmod\
         $nporeq]} {
         # get dependent mod of dep mod when looking at full dep tree
         if {!$direct} {
            eval appendNoDupToList fulllist [getDirectDependentList $depmod\
               $strong $nporeq 0 $fulllist]
         }
         # avoid module currently unloading from result list
         if {[notInList $unloadingmodlist $depmod]} {
            lappend deplist $depmod
         }
      }
   }

# restore conflict violation if any
   if {[array exists conunvioarr]} {
      foreach conunvio [array names conunvioarr] {
         setModuleConflictViolation $conunvio $conunvioarr($conunvio)
      }
   }

# sort complete result list to match both loaded and dependency orders
   set sortlist [sortModulePerLoadedAndDepOrder $deplist $nporeq $loading]
   reportDebug "got '$sortlist'"
   return $sortlist
}

# test if passed 'mod' could be automatically unloaded or not, which means it
# has been loaded automatically and no loaded modules require it anymore.
# unmodlist: pass a list of modules that are going to be unloaded
proc isModuleUnloadable {mod {unmodlist {}}} {
   set ret 1
   # get currently unloading modules if no specific unmodlist set
   if {[llength $unmodlist] == 0} {
      set unmodlist [getUnloadingModuleList]
   }

if {[isModuleUserAsked $mod]} {
      set ret 0
   } else {
      # mod is unloadable if all its dependent are unloaded or unloading
      foreach depmod [getDirectDependentList $mod] {
         if {[notInList $unmodlist $depmod]} {
            set ret 0
            break
         }
      }
   }

return $ret
}

# gets the list of all loaded modules which are required by passed modlist
# ordered by load position.
proc getRequiredLoadedModuleList {modlist} {
   reportDebug "get mods required by '$modlist'"

# search over all list of loaded modules, starting with passed module
   # list, then adding in turns their requirements
   set fulllist $modlist
   for {set i 0} {$i < [llength $fulllist]} {incr i 1} {
      # gets the list of loaded modules which are required by depmod
      eval appendNoDupToList fulllist $::g_moduleDepend([lindex $fulllist $i])
   }

# sort complete result list to match both loaded and dependency orders
   set sortlist [sortModulePerLoadedAndDepOrder [lrange $fulllist [llength\
      $modlist] end]]
   reportDebug "got '$sortlist'"
   return $sortlist
}

# finds required modules that can be unloaded if passed modules are unloaded:
# they have been loaded automatically and are not depended (mandatory or
# optionally) by other module
proc getUnloadableLoadedModuleList {modlist} {
   reportDebug "get unloadable mods once '$modlist' unloaded"

# search over all list of unloaded modules, starting with passed module
   # list, then adding in turns unloadable requirements
   set fulllist $modlist
   for {set i 0} {$i < [llength $fulllist]} {incr i 1} {
      set depmod [lindex $fulllist $i]
      # gets the list of loaded modules which are required by depmod
      set deplist {}
      foreach lmmodlist $::g_moduleDepend($depmod) {
         foreach lmmod $lmmodlist {
            if {[notInList $fulllist $lmmod]} {
               lappend deplist $lmmod
            }
         }
      }

# get those required module that have been automatically loaded and are
      # only required by modules currently being unloaded
      foreach lmmod $deplist {
         if {[isModuleUnloadable $lmmod $fulllist]} {
            lappend fulllist $lmmod
         }
      }
   }

# runs the global RC files if they exist
proc runModulerc {} {
   set rclist {}

reportDebug running...

if {[set rcfile [getConf rcfile]] ne {}} {
      # if MODULERCFILE is a dir, look at a modulerc file in it
      if {[file isdirectory $rcfile]\
         && [file isfile $rcfile/modulerc]} {
         lappend rclist $rcfile/modulerc
      } elseif {[file isfile $rcfile]} {
         lappend rclist $rcfile
      }
   }
   if {[file isfile /etc/environment-modules/rc]} {
      lappend rclist /etc/environment-modules/rc
   }
   if {[info exists ::env(HOME)] && [file isfile $::env(HOME)/.modulerc]} {
      lappend rclist $::env(HOME)/.modulerc
   }

foreach rc $rclist {
      if {[file readable $rc]} {
         reportDebug "Executing $rc"
         cmdModuleSource $rc
         lappend ::g_rc_loaded $rc
      }
   }

# identify alias or symbolic version set in these global RC files to be
   # able to include them or not in output or resolution processes
   array set ::g_rcAlias [array get ::g_moduleAlias]
   array set ::g_rcVersion [array get ::g_moduleVersion]
   array set ::g_rcVirtual [array get ::g_moduleVirtual]
}

# how many settings bundle are currently saved
proc getSavedSettingsStackDepth {} {
   return [llength $::g_SAVE_g_loadedModules]
}

# manage settings to save as a stack to have a separate set of settings
# for each module loaded or unloaded in order to be able to restore the
# correct set in case of failure
proc pushSettings {} {
   foreach var {env g_clearedEnvVars g_Aliases g_stateEnvVars g_stateAliases\
      g_stateFunctions g_Functions g_newXResources g_delXResources\
      g_loadedModules g_loadedModuleFiles g_loadedModuleUasked\
      g_loadedModuleConflict g_loadedModulePrereq g_loadedModuleAltname\
      g_loadedModuleAutoAltname g_moduleDepend g_dependHash g_moduleNPODepend\
      g_dependNPOHash g_prereqViolation g_prereqNPOViolation\
      g_conflictViolation g_moduleUnmetDep g_unmetDepHash g_moduleEval} {
      eval "lappend ::g_SAVE_$var \[array get ::$var\]"
   }
   # save non-array variable and indication if it was set
   foreach var {g_changeDir g_stdoutPuts g_return_text} {
      if {[info exists ::$var]} {
         eval "lappend ::g_SAVE_$var \[list 1 \[set ::$var\]\]"
      } else {
         eval "lappend ::g_SAVE_$var \[list 0 {}\]"
      }
   }
   reportDebug "settings saved (#[getSavedSettingsStackDepth])"
}

proc popSettings {} {
   set flushedid [getSavedSettingsStackDepth]
   foreach var {env g_clearedEnvVars g_Aliases g_stateEnvVars g_stateAliases\
      g_stateFunctions g_Functions g_newXResources g_delXResources\
      g_changeDir g_stdoutPuts g_return_text\
      g_loadedModules g_loadedModuleFiles g_loadedModuleUasked\
      g_loadedModuleConflict g_loadedModulePrereq g_loadedModuleAltname\
      g_loadedModuleAutoAltname g_moduleDepend g_dependHash g_moduleNPODepend\
      g_dependNPOHash g_prereqViolation g_prereqNPOViolation\
      g_conflictViolation g_moduleUnmetDep g_unmetDepHash g_moduleEval} {
      eval "set ::g_SAVE_$var \[lrange \$::g_SAVE_$var 0 end-1\]"
   }
   reportDebug "previously saved settings flushed (#$flushedid)"
}

proc restoreSettings {} {
   foreach var {g_clearedEnvVars g_Aliases g_stateEnvVars g_stateAliases\
      g_stateFunctions g_Functions g_newXResources g_delXResources\
      g_loadedModules g_loadedModuleFiles g_loadedModuleUasked\
      g_loadedModuleConflict g_loadedModulePrereq g_loadedModuleAltname\
      g_loadedModuleAutoAltname g_moduleDepend g_dependHash g_moduleNPODepend\
      g_dependNPOHash g_prereqViolation g_prereqNPOViolation\
      g_conflictViolation g_moduleUnmetDep g_unmetDepHash g_moduleEval} {
      # clear current $var arrays
      if {[info exists ::$var]} {
         eval "unset ::$var; array set ::$var {}"
      }
      eval "array set ::$var \[lindex \$::g_SAVE_$var end\]"
   }
   # specific restore mechanism for ::env as unsetting this array will make
   # Tcl stop monitoring env accesses and not update env variables anymore
   set envvarlist [list]
   foreach {var val} [lindex $::g_SAVE_env end] {
      lappend envvarlist $var
      interp-sync-env set $var $val
   }
   foreach var [array names ::env] {
      if {[notInList $envvarlist $var]} {
         interp-sync-env unset $var
      }
   }
   # restore non-array variable if it was set
   foreach var {g_changeDir g_stdoutPuts g_return_text} {
      if {[info exists ::$var]} {
         eval "unset ::$var"
      }
      eval "lassign \[lindex \$::g_SAVE_$var end\] isdefined val"
      if {$isdefined} {
         set ::$var $val
      }
   }
   reportDebug "previously saved settings restored\
      (#[getSavedSettingsStackDepth])"
}

proc renderSettings {} {
   global g_stateEnvVars g_stateAliases g_stateFunctions g_newXResources\
      g_delXResources

reportDebug called.

# required to work on cygwin, shouldn't hurt real linux
   fconfigure stdout -translation lf

# preliminaries if there is stuff to render
   if {$::g_autoInit || [array size g_stateEnvVars] > 0 ||\
      [array size g_stateAliases] > 0 || [array size g_newXResources] > 0 ||\
      [array size g_stateFunctions] > 0 || [array size g_delXResources] > 0\
      || [info exists ::g_changeDir] || [info exists ::g_stdoutPuts] ||\
      [info exists ::g_return_text]} {
      switch -- $::g_shellType {
         python {
            puts stdout {import os}
         }
      }
      set has_rendered 1
   } else {
      set has_rendered 0
   }

if {$::g_autoInit} {
      renderAutoinit
   }

# new environment variables
   foreach var [array names g_stateEnvVars] {
      switch -- $g_stateEnvVars($var) {
         new {
            switch -- $::g_shellType {
               csh {
                  set val [charEscaped $::env($var)]
                  # csh barfs on long env vars
                  if {$::g_shell eq {csh} && [string length $val] >\
                     $::CSH_LIMIT} {
                     if {$var eq {PATH}} {
                        reportWarning "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 "$var exceeds $::CSH_LIMIT characters,\
                            truncating..."
                         set val [string range $val 0 [expr {$::CSH_LIMIT\
                            - 1}]]
                     }
                  }
                  puts stdout "setenv $var $val;"
               }
               sh {
                  puts stdout "$var=[charEscaped $::env($var)];\
                     export $var;"
               }
               fish {
                  set val [charEscaped $::env($var)]
                  # fish shell has special treatment for PATH variable
                  # so its value should be provided as a list separated
                  # by spaces not by semi-colons
                  if {$var eq {PATH}} {
                     regsub -all : $val { } val
                  }
                  puts stdout "set -xg $var $val;"
               }
               tcl {
                  set val $::env($var)
                  puts stdout "set ::env($var) {$val};"
               }
               cmd {
                  set val $::env($var)
                  puts stdout "set $var=$val"
               }
               perl {
                  set val [charEscaped $::env($var) \']
                  puts stdout "\$ENV{'$var'} = '$val';"
               }
               python {
                  set val [charEscaped $::env($var) \']
                  puts stdout "os.environ\['$var'\] = '$val'"
               }
               ruby {
                  set val [charEscaped $::env($var) \']
                  puts stdout "ENV\['$var'\] = '$val'"
               }
               lisp {
                  set val [charEscaped $::env($var) \"]
                  puts stdout "(setenv \"$var\" \"$val\")"
               }
               cmake {
                  set val [charEscaped $::env($var) \"]
                  puts stdout "set(ENV{$var} \"$val\")"
               }
               r {
                  set val [charEscaped $::env($var) {\\'}]
                  puts stdout "Sys.setenv('$var'='$val')"
               }
            }
         }
         del {
            switch -- $::g_shellType {
               csh {
                  puts stdout "unsetenv $var;"
               }
               sh {
                  puts stdout "unset $var;"
               }
               fish {
                  puts stdout "set -e $var;"
               }
               tcl {
                  puts stdout "catch {unset ::env($var)};"
               }
               cmd {
                  puts stdout "set $var="
               }
               perl {
                  puts stdout "delete \$ENV{'$var'};"
               }
               python {
                  puts stdout "os.environ\['$var'\] = ''"
                  puts stdout "del os.environ\['$var'\]"
               }
               ruby {
                  puts stdout "ENV\['$var'\] = nil"
               }
               lisp {
                  puts stdout "(setenv \"$var\" nil)"
               }
               cmake {
                  puts stdout "unset(ENV{$var})"
               }
               r {
                  puts stdout "Sys.unsetenv('$var')"
               }
            }
         }
      }
   }

foreach var [array names g_stateAliases] {
      switch -- $g_stateAliases($var) {
         new {
            set val $::g_Aliases($var)
            # convert $n in !!:n and $* in !* on csh (like on compat version)
            if {$::g_shellType eq {csh}} {
               regsub -all {([^\\]|^)\$([0-9]+)} $val {\1!!:\2} val
               regsub -all {([^\\]|^)\$\*} $val {\1!*} val
            }
            # unescape \$ after now csh-specific conversion is over
            regsub -all {\\\$} $val {$} val
            switch -- $::g_shellType {
               csh {
                  set val [charEscaped $val]
                  puts stdout "alias $var $val;"
               }
               sh {
                  set val [charEscaped $val]
                  puts stdout "alias $var=$val;"
               }
               fish {
                  set val [charEscaped $val]
                  puts stdout "alias $var $val;"
               }
               cmd {
                  puts stdout "doskey $var=$val"
               }
            }
         }
         del {
            switch -- $::g_shellType {
               csh {
                  puts stdout "unalias $var;"
               }
               sh {
                  puts stdout "unalias $var;"
               }
               fish {
                  puts stdout "functions -e $var;"
               }
               cmd {
                  puts stdout "doskey $var="
               }
            }
         }
      }
   }
   foreach funcname [array names g_stateFunctions] {
      switch -- $g_stateFunctions($funcname) {
         new {
            # trim function body to smoothly add a finishing ;
            set val [string trim $::g_Functions($funcname) "; \t\n\r"]
            switch -- $::g_shellType {
               sh {
                  puts stdout "$funcname () { $val; }; export $funcname;"
               }
               fish {
                  puts stdout "function $funcname; $val; end;"
               }
            }
         }
         del {
            switch -- $::g_shellType {
               sh {
                  puts stdout "unset -f $funcname;"
               }
               fish {
                  puts stdout "functions -e $funcname;"
               }
            }
         }
      }
   }

# preliminaries for x-resources stuff
   if {[array size g_newXResources] > 0 || [array size g_delXResources] > 0} {
      switch -- $::g_shellType {
         python {
            puts stdout {import subprocess}
         }
         ruby {
            puts stdout {require 'open3'}
         }
      }
   }

# new x resources
   if {[array size g_newXResources] > 0} {
      # xrdb executable has already be verified in x-resource
      set xrdb [getCommandPath xrdb]
      foreach var [array names g_newXResources] {
         set val $g_newXResources($var)
         # empty val means that var is a file to parse
         if {$val eq {}} {
            switch -- $::g_shellType {
               sh - csh - fish {
                  puts stdout "$xrdb -merge $var;"
               }
               tcl {
                  puts stdout "exec $xrdb -merge $var;"
               }
               perl {
                  puts stdout "system(\"$xrdb -merge $var\");"
               }
               python {
                  set var [charEscaped $var \']
                  puts stdout "subprocess.Popen(\['$xrdb',\
                     '-merge', '$var'\])"
               }
               ruby {
                  set var [charEscaped $var \']
                  puts stdout "Open3.popen2('$xrdb -merge $var')"
               }
               lisp {
                  puts stdout "(shell-command-to-string \"$xrdb\
                     -merge $var\")"
               }
               cmake {
                  puts stdout "execute_process(COMMAND $xrdb -merge $var)"
               }
               r {
                  set var [charEscaped $var {\\'}]
                  puts stdout "system('$xrdb -merge $var')"
               }
            }
         } else {
            switch -- $::g_shellType {
               sh - csh - fish {
                  set var [charEscaped $var \"]
                  set val [charEscaped $val \"]
                  puts stdout "echo \"$var: $val\" | $xrdb -merge;"
               }
               tcl {
                  puts stdout "set XRDBPIPE \[open \"|$xrdb -merge\" r+\];"
                  set var [charEscaped $var \"]
                  set val [charEscaped $val \"]
                  puts stdout "puts \$XRDBPIPE \"$var: $val\";"
                  puts stdout {close $XRDBPIPE;}
                  puts stdout {unset XRDBPIPE;}
               }
               perl {
                  puts stdout "open(XRDBPIPE, \"|$xrdb -merge\");"
                  set var [charEscaped $var \"]
                  set val [charEscaped $val \"]
                  puts stdout "print XRDBPIPE \"$var: $val\\n\";"
                  puts stdout {close XRDBPIPE;}
               }
               python {
                  set var [charEscaped $var \']
                  set val [charEscaped $val \']
                  puts stdout "subprocess.Popen(\['$xrdb', '-merge'\],\
                     stdin=subprocess.PIPE).communicate(input='$var:\
                     $val\\n')"
               }
               ruby {
                  set var [charEscaped $var \']
                  set val [charEscaped $val \']
                  puts stdout "Open3.popen2('$xrdb -merge') {|i,o,t| i.puts\
                     '$var: $val'}"
               }
               lisp {
                  puts stdout "(shell-command-to-string \"echo $var:\
                     $val | $xrdb -merge\")"
               }
               cmake {
                  set var [charEscaped $var \"]
                  set val [charEscaped $val \"]
                  puts stdout "execute_process(COMMAND echo \"$var: $val\"\
                     COMMAND $xrdb -merge)"
               }
               r {
                  set var [charEscaped $var {\\'}]
                  set val [charEscaped $val {\\'}]
                  puts stdout "system('$xrdb -merge', input='$var: $val')"
               }
            }
         }
      }
   }

if {[array size g_delXResources] > 0} {
      set xrdb [getCommandPath xrdb]
      set xres_to_del {}
      foreach var [array names g_delXResources] {
         # empty val means that var is a file to parse
         if {$g_delXResources($var) eq {}} {
            # xresource file has to be parsed to find what resources
            # are declared there and need to be unset
            foreach fline [split [exec $xrdb -n load $var] \n] {
               lappend xres_to_del [lindex [split $fline :] 0]
            }
         } else {
            lappend xres_to_del $var
         }
      }

# xresource strings are unset by emptying their value since there
      # is no command of xrdb that can properly remove one property
      switch -- $::g_shellType {
         sh - csh - fish {
            foreach var $xres_to_del {
               puts stdout "echo \"$var:\" | $xrdb -merge;"
            }
         }
         tcl {
            foreach var $xres_to_del {
               puts stdout "set XRDBPIPE \[open \"|$xrdb -merge\" r+\];"
               set var [charEscaped $var \"]
               puts stdout "puts \$XRDBPIPE \"$var:\";"
               puts stdout {close $XRDBPIPE;}
               puts stdout {unset XRDBPIPE;}
            }
         }
         perl {
            foreach var $xres_to_del {
               puts stdout "open(XRDBPIPE, \"|$xrdb -merge\");"
               set var [charEscaped $var \"]
               puts stdout "print XRDBPIPE \"$var:\\n\";"
               puts stdout {close XRDBPIPE;}
            }
         }
         python {
            foreach var $xres_to_del {
               set var [charEscaped $var \']
               puts stdout "subprocess.Popen(\['$xrdb', '-merge'\],\
                  stdin=subprocess.PIPE).communicate(input='$var:\\n')"
            }
         }
         ruby {
            foreach var $xres_to_del {
               set var [charEscaped $var \']
               puts stdout "Open3.popen2('$xrdb -merge') {|i,o,t| i.puts\
                  '$var:'}"
            }
         }
         lisp {
            foreach var $xres_to_del {
               puts stdout "(shell-command-to-string \"echo $var: |\
                  $xrdb -merge\")"
            }
         }
         cmake {
            foreach var $xres_to_del {
               set var [charEscaped $var \"]
               puts stdout "execute_process(COMMAND echo \"$var:\"\
                  COMMAND $xrdb -merge)"
            }
         }
         r {
            foreach var $xres_to_del {
               set var [charEscaped $var {\\'}]
               puts stdout "system('$xrdb -merge', input='$var:')"
            }
         }
      }
   }

if {[info exists ::g_changeDir]} {
      switch -- $::g_shellType {
         sh - csh - fish {
            puts stdout "cd '$::g_changeDir';"
         }
         tcl {
            puts stdout "cd \"$::g_changeDir\";"
         }
         cmd {
            puts stdout "cd $::g_changeDir"
         }
         perl {
            puts stdout "chdir '$::g_changeDir';"
         }
         python {
            puts stdout "os.chdir('$::g_changeDir')"
         }
         ruby {
            puts stdout "Dir.chdir('$::g_changeDir')"
         }
         lisp {
            puts stdout "(shell-command-to-string \"cd '$::g_changeDir'\")"
         }
         r {
            puts stdout "setwd('$::g_changeDir')"
         }
      }
      # cannot change current directory of cmake "shell"
   }

# send content deferred during modulefile interpretation
   if {[info exists ::g_stdoutPuts]} {
      foreach putsArgs $::g_stdoutPuts {
         eval puts $putsArgs
         # check if a finishing newline will be needed after content sent
         set needPutsNl [expr {[lindex $putsArgs 0] eq {-nonewline} ? 1 : 0}]
      }
      if {$needPutsNl} {
         puts stdout {}
      }
   }

# return text value if defined even if error happened
   if {[info exists ::g_return_text]} {
      reportDebug {text value should be returned.}
      renderText $::g_return_text
   } elseif {$::error_count > 0} {
      reportDebug "$::error_count error(s) detected."
      renderFalse
   } elseif {$::g_return_false} {
      reportDebug {false value should be returned.}
      renderFalse
   } elseif {$has_rendered} {
      # finish with true statement if something has been put
      renderTrue
   }
}

proc renderAutoinit {} {
   reportDebug called.

# automatically detect which tclsh should be used for
   # future module commands
   set tclshbin [info nameofexecutable]

# ensure script path is absolute
   set ::argv0 [getAbsolutePath $::argv0]

switch -- $::g_shellType {
      csh {
         set pre_hi {set _histchars = $histchars; unset histchars;}
         set post_hi {set histchars = $_histchars; unset _histchars;}
         set pre_pr {set _prompt=$prompt:q; set prompt="";}
         set post_pr {set prompt=$_prompt:q; unset _prompt;}
         # apply workaround for Tcsh history if set
         set eval_cmd [expr {[getConf wa_277] ? "eval `$tclshbin $::argv0\
            $::g_shell \\!*`;" :  "eval \"`$tclshbin $::argv0 $::g_shell\
            \\!*:q`\";"}]
         set pre_ex {set _exit="$status";}
         set post_ex {test 0 = $_exit}

set fdef "if ( \$?histchars && \$?prompt )\
alias module '$pre_hi $pre_pr $eval_cmd $pre_ex $post_hi $post_pr $post_ex' ;
if ( \$?histchars && ! \$?prompt )\
alias module '$pre_hi $eval_cmd $pre_ex $post_hi $post_ex' ;
if ( ! \$?histchars && \$?prompt )\
alias module '$pre_pr $eval_cmd $pre_ex $post_pr $post_ex' ;
if ( ! \$?histchars && ! \$?prompt ) alias module '$eval_cmd' ;"
         if {[getConf ml]} {
            append fdef {
alias ml 'module ml \!*' ;}
         }
      }
      sh {
         # Considering the diversity of ways local variables are handled
         # through the sh-variants ('local' known everywhere except on ksh,
         # 'typeset' known everywhere except on pure-sh, and on some systems
         # the pure-sh is in fact a 'ksh'), no local variables are defined and
         # these variables that should have been local are unset at the end

# on zsh, word splitting should be enabled explicitly
         set wsplit [expr {$::g_shell eq {zsh} ? {=} : {}}]
         # only redirect module from stderr to stdout when session is
         # attached to a terminal to avoid breaking non-terminal session
         # (scp, sftp, etc)
         set fname [expr {[isStderrTty] ? {_module_raw} : {module}}]
         # build quarantine mechanism in module function
         # an empty runtime variable is set even if no corresponding
         # MODULES_RUNENV_* variable found, as var cannot be unset on
         # modified environment command-line
         set fdef "${fname}() {"
         append fdef {
   unset _mlshdbg;
   if [ "${MODULES_SILENT_SHELL_DEBUG:-0}" = '1' ]; then
      case "$-" in
         *v*x*) set +vx; _mlshdbg='vx' ;;
         *v*) set +v; _mlshdbg='v' ;;
         *x*) set +x; _mlshdbg='x' ;;
         *) _mlshdbg='' ;;
      esac;
   fi;}
         append fdef "
   unset _mlre _mlIFS;
   if \[ -n \"\${IFS+x}\" \]; then
      _mlIFS=\$IFS;
   fi;
   IFS=' ';
   for _mlv in \${${wsplit}MODULES_RUN_QUARANTINE:-}; do"
         append fdef {
      if [ "${_mlv}" = "${_mlv##*[!A-Za-z0-9_]}" -a "${_mlv}" = "${_mlv#[0-9]}" ]; then
         if [ -n "`eval 'echo ${'$_mlv'+x}'`" ]; then
            _mlre="${_mlre:-}${_mlv}_modquar='`eval 'echo ${'$_mlv'}'`' ";
         fi;
         _mlrv="MODULES_RUNENV_${_mlv}";
         _mlre="${_mlre:-}${_mlv}='`eval 'echo ${'$_mlrv':-}'`' ";
      fi;
   done;
   if [ -n "${_mlre:-}" ]; then}
         append fdef "\n      eval `eval \${${wsplit}_mlre} $tclshbin $::argv0\
$::g_shell '\"\$@\"'`;
   else
      eval `$tclshbin $::argv0 $::g_shell \"\$@\"`;
   fi;"
#         append fdef "
#   eval `$tclshbin $::argv0 $::g_shell \"\$@\"`;"
         append fdef {
   _mlstatus=$?;}
         append fdef {
   if [ -n "${_mlIFS+x}" ]; then
      IFS=$_mlIFS;
   else
      unset IFS;
   fi;
   unset _mlre _mlv _mlrv _mlIFS;}
         append fdef {
   if [ -n "${_mlshdbg:-}" ]; then
      set -$_mlshdbg;
   fi;
   unset _mlshdbg;}
         append fdef {
   return $_mlstatus;}
         append fdef "\n};"
         if {[isStderrTty]} {
            append fdef "\nmodule() { _module_raw \"\$@\" 2>&1; };"
         }
         if {[getConf ml]} {
            append fdef {
ml() { module ml "$@"; };}
         }
      }
      fish {
         set fdef [expr {[isStderrTty] ? "function _module_raw\n" :\
            "function module\n"}]
         append fdef {   set -l _mlre ''; set -l _mlv; set -l _mlrv;
   for _mlv in (string split ' ' $MODULES_RUN_QUARANTINE)
      if string match -r '^[A-Za-z_][A-Za-z0-9_]*$' $_mlv >/dev/null
         if set -q $_mlv
            set _mlre $_mlre$_mlv"_modquar='$$_mlv' "
         end
         set _mlrv "MODULES_RUNENV_$_mlv"
         set _mlre "$_mlre$_mlv='$$_mlrv' "
      end
   end
   if [ -n "$_mlre" ]
      set _mlre "env $_mlre"
   end}
         # use "| source -" rather than "eval" to be able
         # to redirect stderr after stdout being evaluated
         append fdef "\n   eval \$_mlre $tclshbin $::argv0 $::g_shell\
            (string escape -- \$argv) | source -\n"
#         append fdef "   eval $tclshbin $::argv0 $::g_shell\
            (string escape -- \$argv) | source -\n"
         if {[isStderrTty]} {
            append fdef {end
function module
   _module_raw $argv 2>&1
end}
         } else {
            append fdef end
         }
         if {[getConf ml]} {
            append fdef {
function ml
   module ml $argv
end}
         }
      }
      tcl {
         set fdef "proc module {args} {"
         append fdef {
   set _mlre {};
   if {[info exists ::env(MODULES_RUN_QUARANTINE)]} {
      foreach _mlv [split $::env(MODULES_RUN_QUARANTINE) " "] {
         if {[regexp {^[A-Za-z_][A-Za-z0-9_]*$} $_mlv]} {
            if {[info exists ::env($_mlv)]} {
               lappend _mlre "${_mlv}_modquar=$::env($_mlv)"
            }
            set _mlrv "MODULES_RUNENV_${_mlv}"
            lappend _mlre [expr {[info exists ::env($_mlrv)] ?\
               "${_mlv}=$::env($_mlrv)" : "${_mlv}="}]
         }
      }
      if {[llength $_mlre] > 0} {
         set _mlre [linsert $_mlre 0 "env"]
      }
   }}
      append fdef {
   set _mlstatus 1;}
         append fdef "\n   catch {eval exec \$_mlre \"$tclshbin\"\
            \"$::argv0\" \"$::g_shell\" \$args 2>@stderr} script\n"
#         append fdef "\n   catch {eval exec \"$tclshbin\"\
            \"$::argv0\" \"$::g_shell\" \$args 2>@stderr} script\n"
         append fdef {   eval $script;
   return $_mlstatus}
         append fdef "\n}"
         if {[getConf ml]} {
            append fdef {
proc ml {args} {
   return [eval module ml $args]
}}
         }
      }
      cmd {
         reportErrorAndExit {No autoinit mode available for 'cmd' shell}
      }
      perl {
         set fdef "sub module {"
         append fdef {
   my $_mlre = '';
   if (defined $ENV{'MODULES_RUN_QUARANTINE'}) {
      foreach my $_mlv (split(' ', $ENV{'MODULES_RUN_QUARANTINE'})) {
         if ($_mlv =~ /^[A-Za-z_][A-Za-z0-9_]*$/) {
            if (defined $ENV{$_mlv}) {
               $_mlre .= "${_mlv}_modquar='$ENV{$_mlv}' ";
            }
            my $_mlrv = "MODULES_RUNENV_$_mlv";
            $_mlre .= "$_mlv='$ENV{$_mlrv}' ";
        }
      }
      if ($_mlre ne "") {
         $_mlre = "env $_mlre";
      }
   }}
         append fdef {
   my $args = '';
   if (@_ > 0) {
      $args = '"' . join('" "', @_) . '"';
   }
   my $_mlstatus = 1;}
         append fdef "\n   eval `\${_mlre}$tclshbin $::argv0 perl \$args`;\n"
#         append fdef "\n   eval `$tclshbin $::argv0 perl \$args`;\n"
         append fdef {   return $_mlstatus;}
         append fdef "\n}"
         if {[getConf ml]} {
            append fdef {
sub ml {
   return module('ml', @_);
}}
         }
      }
      python {
         set fdef {import re, subprocess
def module(*arguments):}
         append fdef {
   _mlre = os.environ.copy()
   if 'MODULES_RUN_QUARANTINE' in os.environ:
      for _mlv in os.environ['MODULES_RUN_QUARANTINE'].split():
         if re.match('^[A-Za-z_][A-Za-z0-9_]*$', _mlv):
            if _mlv in os.environ:
               _mlre[_mlv + '_modquar'] = os.environ[_mlv]
            _mlrv = 'MODULES_RUNENV_' + _mlv
            if _mlrv in os.environ:
               _mlre[_mlv] = os.environ[_mlrv]
            else:
               _mlre[_mlv] = ''}
         append fdef {
   ns = {}}
         append fdef "\n   exec(subprocess.Popen(\['$tclshbin',\
            '$::argv0', 'python'\] + list(arguments),\
            stdout=subprocess.PIPE, env=_mlre).communicate()\[0\], ns)\n"
#         append fdef "\n   exec(subprocess.Popen(\['$tclshbin',\
            '$::argv0', 'python'\] + list(arguments),\
            stdout=subprocess.PIPE).communicate()\[0\], ns)\n"
         append fdef {   if '_mlstatus' in ns:
      _mlstatus = ns['_mlstatus']
   else:
      _mlstatus = True
   return _mlstatus}
         if {[getConf ml]} {
            append fdef {
def ml(*arguments):
   return module('ml', *arguments)
}
         }
      }
      ruby {
         set fdef {class ENVModule
   def ENVModule.module(*args)}
         append fdef {
      _mlre = ''
      if ENV.has_key?('MODULES_RUN_QUARANTINE') then
         ENV['MODULES_RUN_QUARANTINE'].split(' ').each do |_mlv|
            if _mlv =~ /^[A-Za-z_][A-Za-z0-9_]*$/ then
               if ENV.has_key?(_mlv) then
                  _mlre << _mlv + "_modquar='" + ENV[_mlv].to_s + "' "
               end
               _mlrv = 'MODULES_RUNENV_' + _mlv
               _mlre << _mlv + "='" + ENV[_mlrv].to_s + "' "
            end
         end
         unless _mlre.empty?
            _mlre = 'env ' + _mlre
         end
      end}
         append fdef {
      if args[0].kind_of?(Array) then
         args = args[0]
      end
      if args.length == 0 then
         args = ''
      else
         args = "\"#{args.join('" "')}\""
      end
      _mlstatus = true}
         append fdef "\n      eval `#{_mlre}$tclshbin $::argv0 ruby #{args}`\n"
#         append fdef "\n      eval `$tclshbin $::argv0 ruby #{args}`\n"
         append fdef {      return _mlstatus
   end}
         if {[getConf ml]} {
            append fdef {
   def ENVModule.ml(*args)
      return ENVModule.module('ml', *args)
   end}
         }
         append fdef {
end}
      }
      lisp {
         reportErrorAndExit {lisp mode autoinit not yet implemented}
      }
      cmake {
         set pre_exec "\n      execute_process(COMMAND \${_mlre} $tclshbin\
            $::argv0 cmake "
#         set pre_exec "\n      execute_process(COMMAND $tclshbin\
            $::argv0 cmake "
         set post_exec "\n         OUTPUT_FILE \${tempfile_name})\n"
         set fdef {function(module)
   cmake_policy(SET CMP0007 NEW)}
         append fdef {
   set(_mlre "")
   if(DEFINED ENV{MODULES_RUN_QUARANTINE})
      string(REPLACE " " ";" _mlv_list "$ENV{MODULES_RUN_QUARANTINE}")
      foreach(_mlv ${_mlv_list})
         if(${_mlv} MATCHES "^[A-Za-z_][A-Za-z0-9_]*$")
            if(DEFINED ENV{${_mlv}})
               set(_mlre "${_mlre}${_mlv}_modquar=$ENV{${_mlv}};")
            endif()
            set(_mlrv "MODULES_RUNENV_${_mlv}")
            set(_mlre "${_mlre}${_mlv}=$ENV{${_mlrv}};")
        endif()
      endforeach()
      if (NOT "${_mlre}" STREQUAL "")
         set(_mlre "env;${_mlre}")
      endif()
   endif()}
         append fdef {
   set(_mlstatus TRUE)
   execute_process(COMMAND mktemp -t moduleinit.cmake.XXXXXXXXXXXX
      OUTPUT_VARIABLE tempfile_name
      OUTPUT_STRIP_TRAILING_WHITESPACE)
   if(${ARGC} EQUAL 1)}
            # adapt command definition depending on the number of args to be
            # able to pass to some extend (<5 args) empty string element to
            # modulecmd (no other way as empty element in ${ARGV} are skipped
            append fdef "$pre_exec\"\${ARGV0}\"$post_exec"
            append fdef {   elseif(${ARGC} EQUAL 2)}
            append fdef "$pre_exec\"\${ARGV0}\" \"\${ARGV1}\"$post_exec"
            append fdef {   elseif(${ARGC} EQUAL 3)}
            append fdef "$pre_exec\"\${ARGV0}\" \"\${ARGV1}\"\
               \"\${ARGV2}\"$post_exec"
            append fdef {   elseif(${ARGC} EQUAL 4)}
            append fdef "$pre_exec\"\${ARGV0}\" \"\${ARGV1}\"\
               \"\${ARGV2}\" \"\${ARGV3}\"$post_exec"
            append fdef {   else()}
            append fdef "$pre_exec\${ARGV}$post_exec"
            append fdef {   endif()
   if(EXISTS ${tempfile_name})
      include(${tempfile_name})
      file(REMOVE ${tempfile_name})
   endif()
   set(module_result ${_mlstatus} PARENT_SCOPE)
endfunction(module)}
         if {[getConf ml]} {
            append fdef {
function(ml)
   module(ml ${ARGV})
   set(module_result ${module_result} PARENT_SCOPE)
endfunction(ml)}
         }
      }
      r {
         set fdef "module <- function(...){"
         append fdef {
   mlre <- ''
   if (!is.na(Sys.getenv('MODULES_RUN_QUARANTINE', unset=NA))) {
      for (mlv in strsplit(Sys.getenv('MODULES_RUN_QUARANTINE'), ' ')[[1]]) {
         if (grepl('^[A-Za-z_][A-Za-z0-9_]*$', mlv)) {
            if (!is.na(Sys.getenv(mlv, unset=NA))) {
               mlre <- paste0(mlre, mlv, "_modquar='", Sys.getenv(mlv), "' ")
            }
            mlrv <- paste0('MODULES_RUNENV_', mlv)
            mlre <- paste0(mlre, mlv, "='", Sys.getenv(mlrv), "' ")
         }
      }
      if (mlre != '') {
         mlre <- paste0('env ', mlre)
      }
   }}
         append fdef {
   arglist <- as.list(match.call())
   arglist[1] <- 'r'
   args <- paste0('"', paste0(arglist, collapse='" "'), '"')}
         append fdef "\n   cmd <- paste(mlre, '$tclshbin', '$::argv0', args,\
            sep=' ')\n"
#         append fdef "\n   cmd <- paste('$tclshbin', '$::argv0', args,\
            sep=' ')\n"
         append fdef {   mlstatus <- TRUE
   hndl <- pipe(cmd)
   eval(expr = parse(file=hndl))
   close(hndl)
   invisible(mlstatus)}
         append fdef "\n}"
         if {[getConf ml]} {
            append fdef {
ml <- function(...){
   module('ml', ...)
}}
         }
      }
   }

# output function definition
   puts stdout $fdef
}

proc cacheCurrentModules {} {
   # parse loaded modules information only once, global arrays are updated
   # afterwards when module commands update loaded modules state
   if {![info exists ::g_lm_info_cached]} {
      set ::g_lm_info_cached 1
      # mark specific as well as generic modules as loaded
      set i 0
      set modfilelist [getLoadedModuleFileList]
      set modlist [getLoadedModuleList]
      set nuaskedlist [getLoadedModuleNotUserAskedList]

if {[llength $modlist] == [llength $modfilelist]} {
         # cache declared alternative names of loaded modules
         foreach modalt [getLoadedModuleAltnameList] {
            eval setLoadedAltname $modalt
         }

# cache declared conflict of loaded modules
         foreach modcon [getLoadedModuleConflictList] {
            # parse module version specification to record translation
            foreach modconelt [lrange $modcon 1 end] {
               eval parseModuleVersionSpecifier 0 $modconelt
            }
            eval setLoadedConflict $modcon
         }

# cache declared prereq of loaded modules, prior to setLoadedModule
         # which triggers dependency chain build
         foreach modpre [getLoadedModulePrereqList] {
            # parse module version specification to record translation
            foreach modpreeltlist [lrange $modpre 1 end] {
               foreach modpreelt $modpreeltlist {
                  eval parseModuleVersionSpecifier 0 $modpreelt
               }
            }
            eval setLoadedPrereq $modpre
         }

foreach mod $modlist {
            setLoadedModule $mod [lindex $modfilelist $i] [notInList\
               $nuaskedlist $mod]
            incr i
         }

reportDebug "$i loaded"
      } else {
         reportErrorAndExit "Loaded environment state is\
            inconsistent\nLOADEDMODULES=$modlist\n_LMFILES_=$modfilelist"
      }
   }
}

# This proc resolves module aliases or version aliases to the real module name
# and version.
proc resolveModuleVersionOrAlias {name icase} {
   set name [getArrayKey ::g_moduleResolved $name $icase]
   if {[info exists ::g_moduleResolved($name)]} {
      set ret $::g_moduleResolved($name)
   } else {
      set ret $name
   }

reportDebug "'$name' resolved to '$ret'"
   return $ret
}

proc charEscaped {str {charlist { \\\t\{\}|<>!;#^$&*?"'`()}}} {
   return [regsub -all "$\[$charlist\]$" $str {\\\1}]
}

proc charUnescaped {str {charlist { \\\t\{\}|<>!;#^$&*?"'`()}}} {
   return [regsub -all "\\\\$\[$charlist\]$" $str {\1}]
}

# find command path and remember it
proc getCommandPath {cmd} {
   return [lindex [auto_execok $cmd] 0]
}

# find then run command or raise error if command not found
proc runCommand {cmd args} {
   set cmdpath [getCommandPath $cmd]
   if {$cmdpath eq {}} {
      knerror "Command '$cmd' cannot be found" MODULES_ERR_GLOBAL
   } else {
      return [eval exec $cmdpath $args]
   }
}

proc getAbsolutePath {path} {
   # currently executing a modulefile or rc, so get the directory of this file
   if {$::ModulesCurrentModulefile ne {}} {
      set curdir [file dirname $::ModulesCurrentModulefile]
   # elsewhere get module command current working directory
   } else {
      # register pwd at first call
      if {![info exists ::cwd]} {
         set ::cwd [pwd]
      }
      set curdir $::cwd
   }

# empty result if empty path
   if {$path eq {}} {
      set abspath {}
   } else {
      set abslist {}
      # get a first version of the absolute path by joining the current
      # working directory to the given path. if given path is already absolute
      # 'file join' will not break it as $curdir will be ignored as soon a
      # beginning '/' character is found on $path. this first pass also clean
      # extra '/' character. then each element of the path is analyzed to
      # clear "." and ".." components.
      foreach elt [file split [file join $curdir $path]] {
         if {$elt eq {..}} {
            # skip ".." element if it comes after root element, remove last
            # element elsewhere
            if {[llength $abslist] > 1} {
               set abslist [lreplace $abslist end end]
            }
         # skip any "." element
         } elseif {$elt ne {.}} {
            lappend abslist $elt
         }
      }
      set abspath [eval file join $abslist]
   }

# return cleaned absolute path
   return $abspath
}

# if no exact match found but icase mode is enabled then search if an icase
# match exists among all array key elements, select dictionary highest version
# if multiple icase matches are returned
proc getArrayKey {arrname name icase} {
   if {$icase} {
      upvar $arrname arr
      if {![info exists arr($name)]} {
         foreach elt [lsort -dictionary -decreasing [array names arr]] {
            if {[string equal -nocase $name $elt]} {
               reportDebug "key '$elt' in array '$arrname' matches '$name'"
               set name $elt
               break
            }
         }
      }
   }
   return $name
}

# Define procedure to compare module names set as array keys against pattern.
# Adapt procedure code whether implicit_default is enabled or disabled
proc defineGetEqArrayKeyProc {icase extdfl impdfl} {
   set procname getEqArrayKeyProc
   if {$impdfl} {
      append procname Impdfl
   }

# define proc if not done yet or if it was defined for another context
   if {[info procs getEqArrayKey] eq {} || $::g_getEqArrayKey_proc ne\
      $procname} {
      if {[info exists ::g_getEqArrayKey_proc]} {
         rename ::getEqArrayKey ::$::g_getEqArrayKey_proc
      }
      rename ::$procname ::getEqArrayKey
      set ::g_getEqArrayKey_proc $procname
   }

# also define modEq which is called by getEqArrayKey
   defineModEqProc $icase $extdfl
}

# alternative definitions of getEqArrayKey proc
proc getEqArrayKeyProcImpdfl {arrname name} {
   set icase [isIcase]
   upvar $arrname arr

# extract single module specified if any
   lassign [getModuleVersSpec $name] mod modname
   # check name eventual icase match
   set mod [getArrayKey arr [string trimright $mod /] $icase]

if {$mod ne {} && [info exists arr($mod)]} {
      set match $mod
   } else {
      set mlist {}
      foreach elt [array names arr] {
         if {[modEq $name $elt]} {
            lappend mlist $elt
         }
      }
      if {[llength $mlist] == 1} {
         set match [lindex $mlist 0]
      # in case multiple modules match query, check directory default and
      # return it if it is part of match list, elsewhere return highest result
      } elseif {[llength $mlist] > 1} {
         # get corresponding icase parent directory
         set pname [getArrayKey arr $modname $icase]
         if {[info exists arr($pname)]} {
            set dfl $pname/[lindex $arr($pname) 1]
         }
         # resolve symbolic version entries
         foreach elt $mlist {
            if {[lindex $arr($elt) 0] eq {version}} {
               lappend mrlist [lindex $arr($elt) 1]
            } else {
               lappend mrlist $elt
            }
         }
         if {[info exists dfl] && [isInList $mrlist $dfl]} {
            set match $dfl
         } else {
            set match [lindex [lsort -dictionary $mrlist] end]
         }
      }
   }
   if {[info exists match]} {
      reportDebug "key '$match' in array '$arrname' matches '$name'"
      set name $match
   }
   return $name
}
proc getEqArrayKeyProc {arrname name} {
   set icase [isIcase]
   upvar $arrname arr

lassign [getModuleVersSpec $name] mod modname
   # check name eventual icase match
   set mod [getArrayKey arr [string trimright $mod /] $icase]

if {$mod ne {} && [info exists arr($mod)]} {
      set match $mod
   } else {
      set mlist {}
      foreach elt [array names arr] {
         if {[modEq $name $elt]} {
            lappend mlist $elt
         }
      }
      # must have a default part of result even if only one result
      if {[llength $mlist] >= 1} {
         # get corresponding icase parent directory
         set pname [getArrayKey arr $modname $icase]
         if {[info exists arr($pname)]} {
            set dfl $pname/[lindex $arr($pname) 1]
         }
         # resolve symbolic version entries
         foreach elt $mlist {
            if {[lindex $arr($elt) 0] eq {version}} {
               lappend mrlist [lindex $arr($elt) 1]
            } else {
               lappend mrlist $elt
            }
         }
         if {[info exists dfl] && [isInList $mrlist $dfl]} {
            set match $dfl
         } else {
            # raise error as no default part of result
            upvar retlist retlist
            set retlist [list {} $name none "No default version\
               defined for '$name'"]
         }
      }
   }
   if {[info exists match]} {
      reportDebug "key '$match' in array '$arrname' matches '$name'"
      set name $match
   }
   return $name
}

# split string while ignore any separator character that is espaced
proc psplit {str sep} {
   # use standard split if no sep character found
   if {[string first \\$sep $str] == -1} {
      set res [split $str $sep]
   } else {
      set previdx -1
      set idx [string first $sep $str]
      while {$idx != -1} {
         # look ahead if found separator is escaped
         if {[string index $str [expr {$idx-1}]] ne "\\"} {
            # unescape any separator character when adding to list
            lappend res [charUnescaped [string range $str [expr {$previdx+1}]\
               [expr {$idx-1}]] $sep]
            set previdx $idx
         }
         set idx [string first $sep $str [expr {$idx+1}]]
      }

lappend res [charUnescaped [string range $str [expr {$previdx+1}] end]\
         $sep]
   }

return $res
}

# join list while escape any character equal to separator
proc pjoin {lst sep} {
   # use standard join if no sep character found
   if {[string first $sep $lst] == -1} {
      set res [join $lst $sep]
   } else {
      set res {}
      foreach elt $lst {
         # preserve empty entries
         if {[info exists not_first]} {
            append res $sep
         } else {
            set not_first 1
         }
         # escape any separator character when adding to string
         append res [charEscaped $elt $sep]
      }
   }

return $res
}

# Dictionary-style string comparison
# Use dictionary sort of lsort proc to compare two strings in the "string
# compare" fashion (returning -1, 0 or 1). Tcl dictionary-style comparison
# enables to compare software versions (ex: "1.10" is greater than "1.8")
proc compareVersion {str1 str2} {
   if {$str1 eq $str2} {
      return 0
   # put both strings in a list, then lsort it and get first element
   } elseif {[lindex [lsort -dictionary [list $str1 $str2]] 0] eq $str1} {
      return -1
   } else {
      return 1
   }
}

# Is provided string a version number: consider first element of string if
# '.' character used in it. [0-9af] on this first part is considered valid
# anything else could be used in latter elements
proc isVersion {str} {
   return [string is xdigit -strict [lindex [split $str .] 0]]
}

# Return number of occurences of passed character in passed string
proc countChar {str char} {
   return [expr {[string length $str] - [string length [string map [list\
      $char {}] $str]]}]
}

# provide a lreverse proc for Tcl8.4 and earlier
if {[info commands lreverse] eq {}} {
   proc lreverse {l} {
      set r [list]
      for {set i [expr {[llength $l] - 1}]} {$i >= 0} {incr i -1} {
         lappend r [lindex $l $i]
      }
      return $r
   }
}

# provide a lassign proc for Tcl8.4 and earlier
if {[info commands lassign] eq {}} {
   proc lassign {values args} {
      uplevel 1 [list foreach $args [linsert $values end {}] break]
      lrange $values [llength $args] end
   }
}

proc isInList {lst elt} {
   return [expr {[lsearch -exact $lst $elt] != -1}]
}

proc notInList {lst elt} {
   return [expr {[lsearch -exact $lst $elt] == -1}]
}

proc appendNoDupToList {lstname args} {
   set ret 0
   upvar $lstname lst
   foreach elt $args {
      if {![info exists lst] || [notInList $lst $elt]} {
         lappend lst $elt
         set ret 1
      }
   }
   return $ret
}

proc replaceFromList {list1 item {item2 {}}} {
    while {[set xi [lsearch -exact $list1 $item]] >= 0} {
       set list1 [if {[string length $item2] == 0} {lreplace $list1 $xi $xi}\
         {lreplace $list1 $xi $xi $item2}]
    }

return $list1
}

# returns elements from list1 not part of list2 and elements from list2 not
# part of list1
proc getDiffBetweenList {list1 list2} {
   set res1 [list]
   set res2 [list]

foreach elt $list1 {
      if {[notInList $list2 $elt]} {
         lappend res1 $elt
      }
   }
   foreach elt $list2 {
      if {[notInList $list1 $elt]} {
         lappend res2 $elt
      }
   }

return [list $res1 $res2]
}

proc parseAccessIssue {modfile} {
   # retrieve and return access issue message
   if {[regexp {POSIX .* \{(.*)\}$} $::errorCode match errMsg]} {
      return "[string totitle $errMsg] on '$modfile'"
   } else {
      return "Cannot access '$modfile'"
   }
}

proc checkValidModule {modfile} {
   reportDebug $modfile

# test file only once, cache result obtained to minimize file query
   return [expr {[info exists ::g_modfileValid($modfile)]\
      ? $::g_modfileValid($modfile)\
      : [set ::g_modfileValid($modfile) [readModuleContent $modfile 1 1 1]]}]
}

# get file modification time, cache it at first query, use cache afterward
proc getFileMtime {fpath} {
   if {[info exists ::g_fileMtime($fpath)]} {
      return $::g_fileMtime($fpath)
   } else {
      return [set ::g_fileMtime($fpath) [file mtime $fpath]]
   }
}

# define proc that will be used as fallback to command provided by extension
# library in case this library is not loaded
proc __readFile {filename {firstline 0}} {
   set fid [open $filename r]
   set fdata [if {$firstline} {gets $fid} {read $fid}]
   close $fid
   return $fdata
}

proc readModuleContent {modfile {report_read_issue 0} {must_have_cookie 1}\
   {only_check_validity 0}} {
   reportDebug $modfile
   set res {}

# read file
   if {[catch {
      if {[info exists ::g_modfileContent($modfile)]} {
         lassign $::g_modfileContent($modfile) fh fdata
      } else {
         # only read beginning of file if just checking validity and not
         # asked to always fully read files
         set fdata [readFile $modfile [expr {$only_check_validity &&\
            ![currentAlwaysReadFullFile]}]]
         # extract magic cookie (first word of modulefile)
         set fh [string trimright [lindex [split [string range $fdata 0 32]]\
            0] #]
         # cache full file read to minimize file operations
         if {!$only_check_validity || [currentAlwaysReadFullFile]} {
            set ::g_modfileContent($modfile) [list $fh $fdata]
         }
      }
   } errMsg ]} {
      if {$report_read_issue} {
         set msg [parseAccessIssue $modfile]
         if {$only_check_validity} {
            set res [list accesserr $msg]
         } else {
            reportError $msg
         }
      }
   } else {
      # check module validity if magic cookie is mandatory
      if {$must_have_cookie && ![string equal -length 8 $fh {#%Module}]} {
         set msg {Magic cookie '#%Module' missing}
         if {$only_check_validity} {
            set res [list invalid $msg]
         } else {
            reportInternalBug $msg $modfile
         }
      # check if min version requirement is met if magic cookie is mandatory
      } elseif {$must_have_cookie && [string length $fh] > 8 &&\
         [compareVersion {4.5.2} [string range $fh 8 end]] <0} {
         set msg "Modulefile requires at least Modules version [string range\
            $fh 8 end]"
         if {$only_check_validity} {
            set res [list invalid $msg]
         } else {
            reportInternalBug $msg $modfile
         }
      } else {
         if {$only_check_validity} {
            # set validity information as result
            set res [list true {}]
         } else {
            # set file content as result
            set res $fdata
         }
      }
   }

return $res
}

# If given module maps to default or other symbolic versions, a list of
# those versions is returned. This takes module/version as an argument.
proc getVersAliasList {mod} {
   if {[info exists ::g_symbolHash($mod)]} {
      set tag_list $::g_symbolHash($mod)
   } else {
      set tag_list {}
   }

reportDebug "'$mod' has tag list '$tag_list'"
   return $tag_list
}

proc doesModuleHaveTag {mod} {
   return [expr {[info exists ::g_symbolHash($mod)]}]
}

# get list of elements located in a directory passed as argument. a flag is
# set after each element to know if it is considered hidden or not. a
# fetch_hidden argument is there to control search of hidden elements. a
# fetch_dotversion argument controls whether .version file should be looked at
# in directory .proc will be used as a fallback to command provided by
# extension library
proc __getFilesInDirectory {dir fetch_hidden fetch_dotversion} {
   set dir_list [list]

# try then catch any issue rather than test before trying
   # workaround 'glob -nocomplain' which does not return permission
   # error on Tcl 8.4, so we need to avoid registering issue if
   # raised error is about a no match
   if {[catch {set elt_list [glob $dir/*]} errMsg]} {
      if {$errMsg eq "no files matched glob pattern \"$dir/*\""} {
         set elt_list {}
      } else {
         # rethrow other error to catch it in caller proc
         error $errMsg $::errorInfo $::errorCode
      }
   }

# Add each element in the current directory to the list
   if {[file readable $dir/.modulerc]} {
      lappend dir_list $dir/.modulerc 0
   }
   if {$fetch_dotversion && [file readable $dir/.version]} {
      lappend dir_list $dir/.version 0
   }
   foreach elt $elt_list {
      lappend dir_list $elt 0
   }

# search for hidden files if asked
   if {$fetch_hidden} {
      foreach elt [glob -nocomplain -types hidden -directory\
         $dir -tails *] {
         switch -- $elt {
            .modulerc - .version - . - .. { }
            default {
               lappend dir_list $dir/$elt 1
            }
         }
      }
   }

return $dir_list
}

# Check a module name does match query at expected depth level when indepth
# search is disabled. Define procedure on the fly to adapt its
# code to indepth configuration option and querydepth and test mode params.
proc defineDoesModMatchAtDepthProc {indepth querydepth test} {
   set procprops $indepth:$querydepth:$test

# define proc if not done yet or if it was defined for another context
   if {[info procs doesModMatchAtDepth] eq {} ||\
      $::g_doesModMatchAtDepth_procprops ne $procprops} {
      if {[info exists ::g_doesModMatchAtDepth_procprops]} {
         rename ::doesModMatchAtDepth {}
      }
      set ::g_doesModMatchAtDepth_procprops $procprops

# define optimized procedure
      if {$indepth} {
         set atdepth {$mod}
      } else {
         set atdepth "\[join \[lrange \[split \$mod /\] 0 $querydepth\] /\]"
      }
      proc doesModMatchAtDepth {mod} "return \[modEqStatic $atdepth $test *\]"
   }
}

# Define procedure to check module version equals pattern. Adapt procedure
# code whether icase and extended_default are enabled or disabled
proc defineModVersCmpProc {icase extdfl} {
   set procname modVersCmpProc
   if {$icase} {
      append procname Icase
   }
   if {$extdfl} {
      append procname Extdfl
   }

# define proc if not done yet or if it was defined for another context
   if {[info procs modVersCmp] eq {} || $::g_modVersCmp_proc ne $procname} {
      if {[info exists ::g_modVersCmp_proc]} {
         rename ::modVersCmp ::$::g_modVersCmp_proc
      }
      rename ::$procname ::modVersCmp
      set ::g_modVersCmp_proc $procname
   }
}

# alternative definitions of modVersCmp proc
proc modVersCmpProc {cmpspec versspec modvers test {psuf {}}} {
   set ret 0
   switch -- $cmpspec {
      in {
         foreach vers $versspec {
            append vers $psuf
            if {$test eq {eqstart}} {
               set ret [string equal -length [string length $vers/] $vers/\
                  $modvers/]
            } else {
               set ret [string $test $vers $modvers]
            }
            if {$ret} {
               break
            }
         }
      }
      ge {
         # as we work here on a version range: psuf suffix is ignored, checks
         # are always extended_default-enabled (as 1.2 includes 1.2.12 for
         # instance) and equal, eqstart and match tests are equivalent
         set ret [expr {[isVersion $modvers] && ([compareVersion $modvers\
            $versspec] != -1 || [string match $versspec.* $modvers])}]
      }
      le {
         # 'ge' comment also applies here
         set ret [expr {[isVersion $modvers] && ([compareVersion $versspec\
            $modvers] != -1 || [string match $versspec.* $modvers])}]
      }
      be {
         # 'ge' comment also applies here
         lassign $versspec lovers hivers
         set ret [expr {[isVersion $modvers] && ([compareVersion $modvers\
            $lovers] != -1 || [string match $lovers.* $modvers]) &&\
            ([compareVersion $hivers $modvers] != -1 || [string match\
            $hivers.* $modvers])}]
      }
   }
   return $ret
}
proc modVersCmpProcIcase {cmpspec versspec modvers test {psuf {}}} {
   set ret 0
   switch -- $cmpspec {
      in {
         foreach vers $versspec {
            append vers $psuf
            if {$test eq {eqstart}} {
               set ret [string equal -nocase -length [string length $vers/]\
                  $vers/ $modvers/]
            } else {
               set ret [string $test -nocase $vers $modvers]
            }
            if {$ret} {
               break
            }
         }
      }
      ge {
         set ret [expr {[isVersion $modvers] && ([compareVersion $modvers\
            $versspec] != -1 || [string match -nocase $versspec.* $modvers])}]
      }
      le {
         set ret [expr {[isVersion $modvers] && ([compareVersion $versspec\
            $modvers] != -1 || [string match -nocase $versspec.* $modvers])}]
      }
      be {
         lassign $versspec lovers hivers
         set ret [expr {[isVersion $modvers] && ([compareVersion $modvers\
            $lovers] != -1 || [string match $lovers.* $modvers]) &&\
            ([compareVersion $hivers $modvers] != -1 || [string match -nocase\
            $hivers.* $modvers])}]
      }
   }
   return $ret
}
proc modVersCmpProcExtdfl {cmpspec versspec modvers test {psuf {}}} {
   set ret 0
   switch -- $cmpspec {
      in {
         foreach vers $versspec {
            append vers $psuf
            if {$test eq {eqstart}} {
               set ret [string equal -length [string length $vers/] $vers/\
                  $modvers/]
            } else {
               set ret [string $test $vers $modvers]
            }
            if {$ret || [string match $vers.* $modvers]} {
               set ret 1
               break
            }
         }
      }
      ge {
         set ret [expr {[isVersion $modvers] && ([compareVersion $modvers\
            $versspec] != -1 || [string match $versspec.* $modvers])}]
      }
      le {
         set ret [expr {[isVersion $modvers] && ([compareVersion $versspec\
            $modvers] != -1 || [string match $versspec.* $modvers])}]
      }
      be {
         lassign $versspec lovers hivers
         set ret [expr {[isVersion $modvers] && ([compareVersion $modvers\
            $lovers] != -1 || [string match $lovers.* $modvers]) &&\
            ([compareVersion $hivers $modvers] != -1 || [string match\
            $hivers.* $modvers])}]
      }
   }
   return $ret
}
proc modVersCmpProcIcaseExtdfl {cmpspec versspec modvers test {psuf {}}} {
   set ret 0
   switch -- $cmpspec {
      in {
         # check if one version in list matches
         foreach vers $versspec {
            append vers $psuf
            if {$test eq {eqstart}} {
               set ret [string equal -nocase -length [string length $vers/]\
                  $vers/ $modvers/]
            } else {
               set ret [string $test -nocase $vers $modvers]
            }
            # try the extended default match
            if {$ret || [string match -nocase $vers.* $modvers]} {
               set ret 1
               break
            }
         }
      }
      ge {
         set ret [expr {[isVersion $modvers] && ([compareVersion $modvers\
            $versspec] != -1 || [string match -nocase $versspec.* $modvers])}]
      }
      le {
         set ret [expr {[isVersion $modvers] && ([compareVersion $versspec\
            $modvers] != -1 || [string match -nocase $versspec.* $modvers])}]
      }
      be {
         lassign $versspec lovers hivers
         set ret [expr {[isVersion $modvers] && ([compareVersion $modvers\
            $lovers] != -1 || [string match $lovers.* $modvers]) &&\
            ([compareVersion $hivers $modvers] != -1 || [string match -nocase\
            $hivers.* $modvers])}]
      }
   }
   return $ret
}

# Setup a hardwire version of modEq procedure called modEqStatic. This
# optimized procedure already knows the module pattern to compare to, whose
# specification has already been resolved at procedure definition time, which
# saves lot of processing time.
proc defineModEqStaticProc {icase extdfl modspec} {
   set procprops $icase:$extdfl:$modspec

# define proc if not done yet or if it was defined for another context
   if {[info procs modEqStatic] eq {} || $::g_modEqStatic_procprops ne\
      $procprops} {
      if {[info exists ::g_modEqStatic_procprops]} {
         rename ::modEqStatic {}
      } else {
         # also define modVersCmp which is called by modEqStatic
         defineModVersCmpProc $icase $extdfl
      }
      set ::g_modEqStatic_procprops $procprops

# define optimized procedure
      lassign [getModuleVersSpec $modspec] pmod pmodname cmpspec versspec\
         pmodnamere pmodescglob
      set nocasearg [expr {$icase ? {-nocase } : {}}]
      set pmodnameslen [string length $pmodname/]
      if {$pmod ne {} || $modspec eq {}} {
         set procbody "
            set pmod {$pmod}
            if {\$psuf ne {}} {
               append pmod \$psuf
            }
            if {\$test eq {eqstart}} {
               set ret \[string equal $nocasearg-length \[string length\
                  \$pmod/\] \$pmod/ \$mod/\]
            } else {
               if {\$test eq {matchin}} {
                  set test match
                  set pmod *\$pmod
               }
               set ret \[string \$test $nocasearg\$pmod \$mod\]
            }"
         if {$extdfl} {
            append procbody "
               if {!\$ret && \[string first / \$pmod\] != -1} {
                  if {\$test eq {match}} {
                     set pmodextdfl \$pmod.*
                  } else {
                     set pmodextdfl {$pmodescglob.*}
                  }
                  set ret \[string match $nocasearg\$pmodextdfl \$mod\]
               }"
         }
      } else {
         set procbody "
            set pmodname {$pmodname}
            set pmodnamere {$pmodnamere}
            if {\$test eq {matchin}} {
               set test match
               if {\$pmodnamere ne {}} {
                  set pmodnamere .*\$pmodnamere
               } else {
                  set pmodnamere {.*$pmodname}
               }
            }
            if {(\$pmodnamere ne {} && \$test eq {match} && \[regexp\
               $nocasearg (^\$pmodnamere)/ \$mod/ rematch pmodname\]) ||\
               \[string equal $nocasearg -length $pmodnameslen {$pmodname/}\
               \$mod/\]} {
               set modvers \[string range \$mod \[string length \$pmodname/\]\
                  end\]
               set ret \[modVersCmp {$cmpspec} {$versspec} \$modvers \$test\
                  \$psuf\]
            } else {
               set ret 0
            }"
      }
      append procbody "
         return \$ret"
      proc modEqStatic {mod {test equal} {psuf {}}} $procbody
   }
}

# Define procedure to check module name equals pattern. Adapt procedure
# code whether icase and extended_default are enabled or disabled
proc defineModEqProc {icase extdfl} {
   set procname modEqProc
   if {$icase} {
      append procname Icase
   }
   if {$extdfl} {
      append procname Extdfl
   }

# define proc if not done yet or if it was defined for another context
   if {[info procs modEq] eq {} || $::g_modEq_proc ne $procname} {
      if {[info exists ::g_modEq_proc]} {
         rename ::modEq ::$::g_modEq_proc
      }
      rename ::$procname ::modEq
      set ::g_modEq_proc $procname
   }

# also define modVersCmp which is called by modEq
   defineModVersCmpProc $icase $extdfl
}

# alternative definitions of modEq proc
proc modEqProc {pattern mod {test equal} {trspec 1} {psuf {}}} {
   # extract specified module name from name and version spec
   if {$trspec} {
      lassign [getModuleVersSpec $pattern] pmod pmodname cmpspec versspec\
         pmodnamere pmodescglob
   } else {
      set pmod $pattern
   }
   # specified module can be translated in a simple mod name/vers or is empty
   if {$pmod ne {} || $pattern eq {}} {
      if {$psuf ne {}} {
         append pmod $psuf
      }
      if {$test eq {eqstart}} {
         set ret [string equal -length [string length $pmod/] $pmod/ $mod/]
      } else {
         # contains test
         if {$test eq {matchin}} {
            set test match
            set pmod *$pmod
         }
         set ret [string $test $pmod $mod]
      }
   } else {
      # contains test
      if {$test eq {matchin}} {
         set test match
         if {$pmodnamere ne {}} {
            set pmodnamere .*$pmodnamere
         } else {
            set pmodnamere .*$pmodname
         }
      }
      # for more complex specification, first check if module name matches
      # use a regexp test if module name contains wildcard characters
      if {($pmodnamere ne {} && $test eq {match} && [regexp (^$pmodnamere)/\
         $mod/ rematch pmodname]) || [string equal -length [string length\
         $pmodname/] $pmodname/ $mod/]} {
         # then compare versions
         set modvers [string range $mod [string length $pmodname/] end]
         set ret [modVersCmp $cmpspec $versspec $modvers $test $psuf]
      } else {
         set ret 0
      }
   }
   return $ret
}
proc modEqProcIcase {pattern mod {test equal} {trspec 1} {psuf {}}} {
   if {$trspec} {
      lassign [getModuleVersSpec $pattern] pmod pmodname cmpspec versspec\
         pmodnamere pmodescglob
   } else {
      set pmod $pattern
   }
   if {$pmod ne {} || $pattern eq {}} {
      if {$psuf ne {}} {
         append pmod $psuf
      }
      if {$test eq {eqstart}} {
         set ret [string equal -nocase -length [string length $pmod/] $pmod/\
            $mod/]
      } else {
         # contains test
         if {$test eq {matchin}} {
            set test match
            set pmod *$pmod
         }
         set ret [string $test -nocase $pmod $mod]
      }
   } else {
      # contains test
      if {$test eq {matchin}} {
         set test match
         if {$pmodnamere ne {}} {
            set pmodnamere .*$pmodnamere
         } else {
            set pmodnamere .*$pmodname
         }
      }
      # for more complex specification, first check if module name matches
      # use a regexp test if module name contains wildcard characters
      if {($pmodnamere ne {} && $test eq {match} && [regexp -nocase\
         (^$pmodnamere)/ $mod/ rematch pmodname]) || [string equal -nocase\
         -length [string length $pmodname/] $pmodname/ $mod/]} {
         # then compare versions
         set modvers [string range $mod [string length $pmodname/] end]
         set ret [modVersCmp $cmpspec $versspec $modvers $test $psuf]
      } else {
         set ret 0
      }
   }
   return $ret
}
proc modEqProcExtdfl {pattern mod {test equal} {trspec 1} {psuf {}}} {
   if {$trspec} {
      lassign [getModuleVersSpec $pattern] pmod pmodname cmpspec versspec\
         pmodnamere pmodescglob
   } else {
      set pmod $pattern
   }
   if {$pmod ne {} || $pattern eq {}} {
      if {$psuf ne {}} {
         append pmod $psuf
      }
      if {$test eq {eqstart}} {
         set ret [string equal -length [string length $pmod/] $pmod/ $mod/]
      } else {
         # contains test
         if {$test eq {matchin}} {
            set test match
            set pmod *$pmod
         }
         set ret [string $test $pmod $mod]
      }
      # try the extended default match if not root module
      if {!$ret && [string first / $pmod] != -1} {
         if {$test eq {match}} {
            set pmodextdfl $pmod.*
         } else {
            set pmodextdfl $pmodescglob.*
         }
         set ret [string match $pmodextdfl $mod]
      }
   } else {
      # contains test
      if {$test eq {matchin}} {
         set test match
         if {$pmodnamere ne {}} {
            set pmodnamere .*$pmodnamere
         } else {
            set pmodnamere .*$pmodname
         }
      }
      # for more complex specification, first check if module name matches
      # use a regexp test if module name contains wildcard characters
      if {($pmodnamere ne {} && $test eq {match} && [regexp (^$pmodnamere)/\
         $mod/ rematch pmodname]) || [string equal -length [string length\
         $pmodname/] $pmodname/ $mod/]} {
         # then compare versions
         set modvers [string range $mod [string length $pmodname/] end]
         set ret [modVersCmp $cmpspec $versspec $modvers $test $psuf]
      } else {
         set ret 0
      }
   }
   return $ret
}
proc modEqProcIcaseExtdfl {pattern mod {test equal} {trspec 1} {psuf {}}} {
   if {$trspec} {
      lassign [getModuleVersSpec $pattern] pmod pmodname cmpspec versspec\
         pmodnamere pmodescglob
   } else {
      set pmod $pattern
   }
   if {$pmod ne {} || $pattern eq {}} {
      if {$psuf ne {}} {
         append pmod $psuf
      }
      if {$test eq {eqstart}} {
         set ret [string equal -nocase -length [string length $pmod/] $pmod/\
            $mod/]
      } else {
         # contains test
         if {$test eq {matchin}} {
            set test match
            set pmod *$pmod
         }
         set ret [string $test -nocase $pmod $mod]
      }
      # try the extended default match if not root module
      if {!$ret && [string first / $pmod] != -1} {
         if {$test eq {match}} {
            set pmodextdfl $pmod.*
         } else {
            set pmodextdfl $pmodescglob.*
         }
         set ret [string match -nocase $pmodextdfl $mod]
      }
   } else {
      # contains test
      if {$test eq {matchin}} {
         set test match
         if {$pmodnamere ne {}} {
            set pmodnamere .*$pmodnamere
         } else {
            set pmodnamere .*$pmodname
         }
      }
      # for more complex specification, first check if module name matches
      # use a regexp test if module name contains wildcard characters
      if {($pmodnamere ne {} && $test eq {match} && [regexp -nocase\
         (^$pmodnamere)/ $mod/ rematch pmodname]) || [string equal -nocase\
         -length [string length $pmodname/] $pmodname/ $mod/]} {
         # then compare versions
         set modvers [string range $mod [string length $pmodname/] end]
         set ret [modVersCmp $cmpspec $versspec $modvers $test $psuf]
      } else {
         set ret 0
      }
   }
   return $ret
}

# check if an existing findModules cache entry matches current search by
# evaluating search ids. if an exact match cannot be found, look at saved
# searches that contains current search (superset of looked elements), extra
# elements will be filtered-out by GetModules
proc findModulesInMemCache {searchid} {
   # exact same search is cached
   if {[info exists ::g_foundModulesMemCache($searchid)]} {
      set match_searchid $searchid
      set mod_list $::g_foundModulesMemCache($searchid)
   # look for a superset search
   } else {
      set match_searchid {}
      set mod_list {}
      foreach cacheid [array names ::g_foundModulesMemCache] {
         # cache id acts as pattern to check if it contains current search
         if {[string match $cacheid $searchid]} {
            set match_searchid $cacheid
            set mod_list $::g_foundModulesMemCache($cacheid)
            break
         }
      }
   }

return [list $match_searchid $mod_list]
}

# finds all module-related files matching mod in the module path dir
proc findModules {dir mod depthlvl fetch_mtime fetch_hidden} {
   reportDebug "finding '$mod' in $dir (depthlvl=$depthlvl,\
      fetch_mtime=$fetch_mtime, fetch_hidden=$fetch_hidden)"

# generated search id (for cache search/save) by compacting given args
   set searchid $dir:$mod:$depthlvl:$fetch_mtime:$fetch_hidden

# look at memory cache for a compatible result
   lassign [findModulesInMemCache $searchid] cache_searchid cache_list
   if {$cache_searchid ne {}} {
      reportDebug "use cache entry '$cache_searchid'"
      return $cache_list
   }

defineModEqStaticProc [isIcase] [getConf extended_default] $mod

# skip search in top dir if directly looking to a deep element, which means
   # findModules has already been called and top dir has already been analyzed
   if {[file dirname $mod] eq {.}} {
      # use catch protection to handle non-readable and non-existent dir
      if {[catch {
         set full_list {}
         foreach {fpelt hid} [getFilesInDirectory $dir $fetch_hidden 0] {
            set elt [file tail $fpelt]
            # include any .modulerc file found at the modulepath root
            if {$elt eq {.modulerc} || $mod eq {} || [modEqStatic $elt\
               match]} {
               lappend full_list $fpelt
            }
         }
      }]} {
         return {}
      }
   } else {
      lappend full_list [file join $dir $mod]
   }
   foreach igndir [getConf ignored_dirs] {
      set ignored_dirs($igndir) 1
   }
   array set mod_list {}
   for {set i 0} {$i < [llength $full_list]} {incr i 1} {
      set element [lindex $full_list $i]
      set tag_list {}

set tail [file tail $element]
      set modulename [getModuleNameFromModulepath $element $dir]
      set parentname [file dirname $modulename]
      set moddepthlvl [llength [file split $modulename]]
      if {[file isdirectory $element]} {
         if {![info exists ignored_dirs($tail)]} {
            if {[catch {
               set elt_list [getFilesInDirectory $element $fetch_hidden 1]
            } errMsg]} {
               set mod_list($modulename) [list accesserr [parseAccessIssue\
                  $element] $element]
            } else {
               # Add each element in the current directory to the list
               foreach {fpelt hid} $elt_list {
                  lappend full_list $fpelt
                  # Flag hidden files
                  if {$hid} {
                     set hidden_list($fpelt) 1
                  }
               }
            }
         }
      } else {
         switch -glob -- $tail {
            .modulerc {
               set mod_list($modulename) [list modulerc]
            }
            .version {
               # skip .version file from different depth level than search
               # targets if no in depth mode is enabled
               if {$depthlvl == 0 || $moddepthlvl == $depthlvl} {
                  set mod_list($modulename) [list modulerc]
               }
            }
            *~ - *,v - \#*\# { }
            default {
               # skip modfile in no in depth mode search if it does not relate
               # to targeted depth level and one valid modfile has already be
               # found for the dirs lying at other depth level
               if {$depthlvl == 0 || $moddepthlvl == $depthlvl || ![info\
                  exists modfile_indir($parentname)]} {
                  lassign [checkValidModule $element] check_valid check_msg
                  switch -- $check_valid {
                     true {
                        set mtime [expr {$fetch_mtime ? [getFileMtime\
                           $element] : {}}]
                        set mod_list($modulename) [list modulefile $mtime\
                           $element]

# a valid modfile has been found in directory
                        if {!$fetch_hidden || ![info exists\
                           hidden_list($element)]} {
                           set modfile_indir($parentname) 1
                        }
                     }
                     default {
                        # register check error and relative message to get it
                        # in case of direct access of this module element, but
                        # no registering in parent directory structure as
                        # element is not valid
                        set mod_list($modulename) [list $check_valid\
                           $check_msg $element]
                     }
                  }
               }
            }
         }
      }
   }

reportDebug "found [array names mod_list]"

# cache search results
   reportDebug "create cache entry '$searchid'"
   set found_list [array get mod_list]
   set ::g_foundModulesMemCache($searchid) $found_list

return $found_list
}

proc getModules {dir {mod {}} {fetch_mtime 0} {search {}} {fetch_hidden 0}\
   {filter {}}} {
   global g_sourceAlias g_sourceVersion g_sourceVirtual g_resolvedPath
   global g_rcAlias g_moduleAlias g_rcVersion g_moduleVersion
   global g_rcVirtual g_moduleVirtual g_rcfilesSourced

reportDebug "get '$mod' in $dir (fetch_mtime=$fetch_mtime, search=$search,\
      fetch_hidden=$fetch_hidden, filter=$filter)"

# generated search id (for cache search/save) by compacting given args
   set searchid $dir:$mod:$fetch_mtime:$search:$fetch_hidden:$filter

# look at memory cache for a compatible result
   if {[info exists ::g_gotModulesMemCache($searchid)]} {
      reportDebug "use cache entry '$searchid'"
      return $::g_gotModulesMemCache($searchid)
   }

# extract one module name from query
   set modqe [getOneModuleFromVersSpec $mod]

# perform an in depth search or not
   set indepth [expr {[isInList $search noindepth] ? 0 : 1}]

# set a default if none defined on directory entries
   set implicitdfl [getConf implicit_default]

# automatically define latest and default sym for all modules
   set autosymbol [expr {$implicitdfl && [getConf advanced_version_spec]}]

# match passed name against any part of avail module names
   set contains [expr {[isInList $search contains] ? 1 : 0}]
   set mtest [expr {$contains ? {matchin} : {match}}]

set icase [isIcase]

set wild [expr {[isInList $search wild] ? 1 : 0}]

# will only keep default or latest elts in the end or remove plain dirs
   set filtering [expr {$filter eq {noplaindir}}]
   set keeping [expr {!$filtering && $filter ne {}}]

# check search query string corresponds to directory
   set querydir [string trimright $modqe *]
   set isquerydir [expr {[string index $querydir end] eq {/}}]
   set querydir [string range $querydir 0 end-1]
   set querydepth [countChar $modqe /]

# if search for global or user rc alias only, no dir lookup is performed
   # and aliases from g_rcAlias are returned
   if {[isInList $search rc_alias_only]} {
      set add_rc_defs 1
      array set found_list {}
   } else {
      # find modules by (1) searching with first path element if mod is a deep
      # modulefile (elt1/etl2/vers) in order to catch all .modulerc and
      # .version files of module-related parent directories in case we need
      # to translate an alias or a version (2) retrieving all elements first
      # to then look at fully qualified file names containing searched string
      set parentlist [split $modqe /]

if {$contains} {
         set findmod *
      } else {
         set findmod [lindex $parentlist 0]
         # if searched mod is an empty or flat element append wildcard character
         # to match anything starting with mod
         if {$wild && [llength $parentlist] <= 1} {
            append findmod *
         }
      }

# add alias/version definitions from global or user rc to result
      set add_rc_defs [expr {[isInList $search rc_defs_included] ? 1 : 0}]
      if {!$fetch_hidden} {
         set fetch_hidden [isModuleSpecHidden $mod]
         reportDebug "is '$mod' requiring hidden search ($fetch_hidden)"
      }

# if no indepth mode search, pass the depth level of the search query
      set depthlvl [expr {$indepth ? 0 : [llength $parentlist]}]

array set found_list [findModules $dir $findmod $depthlvl $fetch_mtime\
         $fetch_hidden]
   }

# Phase #1: consolidate every kind of entries (directory, modulefile,
   # symbolic version, alias and virtual module) in found_list

# define module name and version comparison procs
   defineModEqStaticProc $icase [getConf extended_default] $mod

array set err_list {}
   array set hversmod_nosearch {}
   array set dflvers_nosearch {}

foreach elt [lsort [array names found_list]] {
      switch -- [lindex $found_list($elt) 0] {
         modulerc {
            # process rc files them remove them from found_list
            if {![info exists g_rcfilesSourced($dir/$elt)]} {
               execute-modulerc $dir/$elt $elt $elt
               # Keep track of already sourced rc files not to run them again
               set g_rcfilesSourced($dir/$elt) 1
            }
            unset found_list($elt)
         }
         modulefile {
         }
         default {
            # flag entries with error
            set err_list($elt) 1
         }
      }
   }

# add all versions found when parsing .version or .modulerc files in this
   # directory (skip versions not registered from this directory except if
   # global or user rc definitions should be included))
   foreach vers [array names g_moduleVersion] {
      set versmod $g_moduleVersion($vers)
      if {($dir ne {} && [string first $dir/ $g_sourceVersion($vers)] == 0)\
         || ($add_rc_defs && [info exists g_rcVersion($vers)])} {
         set found_list($vers) [list version $versmod]

# look for hidden target if not searched yet and if symbolic version
         # matches passed $mod
         if {![info exists found_list($versmod)] && !$fetch_hidden &&\
            [isModuleHidden $versmod]} {
            if {[modEqStatic $vers]} {
               array set found_list [findModules $dir $versmod 0\
                  $fetch_mtime 1]
            } else {
               # record hidden target not searched
               set hversmod_nosearch($versmod) 1
               # record default version target has not been searched
               if {[file tail $vers] eq {default}} {
                  set dflvers_nosearch($vers) $versmod
               }
            }
         }
      }
   }

# add aliases found when parsing .version or .modulerc files in this
   # directory (skip aliases not registered from this directory except if
   # global or user rc definitions should be included)
   foreach alias [array names g_moduleAlias] {
      if {($dir ne {} && [string first $dir/ $g_sourceAlias($alias)] == 0)\
         || ($add_rc_defs && [info exists g_rcAlias($alias)])} {
         set found_list($alias) [list alias $g_moduleAlias($alias)]
      }
   }

# add virtual mods found when parsing .version or .modulerc files in this
   # directory (skip virtual mods not registered from this directory except if
   # global or user rc definitions should be included)
   foreach virt [array names g_moduleVirtual] {
      if {($dir ne {} && [string first $dir/ $g_sourceVirtual($virt)] == 0)\
         || ($add_rc_defs && [info exists g_rcVirtual($virt)])} {
         lassign [checkValidModule $g_moduleVirtual($virt)] check_valid\
            check_msg
         switch -- $check_valid {
            true {
               set mtime [expr {$fetch_mtime ? [getFileMtime\
                  $g_moduleVirtual($virt)] : {}}]
               # set mtime at index 1 like a modulefile entry
               set found_list($virt) [list virtual $mtime\
                  $g_moduleVirtual($virt)]
            }
            default {
               # register check error and relative message to get it in
               # case of direct access of this module element
               set found_list($virt) [list $check_valid $check_msg\
                  $g_moduleVirtual($virt)]
               set err_list($virt) 1
            }
         }
      }
   }

# Phase #2: filter-out dynamically hidden or expired elements

# Phase #3: elaborate directory content with default element selection

array set dir_list {}
   array set hid_list {}
   array set autosym_list {}

# build list of elements contained in each directory
   foreach elt [array names found_list] {
      # track hidden entries
      if {[string index [file tail $elt] 0] eq {.}} {
         set hid_list($elt) 1
      }

# add a ref to element in its parent directory unless element has error,
      # is a symbolic version (whose target has been searched if default) or
      # search of hidden files is disabled and element is an hidden file then
      # recursively add parent element until reaching top directory
      if {![info exists err_list($elt)] && ([lindex $found_list($elt) 0] ne\
         {version} || [info exists dflvers_nosearch($elt)]) && ($fetch_hidden\
         || ![info exists hid_list($elt)])} {
         # change to default version target if this target has not been
         # searched to ensure definition of directory
         if {[info exists dflvers_nosearch($elt)]} {
            set elt $dflvers_nosearch($elt)
         }
         set direlt $elt
         while {[set pardir [file dirname $direlt]] ne {.}} {
            appendNoDupToList dir_list($pardir) [file tail $direlt]
            set direlt $pardir
         }
      }
   }

# determine default element for each directory and record sorted elt list
   # unless if an alias or a virtual module has overwritten directory entry
   foreach elt [array names dir_list] {
      if {![info exists found_list($elt)]} {
         set dir_list($elt) [lsort -dictionary $dir_list($elt)]
         # get default element: explicitely defined default (whether it exists
         # or is in error) or implicit default if enabled
         if {[info exists g_resolvedPath($elt)]} {
            set dfl [file tail $g_resolvedPath($elt)]
         } elseif {$implicitdfl} {
            set dfl [lindex $dir_list($elt) end]
         } else {
            set dfl {}
         }
         # record directory properties
         set found_list($elt) [concat [list directory $dfl] $dir_list($elt)]

# automatically define symbols for all modules if these names do not
         # exist yet
         if {$autosymbol} {
            if {![info exists found_list($elt/default)]} {
               set found_list($elt/default) [list version $elt/$dfl]
               set autosym_list($elt/default) 1
               setModuleResolution $elt/default $elt/$dfl default 1 1
            }
            if {![info exists found_list($elt/latest)]} {
               set lat [lindex $dir_list($elt) end]
               set found_list($elt/latest) [list version $elt/$lat]
               set autosym_list($elt/latest) 1
               setModuleResolution $elt/latest $elt/$lat latest 1 1
            }
         }
      }
   }

# Phase #4: filter results to keep those matching search query

# define module name and version comparison procs
   defineDoesModMatchAtDepthProc $indepth $querydepth $mtest
   defineModEqProc $icase [getConf extended_default]
   defineModEqStaticProc $icase [getConf extended_default] $mod

array set mod_list {}
   array set fdir_list {}
   array set keep_list {}

# keep element matching query, also add directory to result if query name
   # finishes with trailing slash; only keep hidden elements if they should be
   # included in the results or if they fully match query; only keep auto syms
   # if fully matched or version not specified in query
   foreach elt [array names found_list] {
      set elt_type [lindex $found_list($elt) 0]
      if {(($wild && [doesModMatchAtDepth $elt]) || (!$wild && ([modEqStatic\
         $elt match /*] || [modEqStatic $elt match])) || ($isquerydir &&\
         $elt_type eq {directory} && [modEq $querydir $elt match 0])) &&\
         ($fetch_hidden || ![info exists hid_list($elt)] || [modEqStatic\
         $elt]) && (![info exists autosym_list($elt)] || ([countChar $elt /]\
         != $querydepth && !$contains) || [modEqStatic $elt]) && ![info\
         exists mod_list($elt)]} {
         if {$elt_type eq {directory}} {
            # add matching directory to the result list, its entries will be
            # computed in a second time and directory will be dropped if it
            # has no entry in the end
            set mod_list($elt) [list directory]
            # add dir to the filter dir list to enable its removal in next
            # step if dir is empty
            if {![info exists fdir_list($elt)]} {
               set fdir_list($elt) {}
            }
         } else {
            set mod_list($elt) $found_list($elt)
         }

# version may matches query but not its target, so it should be in
         # this case manually added to result (if it exists)
         if {$elt_type eq {version}} {
            set versmod [lindex $mod_list($elt) 1]
            # add target to dir struct (not version) if not already recorded
            set direlt .

# recursively add targets to result (process directory content if
            # target is a directory
            set tgt_list [list $versmod]
            for {set i 0} {$i < [llength $tgt_list]} {incr i} {
               set tgt [lindex $tgt_list $i]

if {![info exists mod_list($tgt)]} {
                  if {[info exists found_list($tgt)]} {
                     set mod_list($tgt) $found_list($tgt)
                     # version target is directory: recursively add content
                     if {[lindex $mod_list($tgt) 0] eq {directory}} {
                        foreach tgtelt $dir_list($tgt) {
                           lappend tgt_list $tgt/$tgtelt
                        }
                        # add dir to the filter dir list to enable its removal
                        # in next step if dir is empty
                        if {![info exists fdir_list($tgt)]} {
                           set fdir_list($tgt) {}
                        }
                     }
                  }

# record target in dir struct if part of found elts or not
                  # searched (this to avoid dir removal if no other elt in it)
                  # but should not be in error or hidden
                  if {([info exists found_list($tgt)] || [info exists\
                     hversmod_nosearch($tgt)]) && ![info exists\
                     err_list($tgt)] && ![info exists hid_list($tgt)]} {
                     if {$i == 0} {
                        set direlt $tgt
                     } else {
                        lappend fdir_list([file dirname $tgt]) [file tail\
                           $tgt]
                     }
                  }
               }
            }
         # skip adding element to directory content if in error or hidden
         } elseif {[info exists err_list($elt)] || [info exists\
            hid_list($elt)]} {
            set direlt .
         } else {
            set direlt $elt
         }

# track directory content, as directory are also reported to their
         # parent directory the directory structure is also tracked
         if {[set pardir [file dirname $direlt]] ne {.}} {
            lappend fdir_list($pardir) [file tail $direlt]
         # track top level entries that will be kept if result is filtered
         } elseif {$keeping && $direlt ne {.} && $elt_type ne {directory}} {
            set keep_list($elt) 1
         }
      }
   }

# determine default element for each directory and record sorted element
   # list unless directory entry has been overwritten by a different module
   # kind or unless only matching directory should be part of result
   foreach elt [lsort -decreasing [array names fdir_list]] {
      if {[lindex $found_list($elt) 0] eq {directory} && ([info exists\
         mod_list($elt)] || $keeping)} {
         set fdir_list($elt) [lsort -dictionary $fdir_list($elt)]
         # get default element: explicitely defined default if included in
         # result or not found or implicit default if enabled
         if {[info exists g_resolvedPath($elt)] && ([info exists\
            mod_list($g_resolvedPath($elt))] || ![info exists\
            found_list($g_resolvedPath($elt))])} {
            set dfl [file tail $g_resolvedPath($elt)]
         } elseif {$implicitdfl} {
            set dfl [lindex $fdir_list($elt) end]
         } else {
            set dfl {}
         }
         # remove empty dirs
         if {[llength $fdir_list($elt)] == 0} {
            unset mod_list($elt)
            unset fdir_list($elt)
            # remove unset dir reference in parent directory. parent dir
            # will be treated after unset dir (due to decreasing sort) if it
            # needs to get in turn unset
            if {[set pardir [file dirname $elt]] ne {.}} {
               set fdir_list($pardir) [replaceFromList $fdir_list($pardir)\
                  [file tail $elt]]
            }
         } else {
            # record directory properties
            set mod_list($elt) [concat [list directory $dfl] $fdir_list($elt)]

# list elements to keep for filtering step
            if {$keeping} {
               if {$filter eq {onlylatest}} {
                  set keepelt $elt/[lindex $fdir_list($elt) end]
               } elseif {$dfl ne {}} {
                  set keepelt $elt/$dfl
               } else {
                  set keepelt {}
               }

# keep directory if its element depth is deeper than query
               if {!$indepth && [countChar $keepelt /] > $querydepth} {
                  set keep_list($elt) 1
               # otherwise only keep existing modules (not directories)
               } elseif {[info exists mod_list($keepelt)] && [lindex\
                  $mod_list($keepelt) 0] ne {directory}} {
                  set keep_list($keepelt) 1
               }
            # when noplaindir filtering, only keep dirs with tags when indepth
            # enabled or if correponds to query depth when indepth disabled
            } elseif {$filtering && $filter eq {noplaindir} &&\
               (($indepth && ![doesModuleHaveTag $elt]) || (!$indepth &&\
               [countChar $elt /] != $querydepth))} {
               unset mod_list($elt)
            }
         }
      }
   }

# now all matching modulefiles are settled, only keep those found at search
   # query depth level if 'noindepth' mode asked
   if {!$indepth} {
      # remove entries with more filename path separator than query pattern
      foreach elt [array names mod_list] {
         if {[countChar $elt /] > $querydepth} {
            unset mod_list($elt)
         }
      }
   }

# if result should be filtered, only keep marked elements
   if {$keeping} {
      foreach elt [array names mod_list] {
         if {![info exists keep_list($elt)]} {
            unset mod_list($elt)
         }
      }
   }

reportDebug "got [array names mod_list]"

# cache search results
   reportDebug "create cache entry '$searchid'"
   set got_list [array get mod_list]
   set ::g_gotModulesMemCache($searchid) $got_list

return $got_list
}

# format an element with its tags for display in a list
proc formatListEltToDisplay {elt eltsgr eltsuffix tag_list tagsgr show_tags\
   sgrdef {matchmap {}}} {
   set disp $elt$eltsuffix
   # hightlight matching substring
   if {$matchmap ne {}} {
      set dispsgr [sgr $eltsgr [string map $matchmap $elt]]
   } else {
      set dispsgr [sgr $eltsgr $elt]
   }
   if {$show_tags} {
      # display default tag graphically over element name
      if {[set defidx [lsearch -exact $tag_list default]] != -1 && $sgrdef} {
         set tag_list [lreplace $tag_list $defidx $defidx]
         set dispsgr [sgr de $dispsgr]
      }

# format remaining tag list
      if {[llength $tag_list] > 0} {
         append disp "([join $tag_list :])"
         set tagssgr [sgr se (]
         foreach tag $tag_list {
            if {![info exists colonsgr]} {
               set colonsgr [sgr se :]
            } else {
               append tagssgr $colonsgr
            }
            append tagssgr [sgr $tagsgr $tag]
         }
         append tagssgr [sgr se )]
         append dispsgr $eltsuffix$tagssgr
      } else {
         append dispsgr $eltsuffix
      }
   } else {
      append dispsgr $eltsuffix
   }
   return [list $disp $dispsgr]
}

# format an element with its tags for a long/detailled display in a list
proc formatListEltToLongDisplay {elt eltsgr eltsuffix tag_list tagsgr mtime\
   sgrdef {matchmap {}}} {
   set disp $elt$eltsuffix
   set displen [string length $disp]
   # hightlight matching substring
   if {$matchmap ne {}} {
      set dispsgr [sgr $eltsgr [string map $matchmap $elt]]
   } else {
      set dispsgr [sgr $eltsgr $elt]
   }
   # display default tag graphically over element name
   if {[set defidx [lsearch -exact $tag_list default]] != -1 && $sgrdef} {
      set tag_list [lreplace $tag_list $defidx $defidx]
      set dispsgr [sgr de $dispsgr]
   }
   # format remaining tag list
   if {[llength $tag_list] > 0} {
      set tagslen [string length [join $tag_list :]]
      foreach tag $tag_list {
         if {![info exists colonsgr]} {
            set colonsgr [sgr se :]
         } else {
            append tagssgr $colonsgr
         }
         append tagssgr [sgr $tagsgr $tag]
      }
   } else {
      set tagssgr {}
      set tagslen 0
   }
   set nbws1 [expr {40 - $displen}]
   set nbws2 [expr {20 - $tagslen + [expr {$nbws1 < 0 ? $nbws1 : 0}]}]
   return [list $disp $dispsgr$eltsuffix[string repeat { }\
      $nbws1]$tagssgr[string repeat { } $nbws2]$mtime]
}

proc formatArrayValToJson {vallist} {
   return [expr {[llength $vallist] > 0 ? "\[ \"[join $vallist {", "}]\" \]"\
      : {[]}}]
}

# format an element with its tags for a json display in a list
proc formatListEltToJsonDisplay {elt args} {
   set disp "\"$elt\": \{ \"name\": \"$elt\""
   foreach {key vtype val} $args {
      append disp ", \"$key\": "
      append disp [expr {$vtype eq {a} ? [formatArrayValToJson $val] :\
         "\"$val\""}]
   }
   append disp "\}"

return $disp
}

# Prepare a map list to translate later on a substring in its highlighted
# counterpart. Translate substring into all module it specifies in case of an
# advanced version specification. Each string obtained is right trimmed from
# wildcard. No highlight is set for strings still containing wildcard chars
# after right trim operation. No highlist map is returned at all if hightlight
# rendering is disabled.
proc prepareMapToHightlightSubstr {substr} {
   set maplist {}
   if {[sgr hi {}] ne {}} {
      foreach m [getAllModulesFromVersSpec $substr] {
         set m [string trimright $m {*?}]
         if {$m ne {} && [string first * $m] == -1 && [string first ? $m] ==\
            -1} {
            lappend maplist $m [sgr hi $m]
         }
      }
   }
   return $maplist
}

# Finds all module versions for mod in the module path dir
proc listModules {dir mod show_mtime filter search} {
   set flag_default_dir [getConf avail_report_dir_sym] ;# Report default dirs
   set flag_default_mf [getConf avail_report_mfile_sym] ;# Report modfile syms

reportDebug "get '$mod' in $dir (show_mtime=$show_mtime, filter=$filter,\
      search=$search)"

# get module list
   # process full dir content but do not exit when err raised from a modulerc.
   array set mod_list [getModules $dir $mod $show_mtime $search 0 $filter]

# output is JSON format
   set json [isReportFormat json]

# prepare results for display
   set alias_colored [expr {[sgr al {}] ne {}}]
   set default_colored [expr {[sgr de {}] ne {}}]
   set matchmap [prepareMapToHightlightSubstr $mod]
   set clean_list {}
   foreach elt [array names mod_list] {
      set tag_list [getVersAliasList $elt]
      set dispsgr {}
      # ignore "version" entries as symbolic version are treated
      # along to their relative modulefile not independently
      switch -- [lindex $mod_list($elt) 0] {
         directory {
            if {$json} {
               set dispsgr [formatListEltToJsonDisplay $elt type s directory\
                  symbols a $tag_list]
            } elseif {$show_mtime} {
               # append / char after name to clearly indicate this is a dir
               lassign [formatListEltToLongDisplay $elt di / $tag_list sy {}\
                  $default_colored $matchmap] disp dispsgr
            } else {
               lassign [formatListEltToDisplay $elt di / $tag_list sy\
                  $flag_default_dir $default_colored $matchmap] disp dispsgr
            }
         }
         modulefile - virtual {
            if {$json} {
               set dispsgr [formatListEltToJsonDisplay $elt type s modulefile\
                  symbols a $tag_list pathname s [lindex $mod_list($elt) 2]]
            } elseif {$show_mtime} {
               # add to display file modification time in addition
               # to potential tags
               lassign [formatListEltToLongDisplay $elt {} {} $tag_list sy\
                  [clock format [lindex $mod_list($elt) 1] -format {%Y/%m/%d\
                  %H:%M:%S}] $default_colored $matchmap] disp dispsgr
            } else {
               lassign [formatListEltToDisplay $elt {} {} $tag_list sy\
                  $flag_default_mf $default_colored $matchmap] disp dispsgr
            }
         }
         alias {
            if {$json} {
               set dispsgr [formatListEltToJsonDisplay $elt type s alias\
                  symbols a $tag_list target s [lindex $mod_list($elt) 1]]
            } elseif {$show_mtime} {
               lassign [formatListEltToLongDisplay $elt al " -> [lindex\
                  $mod_list($elt) 1]" $tag_list sy {} $default_colored\
                  $matchmap] disp dispsgr
            } else {
               # add a '@' tag to indicate elt is an alias if not colored
               if {!$alias_colored} {
                  lappend tag_list @
               }
               lassign [formatListEltToDisplay $elt al {} $tag_list sy\
                  $flag_default_mf $default_colored $matchmap] disp dispsgr
            }
         }
      }
      if {$dispsgr ne {}} {
         if {$json} {
            lappend clean_list $dispsgr
         } else {
            lappend clean_list $disp
            set sgrmap($disp) $dispsgr
         }
      }
   }

set len_list {}
   set max_len 0
   if {$json} {
      upvar 0 clean_list display_list
      if {![info exists display_list]} {
         set display_list {}
      }
   } else {
      set display_list {}
      # always dictionary-sort results
      foreach disp [lsort -dictionary $clean_list] {
         # compute display element length list on sorted result
         lappend display_list $sgrmap($disp)
         lappend len_list [set len [string length $disp]]
         if {$len > $max_len} {
            set max_len $len
         }
      }
   }

reportDebug "Returning $display_list"
   return [list $display_list $len_list $max_len]
}

proc showModulePath {} {
   set modpathlist [getModulePathList]
   if {[llength $modpathlist] > 0} {
      report {Search path for module files (in search order):}
      foreach path $modpathlist {
         report "  [sgr mp $path]"
      }
   } else {
      reportWarning {No directories on module search path}
   }
}

proc displayTableHeader {sgrkey args} {
   foreach {title col_len} $args {
      set col "- [sgr $sgrkey $title] "
      append col [string repeat - [expr {$col_len - [string length $title] -\
         3}]]
      lappend col_list $col
   }

report [join $col_list .]
}

proc displaySeparatorLine {{title {}} {sgrkey {}}} {
   set tty_cols [getTtyColumns]
   if {$title eq {}} {
      # adapt length if screen width is very small
      set max_rep 67
      set rep [expr {$tty_cols > $max_rep ? $max_rep : $tty_cols}]
      report [string repeat - $rep]
   } else {
      set len [string length $title]
      # max expr function is not supported in Tcl8.4 and earlier
      if {[set lrep [expr {($tty_cols - $len - 2)/2}]] < 1} {
         set lrep 1
      }
      if {[set rrep [expr {$tty_cols - $len - 2 - $lrep}]] < 1} {
         set rrep 1
      }
      report "[string repeat - $lrep] [sgr $sgrkey $title] [string repeat -\
         $rrep]"
   }
}

# get a list of elements and print them in a column or in a
# one-per-line fashion
proc displayElementList {header sgrkey hstyle one_per_line display_idx\
   display_list {len_list {}} {max_len 0}} {
   set elt_cnt [llength $display_list]
   reportDebug "header=$header, sgrkey=$sgrkey, hstyle=$hstyle,\
      elt_cnt=$elt_cnt, max_len=$max_len, one_per_line=$one_per_line,\
      display_idx=$display_idx"

# end proc if no element are to print
   if {$elt_cnt == 0} {
      return
   }
   # output is JSON format
   set json [isReportFormat json]

# display header if any provided
   if {$header ne {noheader}} {
      if {$json} {
         report "\"$header\": \{"
      } elseif {$hstyle eq {sepline}} {
         displaySeparatorLine $header $sgrkey
      } else {
         report [sgr $sgrkey $header]:
      }
   }

if {$json} {
      set displist [join $display_list ,\n]
   # display one element per line
   } elseif {$one_per_line} {
      if {$display_idx} {
         set idx 1
         foreach elt $display_list {
            append displist [format {%2d) %s } $idx $elt] \n
            incr idx
         }
      } else {
         append displist [join $display_list \n] \n
      }
   # elsewhere display elements in columns
   } else {
      if {$display_idx} {
         # save room for numbers and spacing: 2 digits + ) + space
         set elt_prefix_len 4
      } else {
         set elt_prefix_len 0
      }
      # save room for two spaces after element
      set elt_suffix_len 2

# compute rows*cols grid size with optimized column number
      # the size of each column is computed to display as much column
      # as possible on each line
      incr max_len $elt_suffix_len
      foreach len $len_list {
         lappend elt_len [incr len $elt_suffix_len]
      }

set tty_cols [getTtyColumns]
      # find valid grid by starting with non-optimized solution where each
      # column length is equal to the length of the biggest element to display
      set cur_cols [expr {int(($tty_cols - $elt_prefix_len) / $max_len)}]
      # when display is found too short to display even one column
      if {$cur_cols == 0} {
         set cols 1
         set rows $elt_cnt
         array set col_width [list 0 $max_len]
      } else {
         set cols 0
         set rows 0
      }
      set last_round 0
      set restart_loop 0
      while {$cur_cols > $cols} {
         if {!$restart_loop} {
            if {$last_round} {
               incr cur_rows
            } else {
               set cur_rows [expr {int(ceil(double($elt_cnt) / $cur_cols))}]
            }
            for {set i 0} {$i < $cur_cols} {incr i} {
               set cur_col_width($i) 0
            }
            for {set i 0} {$i < $cur_rows} {incr i} {
               set row_width($i) 0
            }
            set istart 0
         } else {
            set istart [expr {$col * $cur_rows}]
            # only remove width of elements from current col
            for {set row 0} {$row < ($i % $cur_rows)} {incr row} {
               incr row_width($row) -[expr {$pre_col_width + $elt_prefix_len}]
            }
         }
         set restart_loop 0
         for {set i $istart} {$i < $elt_cnt} {incr i} {
            set col [expr {int($i / $cur_rows)}]
            set row [expr {$i % $cur_rows}]
            # restart loop if a column width change
            if {[lindex $elt_len $i] > $cur_col_width($col)} {
               set pre_col_width $cur_col_width($col)
               set cur_col_width($col) [lindex $elt_len $i]
               set restart_loop 1
               break
            }
            # end search of maximum number of columns if computed row width
            # is larger than terminal width
            if {[incr row_width($row) +[expr {$cur_col_width($col) \
               + $elt_prefix_len}]] > $tty_cols} {
               # start last optimization pass by increasing row number until
               # reaching number used for previous column number, by doing so
               # this number of column may pass in terminal width, if not
               # fallback to previous number of column
               if {$last_round && $cur_rows == $rows} {
                  incr cur_cols -1
               } else {
                  set last_round 1
               }
               break
            }
         }
         # went through all elements without reaching terminal width limit so
         # this number of column solution is valid, try next with a greater
         # column number
         if {$i == $elt_cnt} {
            set cols $cur_cols
            set rows $cur_rows
            array set col_width [array get cur_col_width]
            # number of column is fixed if last optimization round has started
            # reach end also if there is only one row of results
            if {!$last_round && $rows > 1} {
               incr cur_cols
            }
         }

}
      reportDebug list=$display_list
      reportDebug "rows/cols=$rows/$cols,\
         lastcol_item_cnt=[expr {int($elt_cnt % $rows)}]"

for {set row 0} {$row < $rows} {incr row} {
         for {set col 0} {$col < $cols} {incr col} {
            set index [expr {$col * $rows + $row}]
            if {$index < $elt_cnt} {
               if {$display_idx} {
                  append displist [format "%2d) " [expr {$index +1}]]
               }
               # cannot use 'format' as strings may contain SGR codes
               append displist [lindex $display_list $index][string repeat\
                  { } [expr {$col_width($col) - [lindex $len_list $index]}]]
            }
         }
         append displist \n
      }
   }
   if {$json && $header ne {noheader}} {
      append displist "\n\}"
   }
   report $displist 1
   reportSeparateNextContent
}

# Return conf value and from where an eventual def value has been overridden
proc displayConfig {val env_var {asked 0} {trans {}} {locked 0}} {
   array set transarr $trans

# get overridden value and know what has overridden it
   if {$asked} {
      set defby " (cmd-line)"
   } elseif {$env_var ne {} && !$locked && [info exists ::env($env_var)]} {
      set defby " (env-var)"
   } elseif {$locked} {
      set defby " (locked)"
   } else {
      set defby {}
   }

# translate fetched value if translation table exists
   if {[info exists transarr($val)]} {
      set val $transarr($val)
   }

return $val$defby
}

# build list of what to undo then do to move from an initial list to a target
# list, eventually checking element presence in extra from/to lists
proc getMovementBetweenList {from to {extfrom {}} {extto {}}} {
   reportDebug "from($from) to($to) with extfrom($extfrom) extto($extto)"

set undo {}
   set do {}

# determine what element to undo then do
   # to restore a target list from a current list
   # with preservation of the element order
   set imax [if {[llength $to] > [llength $from]} {llength $to} {llength\
      $from}]
   set list_equal 1
   for {set i 0} {$i < $imax} {incr i} {
      set to_obj [lindex $to $i]
      set from_obj [lindex $from $i]
      # check from/to element presence in extra from/to list
      set in_extfrom [isInList $extfrom $from_obj]
      set in_extto [isInList $extto $to_obj]
      # are elts the sames and are both part of or missing from extra lists
      if {$to_obj ne $from_obj || $in_extfrom != $in_extto} {
         set list_equal 0
      }
      if {$list_equal == 0} {
         if {$to_obj ne {}} {
            lappend do $to_obj
         }
         if {$from_obj ne {}} {
            lappend undo $from_obj
         }
      }
   }

return [list $undo $do]
}

# build list of currently loaded modules where modulename is registered minus
# module version if loaded version is the default one. a helper list may be
# provided and looked at prior to module search
proc getSimplifiedLoadedModuleList {{helper_raw_list {}}\
   {helper_list {}}} {
   reportDebug called.

set curr_mod_list {}
   set curr_nuasked_list {}
   set modpathlist [getModulePathList]
   foreach mod [getLoadedModuleList] {
      # if mod found in a previous LOADEDMODULES list use simplified
      # version of this module found in relative helper list (previously
      # computed simplified list)
      if {[set helper_idx [lsearch -exact $helper_raw_list $mod]] != -1} {
         set simplemod [lindex $helper_list $helper_idx]
      # look through modpaths for a simplified mod name if not full path
      } elseif {![isModuleFullPath $mod] && [llength $modpathlist] > 0} {
         set modfile [getModulefileFromLoadedModule $mod]
         set parentmod [file dirname $mod]
         set simplemod $mod
         # simplify to parent name as long as it resolves to current mod
         while {$parentmod ne {.}} {
            lassign [getPathToModule $parentmod $modpathlist 0] parentfile
            if {$parentfile eq $modfile} {
               set simplemod $parentmod
               set parentmod [file dirname $parentmod]
            } else {
               set parentmod .
            }
         }
      } else {
         set simplemod $mod
      }
      lappend curr_mod_list $simplemod
      # record not user asked module list in simplified version form
      if {![isModuleUserAsked $mod]} {
         lappend curr_nuasked_list $simplemod
      }
   }

return [list $curr_mod_list $curr_nuasked_list]
}

# return saved collections found in user directory which corresponds to
# enabled collection target if any set.
proc findCollections {} {
   if {[info exists ::env(HOME)]} {
      set coll_search $::env(HOME)/.module/*
   } else {
      reportErrorAndExit {HOME not defined}
   }

# find saved collections (matching target suffix)
   # a target is a domain on which a collection is only valid.
   # when a target is set, only the collections made for that target
   # will be available to list and restore, and saving will register
   # the target footprint
   set colltarget [getConf collection_target]
   if {$colltarget ne {}} {
      append coll_search .$colltarget
   }

# workaround 'glob -nocomplain' which does not return permission
   # error on Tcl 8.4, so we need to avoid raising error if no match
   # glob excludes by default files starting with "."
   if {[catch {set coll_list [glob $coll_search]} errMsg ]} {
      if {$errMsg eq "no files matched glob pattern \"$coll_search\""} {
         set coll_list {}
      } else {
         reportErrorAndExit "Cannot access collection directory.\n$errMsg"
      }
   }

return $coll_list
}

# get filename corresponding to collection name provided as argument.
# name provided may already be a file name. collection description name
# (with target info if any) is returned along with collection filename
proc getCollectionFilename {coll} {
   # initialize description with collection name
   set colldesc $coll

if {$coll eq {}} {
      reportErrorAndExit {Invalid empty collection name}
   # is collection a filepath
   } elseif {[string first / $coll] > -1} {
      # collection target has no influence when
      # collection is specified as a filepath
      set collfile $coll
   # elsewhere collection is a name
   } elseif {[info exists ::env(HOME)]} {
      set collfile $::env(HOME)/.module/$coll
      # if a target is set, append the suffix corresponding
      # to this target to the collection file name
      set colltarget [getConf collection_target]
      if {$colltarget ne {}} {
         append collfile .$colltarget
         # add knowledge of collection target on description
         append colldesc " (for target \"$colltarget\")"
      }
   } else {
      reportErrorAndExit {HOME not defined}
   }

return [list $collfile $colldesc]
}

# generate collection content based on provided path and module lists
proc formatCollectionContent {path_list mod_list nuasked_list {sgr 0}} {
   set content {}

# graphically enhance module command if asked
   set modcmd [expr {$sgr ? [sgr cm module] : {module}}]

# start collection content with modulepaths
   foreach path $path_list {
      # enclose path if space character found in it
      if {[string first { } $path] != -1} {
         set path "{$path}"
      }
      # 'module use' prepends paths by default so we clarify
      # path order here with --append flag
      append content "$modcmd use --append $path" \n
   }

# then add modules
   foreach mod $mod_list {
      # mark modules not asked by user to restore the user asked state
      set opt [expr {[isInList $nuasked_list $mod] ? {--notuasked } : {}}]
      # enclose module if space character found in it
      if {[string first { } $mod] != -1} {
         set mod "{$mod}"
      }
      append content "$modcmd load $opt$mod" \n
   }

return $content
}

# read given collection file and return the path and module lists it defines
proc readCollectionContent {collfile colldesc} {
   # init lists (maybe coll does not set mod to load)
   set path_list {}
   set mod_list {}
   set nuasked_list {}

# read file
   if {[catch {
      set fdata [split [readFile $collfile] \n]
   } errMsg ]} {
      reportErrorAndExit "Collection $colldesc cannot be read.\n$errMsg"
   }

# analyze collection content
   foreach fline $fdata {
      if {[regexp {module use (.*)$} $fline match patharg] == 1} {
         # paths are appended by default
         set stuff_path append
         # manage multiple paths and path options specified on single line,
         # for instance "module use --append path1 path2 path3", with list
         # representation of patharg (which handles quoted elements containing
         # space in their name)
         foreach path $patharg {
            # following path is asked to be appended
            if {($path eq {--append}) || ($path eq {-a})\
               || ($path eq {-append})} {
               set stuff_path append
            # following path is asked to be prepended
            # collection generated with 'save' does not prepend
            } elseif {($path eq {--prepend}) || ($path eq {-p})\
               || ($path eq {-prepend})} {
               set stuff_path prepend
            } else {
               # ensure given path is absolute to be able to correctly
               # compare with paths registered in MODULEPATH
               set path [getAbsolutePath $path]
               # add path to end of list
               if {$stuff_path eq {append}} {
                  lappend path_list $path
               # insert path to first position
               } else {
                  set path_list [linsert $path_list 0 $path]
               }
            }
         }
      } elseif {[regexp {module load (.*)$} $fline match modarg] == 1} {
         # manage multiple modules specified on a single line, for instance
         # "module load mod1 mod2 mod3", with list representation of modarg
         # make a list of modules that were not directly asked by user
         set cleanlist [lsearch -all -inline -not -exact $modarg\
            --notuasked]
         if {[llength $modarg] != [llength $cleanlist]} {
            set nuasked_list [concat $nuasked_list $cleanlist]
         }
         set mod_list [concat $mod_list $cleanlist]
      }
   }

return [list $path_list $mod_list $nuasked_list]
}

# analyze/translate command name passed to module
proc parseModuleCommandName {command defaultcmd} {
   set cmdempty 0

# resolve command if alias or shortcut name used
   switch -- $command {
      add               {set command load}
      rm - remove       {set command unload}
      show              {set command display}
      apropos - keyword {set command search}
      {} {
         # if empty string supplied translate to default command
         set command $defaultcmd
         set cmdempty 1
      }
      default {
         # specific match for shortcut names
         set cmdlen [string length $command]
         foreach {match minlen sccmd} {load 2 load unload 4 unload delete 3\
            unload refresh 3 reload reload 3 reload switch 2 switch swap 2\
            switch display 2 display available 2 avail aliases 2 aliases list\
            2 list whatis 2 whatis purge 2 purge initadd 5 initadd initload 6\
            initadd initprepend 5 initprepend initswitch 6 initswitch\
            initswap 6 initswitch initunload 8 initrm initlist 5 initlist} {
            if {$cmdlen >= $minlen && [string equal -length $cmdlen $command\
               $match]} {
               set command $sccmd
               break
            }
         }
      }
   }

set cmdvalid [isInList [list load unload reload use unuse source switch\
      display avail aliases path paths list whatis search purge save restore\
      saverm saveshow savelist initadd initprepend initswitch initrm initlist\
      initclear autoinit clear config help test prepend-path append-path\
      remove-path is-loaded is-saved is-used is-avail info-loaded] $command]

return [list $command $cmdvalid $cmdempty]
}

# analyze arg list passed to a module cmd to set options
proc parseModuleCommandArgs {cmd args} {
   set show_oneperline 0
   set show_mtime 0
   set show_filter {}
   set search_filter [expr {[getConf avail_indepth] ? {} : {noindepth}}]
   set search_match [getConf search_match]
   set dump_state 0
   set otherargs {}

# parse argument list
   foreach arg $args {
      switch -glob -- $arg {
         -j - --json {
            # enable json output only on supported command
            if {[isInList [list avail savelist list search whatis] $cmd]} {
               set ::g_report_format json
               set show_oneperline 0
               set show_mtime 0
            }
         }
         -t - --terse {
            set show_oneperline 1
            set show_mtime 0
            set ::g_report_format plain
         }
         -l - --long {
            set show_mtime 1
            set show_oneperline 0
            set ::g_report_format plain
         }
         -d - --default {
            # in case of *-path command, -d means --delim
            if {$arg eq {-d} && [string match *-path $cmd]} {
               lappend otherargs $arg
            } else {
               set show_filter onlydefaults
            }
         }
         -L - --latest {
            set show_filter onlylatest
         }
         -C - --contains {
            set search_match contains
         }
         -S - --starts-with {
            set search_match starts_with
         }
         --indepth {
            # empty value means 'in depth' as it is default behavior
            set search_filter {}
         }
         --no-indepth {
            set search_filter noindepth
         }
         --dump-state {
            set dump_state 1
         }
         --auto - --no-auto - -f - --force {
            reportWarning "Unsupported option '$arg'"
         }
         default {
            lappend otherargs $arg
         }
      }
   }

reportDebug "(show_oneperline=$show_oneperline, show_mtime=$show_mtime,\
      show_filter=$show_filter, search_filter=$search_filter,\
      search_match=$search_match, dump_state=$dump_state, otherargs=$otherargs)"
   return [list $show_oneperline $show_mtime $show_filter $search_filter\
      $search_match $dump_state $otherargs]
}

# when advanced_version_spec option is enabled, parse argument list to set in
# a global context version specification of modules passed as argument.
# specification may vary whether it comes from the ml or another command.
proc parseModuleVersionSpecifier {mlspec args} {
   # skip arg parse if proc was already call with same arg set by an upper
   # proc. check all args to ensure current arglist does not deviate from
   # what was previously parsed
   foreach arg $args {
      if {![info exists ::g_moduleVersSpec($arg)]} {
         set need_parse 1
         break
      }
   }

if {[info exists need_parse]} {
      if {[getConf advanced_version_spec]} {
         set invalidversspec 0
         set invalidversrange 0
         set mlunload 0
         set arglist [list]
         set unarglist [list]
         foreach arg $args {
            # extract module name and version specifier from arg
            set curverslist [lassign [split $arg @] curmod]
            # preserve empty argument
            if {$curmod ne {} || $arg eq {}} {
               # save previous module version spec and transformed arg if any
               if {[info exists modarglist]} {
                  set modarg [join $modarglist]
                  if {[info exists modname] && ($modname ne {} || $modspec eq {})} {
                     setModuleVersSpec $modarg $modname $cmpspec $versspec
                     # rework args to have 1 str element for whole module spec
                     # append to unload list if ml spec and - prefix used
                     if {$mlunload} {
                        lappend unarglist $modarg
                     } else {
                        lappend arglist $modarg
                     }
                  } elseif {$modspec ne {}} {
                     knerror "No module name defined in argument '$modarg'"
                  }
                  unset modarglist
               }
               if {$mlspec} {
                  if {[string index $curmod 0] eq {-}} {
                     set arg [string range $arg 1 end]
                     set curmod [string range $curmod 1 end]
                     set mlunload 1
                  } else {
                     set mlunload 0
                  }
               }
               set modname $curmod
               set modspec {}
            }

set modspec [lindex $curverslist end]
            set versspecislist [expr {[string first , $modspec] != -1}]
            set versspecisrange [expr {[string first : $modspec] != -1}]
            # no deep version specification allowed nor list/range mix
            if {[string first / $modspec] != -1 || ($versspecislist &&\
               $versspecisrange)} {
               set invalidversspec 1
            # ',' separates multiple versions
            } elseif {$versspecislist} {
               set cmpspec in
               set versspec [split $modspec ,]
               # empty element in list is erroneous
               set invalidversspec [expr {[lsearch -exact $versspec {}] != -1}]
            # ':' separates range elements
            } elseif {$versspecisrange} {
               set versspec [split $modspec :]
               set lovers [lindex $versspec 0]
               set hivers [lindex $versspec 1]
               if {[llength $versspec] != 2 || ($lovers eq {} && $hivers eq\
                  {})} {
                  set invalidversspec 1
               } elseif {($lovers ne {} && ![isVersion $lovers]) || ($hivers\
                  ne {} && ![isVersion $hivers])} {
                  set invalidversrange 1
               # greater or equal
               } elseif {$hivers eq {}} {
                  set cmpspec ge
                  set versspec $lovers
               # lower or equal
               } elseif {$lovers eq {}} {
                  set cmpspec le
                  set versspec $hivers
               # between or equal
               } elseif {[compareVersion $lovers $hivers] == 1} {
                  set invalidversrange 1
               } else {
                  set cmpspec be
               }
            } else {
               set cmpspec eq
               set versspec $modspec
            }
            if {$invalidversspec} {
               knerror "Invalid version specifier '$modspec'"
            }
            if {$invalidversrange} {
               knerror "Invalid version range '$modspec'"
            }
            # keep arg enclosed if composed of several words
            if {[string first { } $arg] != -1} {
               lappend modarglist "{$arg}"
            } else {
               lappend modarglist $arg
            }
         }
         # transform last args
         if {[info exists modarglist]} {
            set modarg [join $modarglist]
            if {[info exists modname] && ($modname ne {} || $modspec eq {})} {
               setModuleVersSpec $modarg $modname $cmpspec $versspec
               # rework args to have 1 string element for whole module spec
               # append to unload list if ml spec and - prefix used
               if {$mlunload} {
                  lappend unarglist $modarg
               } else {
                  lappend arglist $modarg
               }
            } elseif {$modspec ne {}} {
               knerror "No module name defined in argument '$modarg'"
            }
         }
      } else {
         set unarglist [list]
         set arglist [list]

foreach arg $args {
            if {$mlspec && [string index $arg 0] eq {-}} {
               set modname [string range $arg 1 end]
               set mlunload 1
            } else {
               set modname $arg
               set mlunload 0
            }
            # keep arg enclosed if composed of several words
            if {[string first { } $modname] != -1} {
               set modarg "{$modname}"
            } else {
               set modarg $modname
            }
            # record spec, especially needed if arg is enclosed
            setModuleVersSpec $modarg $modname eq {}
            # append to unload list if ml spec and - prefix used
            if {$mlunload} {
               lappend unarglist $modarg
            } else {
               lappend arglist $modarg
            }
         }
      }
   } else {
      set arglist $args
   }

if {$mlspec} {
      return [list $unarglist $arglist]
   } else {
      return $arglist
   }
}

proc setModuleVersSpec {modarg modname cmpspec versspec} {
   if {$versspec eq {}} {
      set mod $modname
      set modname [file dirname $modname]
   } else {
      set modname [string trimright $modname /]
      if {$cmpspec ne {eq}} {
         set mod {}
      } else {
         set mod $modname/$versspec
      }
   }
   # save a regexp-ready version of modname (apply
   # non-greedy quantifier to '*', to avoid matching final
   # '/' in string comparison
   set modnamere [string map {. \\. + \\+ * .*? ? .} $modname]
   if {$modname eq $modnamere} {
      set modnamere {}
   }
   # save a glob-special-chars escaped version of mod
   set modescglob [string map {* \\* ? \\?} $mod]

reportDebug "Set module '$mod' (escglob '$modescglob'),  module name\
      '$modname' (re '$modnamere'), version cmp '$cmpspec' and version(s)\
      '$versspec' for argument '$modarg'"
   set ::g_moduleVersSpec($modarg) [list $mod $modname $cmpspec $versspec\
      $modnamere $modescglob]
}

proc getModuleVersSpec {modarg} {
   if {[info exists ::g_moduleVersSpec($modarg)]} {
      return $::g_moduleVersSpec($modarg)
   } else {
      return [list $modarg [file dirname $modarg] {} {} {} [string map {* \\*\
         ? \\?} $modarg]]
   }
}

# get module name from module name and version spec if parsed
proc getModuleNameFromVersSpec {modarg} {
   if {[info exists ::g_moduleVersSpec($modarg)]} {
      lassign $::g_moduleVersSpec($modarg) mod modname
   } else {
      set modname [file dirname $modarg]
   }
   return $modname
}

# translate module name version spec to return all modules mentionned
proc getAllModulesFromVersSpec {modarg} {
   if {[info exists ::g_moduleVersSpec($modarg)]} {
      lassign $::g_moduleVersSpec($modarg) mod modname cmpspec versspec
      if {$mod eq {} && $cmpspec ne {eq}} {
         foreach vers $versspec {
            lappend modlist $modname/$vers
         }
      } else {
         # add empty mod specification if cmpspec is 'eq'
         lappend modlist $mod
      }
   } else {
      lappend modlist $modarg
   }

return $modlist
}

# translate module name version spec to return one module mentionned
proc getOneModuleFromVersSpec {modarg} {
   if {[info exists ::g_moduleVersSpec($modarg)]} {
      lassign $::g_moduleVersSpec($modarg) mod modname cmpspec versspec
      if {$mod eq {} && $cmpspec ne {eq}} {
         set mod $modname/[lindex $versspec 0]
      }
   } else {
      set mod $modarg
   }

return $mod
}

# unload phase of a list of modules reload process
proc reloadModuleListUnloadPhase {lmname {force 0} {errmsgtpl {}} {context\
   unload}} {
   upvar $lmname lmlist
   # unload one by one to ensure same behavior whatever auto_handling state
   foreach mod [lreverse $lmlist] {
      # save user asked state before it vanishes
      set isuasked($mod) [isModuleUserAsked $mod]
      # force unload even if requiring mods are not part of the unload list
      # (violation state) as modules are loaded again just after
      if {[cmdModuleUnload $context match 0 1 0 0 $mod]} {
         # avoid failing module on load phase
         set lmlist [replaceFromList $lmlist $mod]
         set errMsg [string map [list _MOD_ $mod] $errmsgtpl]
         if {$force} {
            # errMsg will always be set as force mode could not be enabled
            # for reload sub-cmd which provides an empty msg template
            reportWarning $errMsg 1
         # stop if one unload fails unless force mode enabled
         } else {
            knerror $errMsg
         }
      }
   }
   return [array get isuasked]
}

# load phase of a list of modules reload process
proc reloadModuleListLoadPhase {lmname isuaskedlist {force 0} {errmsgtpl {}}\
   {context load}} {
   upvar $lmname lmlist
   array set isuasked $isuaskedlist

# loads are made with auto handling mode disabled to avoid disturbances
   # from a missing prereq automatically reloaded, so these module loads may
   # fail as prereq may not be satisfied anymore
   setConf auto_handling 0
   foreach mod $lmlist {
      # reload module with user asked property preserved
      if {[cmdModuleLoad $context $isuasked($mod) $mod]} {
         set errMsg [string map [list _MOD_ $mod] $errmsgtpl]
         if {$force} {
            # errMsg will always be set as force mode could not be enabled
            # for reload sub-cmd which provides an empty msg template
            reportWarning $errMsg 1
         # stop if one load fails unless force mode enabled
         } else {
            knerror $errMsg
         }
      }
   }
   setConf auto_handling 1
}

########################################################################
# command line commands
#
proc cmdModuleList {show_oneperline show_mtime} {
   set loadedmodlist [getLoadedModuleList]
   set json [isReportFormat json]

if {[llength $loadedmodlist] == 0} {
      if {!$json} {
         report {No Modulefiles Currently Loaded.}
      }
   } else {
      set display_list {}
      set default_colored [expr {[sgr de {}] ne {}}]
      set len_list {}
      set max_len 0
      foreach mod $loadedmodlist {
         if {$show_oneperline} {
            lappend display_list $mod
         } else {
            set modfile [getModulefileFromLoadedModule $mod]
            # skip rc find and execution if mod is registered as full path
            if {[isModuleFullPath $mod]} {
               set mtime [getFileMtime $mod]
               set tag_list {}
            # or if loaded module is a virtual module
            } elseif {[isModuleVirtual $mod $modfile]} {
               set mtime [getFileMtime $modfile]
               set tag_list {}
            } else {
               # call getModules to find and execute rc files for this mod
               set dir [getModulepathFromModuleName $modfile $mod]
               array set mod_list [getModules $dir $mod $show_mtime]
               # fetch info only if mod found
               if {[info exists mod_list($mod)]} {
                  set mtime [lindex $mod_list($mod) 1]
                  set tag_list [getVersAliasList $mod]
               } else {
                  set tag_list {}
               }
            }

if {$json} {
               set dispsgr [formatListEltToJsonDisplay $mod type s modulefile\
                  symbols a $tag_list pathname s $modfile]
            } elseif {$show_mtime} {
               if {[info exists mtime]} {
                  set clock_mtime [clock format $mtime -format\
                     {%Y/%m/%d %H:%M:%S}]
                  unset mtime
               } else {
                  set clock_mtime {}
               }

# add to display file modification time in addition to tags
               lassign [formatListEltToLongDisplay $mod {} {} $tag_list sy\
                  $clock_mtime $default_colored] disp dispsgr
            } else {
               lassign [formatListEltToDisplay $mod {} {} $tag_list sy 1\
                  $default_colored] disp dispsgr
               lappend len_list [set len [string length $disp]]
               if {$len > $max_len} {
                  set max_len $len
               }
            }
            lappend display_list $dispsgr
         }
      }

if {!$json} {
         if {$show_mtime} {
            displayTableHeader hi Package 39 Versions 19 {Last mod.} 19
         }
         report {Currently Loaded Modulefiles:}
      }
      if {$show_mtime || $show_oneperline} {
         set display_idx 0
         set one_per_line 1
      } else {
         set display_idx 1
         set one_per_line 0
      }

displayElementList noheader {} {} $one_per_line $display_idx\
         $display_list $len_list $max_len
   }
}

proc cmdModuleDisplay {args} {
   reportDebug "displaying $args"

pushMode display
   set first_report 1
   foreach mod $args {
      lassign [getPathToModule $mod] modfile modname
      if {$modfile ne {}} {
         # only one separator lines between 2 modules
         if {$first_report} {
            displaySeparatorLine
            set first_report 0
         }
         report [sgr hi $modfile]:\n
         execute-modulefile $modfile $modname $mod
         displaySeparatorLine
      }
   }
   popMode
}

proc cmdModulePaths {mod} {
   reportDebug ($mod)

set dir_list [getModulePathList exiterronundef]
   foreach dir $dir_list {
      array unset mod_list
      array set mod_list [getModules $dir $mod 0 [list rc_defs_included]]

# prepare list of dirs for alias/symbol target search, will first search
      # in currently looked dir, then in other dirs following precedence order
      set target_dir_list [concat [list $dir] [replaceFromList $dir_list\
         $dir]]

# forcibly enable implicit_default to resolve alias target when it
      # points to a directory
      setConf implicit_default 1

# build list of modulefile to print
      foreach elt [array names mod_list] {
         switch -- [lindex $mod_list($elt) 0] {
            modulefile {
               lappend ::g_return_text $dir/$elt
            }
            virtual {
               lappend ::g_return_text [lindex $mod_list($elt) 2]
            }
            alias - version {
               # resolve alias target
               set aliastarget [lindex $mod_list($elt) 1]
               lassign [getPathToModule $aliastarget $target_dir_list 0]\
                  modfile modname
               # add module target as result instead of alias
               if {$modfile ne {} && ![info exists mod_list($modname)]} {
                  lappend ::g_return_text $modfile
               }
            }
         }
      }

# reset implicit_default to restore behavior defined
      unsetConf implicit_default
   }

# sort results if any and remove duplicates
   if {[info exists ::g_return_text]} {
      set ::g_return_text [lsort -dictionary -unique $::g_return_text]
   } else {
      # set empty value to return empty if no result
      set ::g_return_text {}
   }
}

proc cmdModulePath {mod} {
   reportDebug ($mod)
   lassign [getPathToModule $mod] modfile modname
   # if no result set empty value to return empty
   if {$modfile eq {}} {
      set ::g_return_text {}
   } else {
      lappend ::g_return_text $modfile
   }
}

proc cmdModuleWhatIs {{mod {}}} {
   cmdModuleSearch $mod {}
}

proc cmdModuleApropos {{search {}}} {
   cmdModuleSearch {} $search
}

proc cmdModuleSearch {{mod {}} {search {}}} {
   reportDebug "($mod, $search)"

# disable error reporting to avoid modulefile errors
   # to mix with valid search results
   inhibitErrorReport

set json [isReportFormat json]

defineModEqProc [isIcase] [getConf extended_default]

lappend searchmod rc_defs_included
   if {$mod eq {}} {
      lappend searchmod wild
   }
   set foundmod 0
   pushMode whatis
   set dir_list [getModulePathList exiterronundef]
   foreach dir $dir_list {
      array unset mod_list
      array set mod_list [getModules $dir $mod 0 $searchmod]
      array unset interp_list
      array set interp_list {}

# forcibly enable implicit_default to resolve alias target when it
      # points to a directory
      setConf implicit_default 1

# build list of modulefile to interpret
      foreach elt [array names mod_list] {
         switch -- [lindex $mod_list($elt) 0] {
            modulefile {
               set interp_list($elt) $dir/$elt
               # register module name in a global list (shared across
               # modulepaths) to get hints when solving aliases/version
               set full_list($elt) 1
            }
            virtual {
               set interp_list($elt) [lindex $mod_list($elt) 2]
               set full_list($elt) 1
            }
            alias - version {
               # resolve alias target
               set elt_target [lindex $mod_list($elt) 1]
               if {![info exists full_list($elt_target)]} {
                  lassign [getPathToModule $elt_target $dir 0]\
                     modfile modname issuetype issuemsg
                  # add module target as result instead of alias
                  if {$modfile ne {} && ![info exists mod_list($modname)]} {
                     set interp_list($modname) $modfile
                     set full_list($modname) 1
                  } elseif {$modfile eq {}} {
                     # if module target not found in current modulepath add to
                     # list for global search after initial modulepath lookup
                     if {[string first {Unable to locate} $issuemsg] == 0} {
                        set extra_search($modname) [list $dir [modEq $mod\
                           $elt]]
                     # register resolution error if alias name matches search
                     } elseif {[modEq $mod $elt]} {
                        set err_list($modname) [list $issuetype $issuemsg]
                     }
                  }
               }
            }
            invalid - accesserr {
               # register any error occuring on element matching search
               if {[modEq $mod $elt]} {
                  set err_list($elt) $mod_list($elt)
               }
            }
         }
      }

# reset implicit_default to restore behavior defined
      unsetConf implicit_default

# in case during modulepath lookup we find an alias target we were
      # looking for in previous modulepath, remove this element from global
      # search list
      foreach elt [array names extra_search] {
         if {[info exists full_list($elt)]} {
            unset extra_search($elt)
         }
      }

# save results from this modulepath for interpretation step as there
      # is an extra round of search to match missing alias target, we cannot
      # process modulefiles found immediately
      if {[array size interp_list] > 0} {
         set interp_save($dir) [array get interp_list]
      }
   }

# forcibly enable implicit_default to resolve alias target when it points
   # to a directory
   setConf implicit_default 1

# find target of aliases in all modulepath except the one already tried
   foreach elt [array names extra_search] {
      lassign [getPathToModule $elt {} 0 no [lindex $extra_search($elt) 0]]\
         modfile modname issuetype issuemsg issuefile
      # found target so append it to results in corresponding modulepath
      if {$modfile ne {}} {
         # get belonging modulepath dir depending of module kind
         if {[isModuleVirtual $modname $modfile]} {
            set dir [findModulepathFromModulefile\
               $::g_sourceVirtual($modname)]
         } else {
            set dir [getModulepathFromModuleName $modfile $modname]
         }
         array unset interp_list
         if {[info exists interp_save($dir)]} {
            array set interp_list $interp_save($dir)
         }
         set interp_list($modname) $modfile
         set interp_save($dir) [array get interp_list]
      # register resolution error if primal alias name matches search
      } elseif {$modfile eq {} && [lindex $extra_search($elt) 1]} {
         set err_list($modname) [list $issuetype $issuemsg $issuefile]
      }
   }

# reset implicit_default to restore behavior defined
   unsetConf implicit_default

# prepare string translation to highlight search query string
   set matchmodmap [prepareMapToHightlightSubstr $mod]
   set matchsearchmap [prepareMapToHightlightSubstr $search]

# interpret all modulefile we got for each modulepath
   foreach dir $dir_list {
      if {[info exists interp_save($dir)]} {
         array unset interp_list
         array set interp_list $interp_save($dir)
         set foundmod 1
         set display_list {}
         # interpret every modulefiles obtained to get their whatis text
         foreach elt [lsort -dictionary [array names interp_list]] {
            set ::g_whatis {}
            execute-modulefile $interp_list($elt) $elt $elt

# treat whatis as a multi-line text
            if {$search eq {} || [regexp -nocase $search $::g_whatis]} {
               if {$json} {
                  lappend display_list [formatListEltToJsonDisplay $elt\
                     whatis a $::g_whatis]
               } else {
                  set eltsgr [string map $matchmodmap $elt]
                  foreach line $::g_whatis {
                     set linesgr [string map $matchsearchmap $line]
                     lappend display_list "[string repeat { } [expr {20 -\
                        [string length $elt]}]]$eltsgr: $linesgr"
                  }
               }
            }
         }

displayElementList $dir mp sepline 1 0 $display_list
      }
   }
   popMode

reenableErrorReport

# report errors if a modulefile was searched but not found
   if {$mod ne {} && !$foundmod} {
      # no error registered means nothing was found to match search
      if {![array exists err_list]} {
         set err_list($mod) [list none "Unable to locate a modulefile for\
            '$mod'"]
      }
      foreach elt [array names err_list] {
         eval reportIssue $err_list($elt)
      }
   }
}

proc cmdModuleSwitch {uasked old {new {}}} {
   # if a single name is provided it matches for the module to load and in
   # this case the module to unload is searched to find the closest match
   # (loaded module that shares at least the same root name)
   if {$new eq {}} {
      set new $old
      set unload_match close
   } else {
      set unload_match match
   }
   # save orig names to register them as deps if called from modulefile
   set argnew $new
   if {$new eq $old} {
      set argold {}
   } else {
      set argold $old
   }

reportDebug "old='$old' new='$new' (uasked=$uasked)"

# record sumup messages from underlying unload/load actions under the same
   # switch message record id to report (evaluation messages still go under
   # their respective unload/load block
   pushMsgRecordId switch-$old-$new-[getEvalModuleStackDepth]

set ret [cmdModuleUnload swunload $unload_match 1 0 0 0 $old]

# register modulefile to unload as conflict if an unload module is
   # mentionned on this module switch command set in a modulefile
   set orig_auto_handling [getConf auto_handling]
   if {!$uasked && $argold ne {}} {
      # skip conflict declaration if old spec matches new as in this case
      # switch means *replace loaded version of mod by this specific version*
      lassign [getPathToModule $new] newmodfile newmod
      if {$newmod eq {} || ![modEq $argold $newmod eqstart]} {
         # temporarily disable auto handling just to record deps, not to try
         # to load or unload them (already tried)
         setConf auto_handling 0
         catch {conflict $argold}
         setConf auto_handling $orig_auto_handling
      }
   }

# attempt load and depre reload only if unload succeed
   if {!$ret} {
      cmdModuleLoad swload $uasked $new

if {[getConf auto_handling] && [info exists deprelist] && [llength\
         $deprelist] > 0} {
         # cmdModuleUnload handles the DepUn, UReqUn mechanisms and the unload
         # phase of the DepRe mechanism. List of DepRe mods and their user
         # asked state is set from cmdModuleUnload procedure to be used here
         # for the load phase of the DepRe mechanism.
         # Try DepRe load phase: load failure will not lead to switch failure
         reloadModuleListLoadPhase deprelist [array get isuasked]\
            1 {Reload of dependent _MOD_ failed} depre
      }

# report a summary of automated evaluations if no error
      reportModuleEval
   }

# report all recorded sumup messages for this evaluation
   reportMsgRecord "Switching from [sgr hi $old] to [sgr hi $new]"
   popMsgRecordId

# register modulefile to load as prereq when called from modulefile
   if {!$uasked && !$ret && $argnew ne {}} {
      setConf auto_handling 0
      prereq $argnew
      setConf auto_handling $orig_auto_handling
   }
}

proc cmdModuleSave {{coll default}} {
   reportDebug $coll

if {![areModuleConstraintsSatisfied]} {
      reportErrorAndExit {Cannot save collection, some module constraints are\
         not satistied}
   }

# format collection content, version number of modulefile are saved if
   # version pinning is enabled
   if {[getConf collection_pin_version]} {
      set curr_mod_list [getLoadedModuleList]
      set curr_nuasked_list [getLoadedModuleNotUserAskedList]
   } else {
      lassign [getSimplifiedLoadedModuleList] curr_mod_list curr_nuasked_list
   }
   set save [formatCollectionContent [getModulePathList returnempty 0]\
      $curr_mod_list $curr_nuasked_list]

if { [string length $save] == 0} {
      reportErrorAndExit {Nothing to save in a collection}
   }

# get coresponding filename and its directory
   lassign [getCollectionFilename $coll] collfile colldesc
   set colldir [file dirname $collfile]

if {![file exists $colldir]} {
      reportDebug "Creating $colldir"
      file mkdir $colldir
   } elseif {![file isdirectory $colldir]} {
      reportErrorAndExit "$colldir exists but is not a directory"
   }

reportDebug "Saving $collfile"

if {[catch {
      set fid [open $collfile w]
      puts $fid $save
      close $fid
   } errMsg ]} {
      reportErrorAndExit "Collection $colldesc cannot be saved.\n$errMsg"
   }
}

proc cmdModuleRestore {{coll default}} {
   reportDebug $coll

# get coresponding filename
   lassign [getCollectionFilename $coll] collfile colldesc

if {![file exists $collfile]} {
      reportErrorAndExit "Collection $colldesc cannot be found"
   }

# read collection
   lassign [readCollectionContent $collfile $colldesc] coll_path_list\
      coll_mod_list coll_nuasked_list

# collection should at least define a path or a mod
   if {[llength $coll_path_list] == 0 && [llength $coll_mod_list] == 0} {
      reportErrorAndExit "$colldesc is not a valid collection"
   }

# forcibly enable implicit_default to restore colls saved in this mode
   setConf implicit_default 1

# fetch what is currently loaded
   set curr_path_list [getModulePathList returnempty 0]
   # get current loaded module list in simplified and raw versions
   # these lists may be used later on, see below
   set curr_mod_list_raw [getLoadedModuleList]
   set curr_nuasked_list_raw [getLoadedModuleNotUserAskedList]
   lassign [getSimplifiedLoadedModuleList] curr_mod_list curr_nuasked_list

# determine what module to unload to restore collection
   # from current situation with preservation of the load order
   lassign [getMovementBetweenList $curr_mod_list $coll_mod_list\
      $curr_nuasked_list $coll_nuasked_list] mod_to_unload mod_to_load
   # determine unload movement with raw loaded list in case versions are
   # pinning in saved collection
   lassign [getMovementBetweenList $curr_mod_list_raw $coll_mod_list\
      $curr_nuasked_list_raw $coll_nuasked_list] mod_to_unload_raw\
      mod_to_load_raw
   if {[llength $mod_to_unload] > [llength $mod_to_unload_raw]} {
      set mod_to_unload $mod_to_unload_raw
   }

# proceed as well for modulepath
   lassign [getMovementBetweenList $curr_path_list $coll_path_list] \
      path_to_unuse path_to_use

# create an eval id to track successful/failed module evaluations
   pushMsgRecordId restore-$coll-[getEvalModuleStackDepth] 0

# unload modules one by one (no dependency auto unload)
   if {[llength $mod_to_unload] > 0} {
      eval cmdModuleUnload unload match 0 0 0 0 [lreverse $mod_to_unload]
   }
   # unuse paths
   if {[llength $path_to_unuse] > 0} {
      eval cmdModuleUnuse [lreverse $path_to_unuse]
   }

# since unloading a module may unload other modules or
   # paths, what to load/use has to be determined after
   # the undo phase, so current situation is fetched again
   set curr_path_list [getModulePathList returnempty 0]

# here we may be in a situation were no more path is left
   # in module path, so we cannot easily compute the simplified loaded
   # module list. so we provide two helper lists: simplified and raw
   # versions of the loaded module list computed before starting to
   # unload modules. these helper lists may help to learn the
   # simplified counterpart of a loaded module if it was already loaded
   # before starting to unload modules
   lassign [getSimplifiedLoadedModuleList $curr_mod_list_raw $curr_mod_list]\
      curr_mod_list curr_nuasked_list
   set curr_mod_list_raw [getLoadedModuleList]
   set curr_nuasked_list_raw [getLoadedModuleNotUserAskedList]

# determine what module to load to restore collection
   # from current situation with preservation of the load order
   lassign [getMovementBetweenList $curr_mod_list $coll_mod_list\
      $curr_nuasked_list $coll_nuasked_list] mod_to_unload mod_to_load
   # determine load movement with raw loaded list in case versions are
   # pinning in saved collection
   lassign [getMovementBetweenList $curr_mod_list_raw $coll_mod_list\
      $curr_nuasked_list_raw $coll_nuasked_list] mod_to_unload_raw\
      mod_to_load_raw
   if {[llength $mod_to_load] > [llength $mod_to_load_raw]} {
      set mod_to_load $mod_to_load_raw
   }

# proceed as well for modulepath
   lassign [getMovementBetweenList $curr_path_list $coll_path_list] \
      path_to_unuse path_to_use

# reset implicit_default to restore behavior defined
   unsetConf implicit_default

# use paths
   if {[llength $path_to_use] > 0} {
      # always append path here to guaranty the order
      # computed above in the movement lists
      eval cmdModuleUse --append $path_to_use
   }

# load modules one by one with user asked state preserved
   foreach mod $mod_to_load {
      cmdModuleLoad load [notInList $coll_nuasked_list $mod] $mod
   }

popMsgRecordId 0
}

proc cmdModuleSaverm {{coll default}} {
   reportDebug $coll

# avoid to remove any kind of file with this command
   if {[string first / $coll] > -1} {
      reportErrorAndExit {Command does not remove collection specified as\
         filepath}
   }

# get coresponding filename
   lassign [getCollectionFilename $coll] collfile colldesc

if {![file exists $collfile]} {
      reportErrorAndExit "Collection $colldesc cannot be found"
   }

# attempt to delete specified colletion
   if {[catch {
      file delete $collfile
   } errMsg ]} {
      reportErrorAndExit "Collection $colldesc cannot be removed.\n$errMsg"
   }
}

proc cmdModuleSaveshow {{coll default}} {
   reportDebug $coll

# get coresponding filename
   lassign [getCollectionFilename $coll] collfile colldesc

if {![file exists $collfile]} {
      reportErrorAndExit "Collection $colldesc cannot be found"
   }

# read collection
   lassign [readCollectionContent $collfile $colldesc] coll_path_list\
      coll_mod_list coll_nuasked_list

# collection should at least define a path or a mod
   if {[llength $coll_path_list] == 0 && [llength $coll_mod_list] == 0} {
      reportErrorAndExit "$colldesc is not a valid collection"
   }

displaySeparatorLine
   report [sgr hi $collfile]:\n
   report [formatCollectionContent $coll_path_list $coll_mod_list\
      $coll_nuasked_list 1]
   displaySeparatorLine
}

proc cmdModuleSavelist {show_oneperline show_mtime} {
   # if a target is set, only list collection matching this
   # target (means having target as suffix in their name)
   set colltarget [getConf collection_target]
   if {$colltarget ne {}} {
      set suffix .$colltarget
      set targetdesc " (for target \"$colltarget\")"
   } else {
      set suffix {}
      set targetdesc {}
   }

set json [isReportFormat json]

reportDebug "list collections for target \"$colltarget\""

set coll_list [findCollections]

if { [llength $coll_list] == 0} {
      if {!$json} {
         report "No named collection$targetdesc."
      }
   } else {
      set list {}
      if {!$json} {
         if {$show_mtime} {
            displayTableHeader hi Collection 59 {Last mod.} 19
         }
         report "Named collection list$targetdesc:"
      }
      set display_list {}
      set len_list {}
      set max_len 0
      if {$show_mtime || $show_oneperline} {
         set display_idx 0
         set one_per_line 1
      } else {
         set display_idx 1
         set one_per_line 0
      }

foreach coll [lsort -dictionary $coll_list] {
         # remove target suffix from names to display
         regsub $suffix$ [file tail $coll] {} mod
         if {$json} {
            lappend display_list [formatListEltToJsonDisplay $mod target s\
               $colltarget pathname s $coll]
         # no need to test mod consistency as findCollections does not return
         # collection whose name starts with "."
         } elseif {$show_mtime} {
            set filetime [clock format [getFileMtime $coll]\
               -format {%Y/%m/%d %H:%M:%S}]
            lappend display_list [format %-60s%19s $mod $filetime]
         } else {
            lappend display_list $mod
            lappend len_list [set len [string length $mod]]
            if {$len > $max_len} {
               set max_len $len
            }
         }
      }

displayElementList noheader {} {} $one_per_line $display_idx\
         $display_list $len_list $max_len
   }
}

proc cmdModuleSource {args} {
   reportDebug $args
   foreach fpath $args {
      set absfpath [getAbsolutePath $fpath]
      if {$fpath eq {}} {
         reportErrorAndExit {File name empty}
      } elseif {[file exists $absfpath]} {
         pushMode load
         # relax constraint of having a magic cookie at the start of the
         # modulefile to execute as sourced files may need more flexibility
         # as they may be managed outside of the modulefile environment like
         # the initialization modulerc file
         execute-modulefile $absfpath $absfpath $absfpath 0
         popMode
      } else {
         reportErrorAndExit "File $fpath does not exist"
      }
   }
}

proc cmdModuleUnsource {args} {
   reportDebug $args
   foreach fpath $args {
      set absfpath [getAbsolutePath $fpath]
      if {$fpath eq {}} {
         reportErrorAndExit {File name empty}
      } elseif {[file exists $absfpath]} {
         pushMode unload
         # relax constraint of having a magic cookie at the start of the
         # modulefile to execute as sourced files may need more flexibility
         # as they may be managed outside of the modulefile environment like
         # the initialization modulerc file
         execute-modulefile $absfpath $absfpath $absfpath 0
         popMode
      } else {
         reportErrorAndExit "File $fpath does not exist"
      }
   }
}

proc cmdModuleLoad {context uasked args} {
   reportDebug "loading $args (context=$context, uasked=$uasked)"

set ret 0
   pushMode load
   foreach mod $args {
      # if a switch action is ongoing...
      if {$context eq {swload}} {
         set swprocessing 1
         # context is ReqLo if switch is called from a modulefile
         if {![isMsgRecordIdTop]} {
            set context reqlo
         }
      }

# record evaluation attempt on specified module name
      registerModuleEvalAttempt $context $mod
      lassign [getPathToModule $mod] modfile modname
      if {$modfile eq {}} {
         set ret 1
         # go to next module to unload
         continue
      }

if {[isModuleEvalFailed load $modname]} {
         reportDebug "$modname ($modfile) load was already tried and failed"
         # nullify this evaluation attempt to avoid duplicate issue report
         unregisterModuleEvalAttempt $context $mod
         continue
      }

# if a switch action is ongoing...
      if {[info exists swprocessing]} {
         # pass the DepRe mod list to the calling cmdModuleSwitch procedure to
         # let it handle the load phase of the DepRe mechanism along with the
         # DepRe modules set from switched off module.
         upvar deprelist swdeprelist
         upvar isuasked isuasked

# transmit loaded mod name for switch report summary
         uplevel 1 set new $modname
      }

# set a unique id to record messages related to this evaluation.
      set msgrecid load-$modname-[getEvalModuleStackDepth]
      pushMsgRecordId $msgrecid

# record evaluation attempt on actual module name
      registerModuleEvalAttempt $context $modname
      registerModuleEvalAttempt $context $modfile

# check if passed modname correspond to an already loaded modfile
      # and get its loaded name (in case it has been loaded as full path)
      set loadedmodname [getLoadedMatchingName $modname]
      if {$loadedmodname ne {}} {
         set modname $loadedmodname
      }

pushSettings
      if {[set errCode [catch {
         if {[isModuleLoaded $modname] || [isModuleLoading $modname]} {
            reportDebug "$modname ($modfile) already loaded/loading"
            # exit treatment but no need to restore settings
            continue
         }

# register altname of modname prior any conflict check
         eval setLoadedAltname "{$modname}" [getAllModuleResolvedName\
            $modname 1]

if {[getConf auto_handling]} {
            # get loaded modules holding a requirement on modname and able to
            # be reloaded
            set deprelist [getUnmetDependentLoadedModuleList $modname]
            reportDebug "depre mod list is '$deprelist'"

# Reload all modules that have declared a prereq on mod as they
            # may take benefit from their prereq availability if it is newly
            # loaded. First perform unload phase of the reload, prior mod load
            # to ensure these dependent modules are unloaded with the same
            # loaded prereq as when they were loaded
            if {[llength $deprelist] > 0} {
               array set isuasked [reloadModuleListUnloadPhase deprelist\
                  [getForce] {Unload of dependent _MOD_ failed} depun]
               if {[info exists swprocessing]} {
                  if {[info exists swdeprelist]} {
                     set swdeprelist [concat $deprelist $swdeprelist]
                  } else {
                     set swdeprelist $deprelist
                  }
               }
            }
         }

if {[execute-modulefile $modfile $modname $mod]} {
            break
         }

# register this evaluation on the main one that triggered it (after
         # load evaluation to report correct order with other evaluations)
         registerModuleEval $context $modname

# raise an error if a conflict violation is detected 
         # do that after modfile evaluation to give it the chance to solve its
         # (module unload) conflicts through its evaluation
         lassign [doesModuleConflict $modname] doescon modconlist\
            moddecconlist
         set retisconun [eval isModuleEvaluated conun "{$modname}"\
            $modconlist]
         if {![set retiseval [eval isModuleEvaluated any "{$modname}"\
            $modconlist]] || [currentMsgRecordId] ne [topMsgRecordId] ||\
            !$retisconun} {
            # more appropriate msg if an evaluation was attempted or is
            # by-passed. error is reported using declared conflict name (as if
            # it was raised raised from a conflict modulefile command)
            set conmsg [expr {$retiseval || [getForce] ? [getConIsLoadedMsg\
               $moddecconlist [is-loading $modconlist]] : [getErrConflictMsg\
               $modname $moddecconlist]}]
         }

# still proceed if force mode enabled
         if {[getForce] && $doescon} {
            defineModEqProc [isIcase] [getConf extended_default]
            # report warning if not already done
            set report_con 1
            if {[info exists ::report_conflict($modname)]} {
               # check if conflict has not been already reported with an
               # alternative name
               foreach modalt [concat [getLoadedAltname $modconlist]\
                  $modconlist $moddecconlist] {
                  foreach reportmod $::report_conflict($modname) {
                     if {[doesModuleMatchesName $modalt $reportmod]} {
                        set report_con 0
                        break
                     }
                  }
               }
            }
            if {$report_con && [info exists conmsg]} {
               reportWarning $conmsg
            }
            # raise conun-specific msg to top level if attempted
            if {$retisconun} {
               reportWarning [getErrConUnMsg $moddecconlist] 1
            }
         } elseif {$doescon} {
            if {$retisconun} {
               if {[info exists conmsg]} {
                  reportError $conmsg
               }
               # raise conun-specific msg to top level if attempted
               knerror [getErrConUnMsg $moddecconlist]
            } else {
               set errlocalreport 1
               knerror $conmsg
            }
         }

add-path append LOADEDMODULES $modname
         # allow duplicate modfile entries for virtual modules
         add-path append --duplicates _LMFILES_ $modfile
         # update cache arrays
         setLoadedModule $modname $modfile $uasked

# register declared conflict in environment
         if {[set modcon [getLoadedConflict $modname 1]] ne {}} {
            add-path append MODULES_LMCONFLICT $modcon
         }

# declare the prereq of this module
         if {[set modpre [getLoadedPrereq $modname 1]] ne {}} {
            add-path append MODULES_LMPREREQ $modpre
         }

# declare module as not asked by user (automatically loaded as
         # dependency) if it is the case
         if {!$uasked} {
            add-path append MODULES_LMNOTUASKED $modname
         }

# declare the alternative names of this module
         if {[set modalt [getLoadedAltname $modname 1]] ne {}} {
            add-path append MODULES_LMALTNAME $modalt
         }

# Load phase of dependent module reloading. These modules can adapt
         # now that mod is seen loaded. Except if switch action ongoing (DepRe
         # load phase will occur from switch)
         if {[getConf auto_handling] && [llength $deprelist] > 0 && ![info\
            exists swprocessing]} {
            reloadModuleListLoadPhase deprelist [array get isuasked]\
               [getForce] {Reload of dependent _MOD_ failed} depre
         }

# report a summary of automated evaluations if no error
         reportModuleEval
      } errMsg]] != 0 && $errCode != 4} {
         if {$errMsg ne {}} {
            reportError $errMsg [expr {![info exists errlocalreport]}]
         }
         # report switched-on module load failure under switch info block
         # unless the above reportError call already put a mesg to this block
         if {[info exists swprocessing] && ($errMsg eq {} || [info exists\
            errlocalreport])} {
            # warn as this issue does not lead to a rollback of switch action
            reportWarning "Load of switched-on $modname failed" 1
         }
         # rollback settings if some evaluation went wrong
         set ret 1
         restoreSettings
         # remove from successfully evaluated module list
         registerModuleEval $context $modname 1 load
         unset -nocomplain errlocalreport
      }
      popSettings

# report all recorded messages for this evaluation except if module were
      # already loaded
      if {$errCode != 4} {
         reportMsgRecord "Loading [sgr hi $modname]"
      }
      popMsgRecordId
   }
   popMode

return $ret
}

proc cmdModuleUnload {context match auto force onlyureq onlyndep args} {
   reportDebug "unloading $args (context=$context, match=$match, auto=$auto,\
      force=$force, onlyureq=$onlyureq, onlyndep=$onlyndep)"

set ret 0
   pushMode unload
   foreach mod $args {
      # if a switch action is ongoing...
      if {$context eq {swunload}} {
         set swprocessing 1
         # context is ConUn if switch is called from a modulefile
         if {![isMsgRecordIdTop]} {
            set context conun
         }
      }

# record evaluation attempt on specified module name
      registerModuleEvalAttempt $context $mod
      # resolve by also looking at matching loaded module
      lassign [getPathToModule $mod {} 1 $match] modfile modname errkind
      if {$modfile eq {}} {
         # no error return if module is not loaded
         if {$errkind eq {notloaded}} {
            reportDebug "$modname is not loaded"
         } else {
            set ret 1
         }
         # go to next module to unload
         continue
      }

if {$onlyureq && ![isModuleUnloadable $modname]}  {
         reportDebug "$modname ($modfile) is required by loaded module or\
            asked by user"
         continue
      }

if {[isModuleEvalFailed unload $modname]} {
         reportDebug "$modname ($modfile) unload was already tried and failed"
         # nullify this evaluation attempt to avoid duplicate issue report
         unregisterModuleEvalAttempt $context $mod
         continue
      }

# if a switch action is ongoing...
      if {[info exists swprocessing]} {
         # pass the DepRe mod list to the calling cmdModuleSwitch
         # procedure to let it handle the load phase of the DepRe
         # mechanism once the switched-to module will be loaded
         upvar deprelist deprelist
         upvar isuasked isuasked

# transmit unloaded mod name for switch report summary
         uplevel 1 set old $modname
      }
      # set a unique id to record messages related to this evaluation.
      set msgrecid unload-$modname-[getEvalModuleStackDepth]
      pushMsgRecordId $msgrecid

# record evaluation attempt on actual module name
      registerModuleEvalAttempt $context $modname
      registerModuleEvalAttempt $context $modfile

pushSettings
      if {[set errCode [catch {
         # error if unloading module violates a registered prereq
         # and auto handling mode is disabled
         set prereq_list [getDependentLoadedModuleList [list $modname]]
         if {[llength $prereq_list] > 0 && (![getConf auto_handling] ||\
            !$auto)} {
            # force mode should not affect if we only look for mods w/o dep
            if {([getForce] || $force) && !$onlyndep} {
               # in case unload is called for a DepRe mechanism or a purge do
               # not warn about prereq violation enforced as it is due to the
               # dependent module which is already in a violation state
               if {$auto || !$force} {
                  reportWarning [getDepLoadedMsg $prereq_list]
               }
            } else {
               set errlocalreport 1
               # exit treatment but no need to set return code to error if
               # called from a 'module unload' command in a modulefile in a
               # load evaluation mode, as set conflict will raise error at end
               # of modulefile evaluation
               if {$onlyndep} {
                  set errharmless 1
               }
               knerror [expr {[eval isModuleEvaluated any "{$modname}"\
                  $prereq_list] ? [getDepLoadedMsg $prereq_list] :\
                  [getErrPrereqMsg $modname $prereq_list 0]}]
            }
         }

if {[getConf auto_handling] && $auto} {
            # compute lists of modules to update due to modname unload prior
            # unload to get requirement info before it vanishes

# DepUn: Dependent to Unload (modules actively requiring modname
            # or a module part of this DepUn batch)
            set depunnpolist [getDependentLoadedModuleList [list $modname] 1\
               0 1 0]
            set depunlist [getDependentLoadedModuleList [list $modname] 1 0 0 0]
            # look at both regular dependencies or No Particular Order
            # dependencies: use NPO result if situation can be healed with NPO
            # dependencies, which will be part of DepRe list to restore the
            # correct loading order for them
            if {[llength $depunnpolist] <= [llength $depunlist]} {
               set depunlist $depunnpolist
            }
            reportDebug "depun mod list is '$depunlist'"

# do not check for UReqUn mods coming from DepUn modules as these
            # DepUn modules are reloaded
            if {[info exists swprocessing]} {
               set urequnqry [list $modname]
            } else {
               set urequnqry [concat $depunlist [list $modname]]
            }

# UReqUn: Useless Requirement to Unload (autoloaded requirements
            # of modname or DepUn modules not required by any remaining mods)
            set urequnlist [getUnloadableLoadedModuleList $urequnqry]
            reportDebug "urequn mod list is '$urequnlist'"

# DepRe: Dependent to Reload (modules optionnaly dependent or in
            # conflict with modname, DepUn or UReqUn modules + modules
            # dependent of a module part of this DepRe batch)
            set deprelist [getDependentLoadedModuleList [concat $urequnlist\
               $depunlist [list $modname]] 0 0 1 0 1 1]
            reportDebug "depre mod list is '$deprelist'"

# DepUn mods are merged into the DepRe list as an attempt to
            # reload these DepUn mods is made once switched-to mod loaded
            if {[info exists swprocessing]} {
               set deprelist [sortModulePerLoadedAndDepOrder [concat\
                  $depunlist $deprelist] 1]
               set depunlist {}
            }

# Reload of all DepRe mods, as they may adapt from the mod unloads
            # happening here. First perform unload phase of the reload, prior
            # mod unloads to ensure these dependent mods are unloaded with the
            # same loaded prereq as when they were loaded. Avoid modules not
            # satisfying their constraint.
            if {[llength $deprelist] > 0} {
               array set isuasked [reloadModuleListUnloadPhase deprelist\
                  [getForce] {Unload of dependent _MOD_ failed} depun]
            }

# DepUn modules unload prior main mod unload
            if {[llength $depunlist] > 0} {
               foreach unmod [lreverse $depunlist] {
                  if {[cmdModuleUnload depun match 0 0 0 0 $unmod]} {
                     # stop if one unload fails unless force mode enabled
                     set errMsg "Unload of dependent $unmod failed"
                     if {[getForce] || $force} {
                        reportWarning $errMsg 1
                     } else {
                        knerror $errMsg
                     }
                  }
               }
            }
         }

# register this evaluation on the main one that triggered it (prior
         # unload evaluation to report correct order with other evaluations)
         registerModuleEval $context $modname

if {[execute-modulefile $modfile $modname $mod]} {
            break
         }

# get module position in loaded list to remove corresponding loaded
         # modulefile (entry at same position in _LMFILES_)
         # need the unfiltered loaded module list to get correct index
         set lmidx [lsearch -exact [getLoadedModuleList 0] $modname]
         unload-path LOADEDMODULES $modname
         unload-path --index _LMFILES_ $lmidx
         if {![isModuleUserAsked $modname]} {
            unload-path MODULES_LMNOTUASKED $modname
         }
         # update cache arrays
         unsetLoadedModule $modname $modfile

# unregister declared conflict
         if {[set modcon [getLoadedConflict $modname 1]] ne {}} {
            unload-path MODULES_LMCONFLICT $modcon
         }
         unsetLoadedConflict $modname

# unset prereq declared for this module
         if {[llength [set modpre [getLoadedPrereq $modname]]] > 0} {
            unload-path MODULES_LMPREREQ [getLoadedPrereq $modname 1]
         }
         unsetLoadedPrereq $modname

# unset alternative names declared for this module
         if {[llength [set modalt [getLoadedAltname $modname]]] >0} {
            unload-path MODULES_LMALTNAME [getLoadedAltname $modname 1]
         }
         unsetLoadedAltname $modname

if {[getConf auto_handling] && $auto} {
            # UReqUn modules unload now DepUn+main mods are unloaded
            if {[llength $urequnlist] > 0} {
               set urequnlist [lreverse $urequnlist]
               for {set i 0} {$i < [llength $urequnlist]} {incr i 1} {
                  set unmod [lindex $urequnlist $i]
                  if {[cmdModuleUnload urequn match 0 0 0 0 $unmod]} {
                     # just warn if UReqUn module cannot be unloaded, main
                     # unload process continues, just the UReqUn modules that
                     # are required by unmod (whose unload failed) are
                     # withdrawn from UReqUn module list
                     reportWarning "Unload of useless requirement $unmod\
                        failed" 1
                     lassign [getDiffBetweenList $urequnlist\
                        [getRequiredLoadedModuleList [list $unmod]]]\
                        urequnlist
                  }
               }
            }

# DepRe modules load phase now DepUn+UReqUn+main mods are unloaded
            # except if a switch action is ongoing as this DepRe load phase
            # will occur after the new mod load
            if {[llength $deprelist] > 0 && ![info exists swprocessing]} {
               reloadModuleListLoadPhase deprelist [array get isuasked]\
                  [getForce] {Reload of dependent _MOD_ failed} depre
            }
         }

# report a summary of automated evaluations if no error
         reportModuleEval
      } errMsg]] != 0 && $errCode != 4} {
         if {$errMsg ne {}} {
            reportError $errMsg [expr {![info exists errlocalreport]}]
         }
         # report switched-off module unload failure under switch info block
         # unless the above reportError call already put a mesg to this block
         if {[info exists swprocessing] && ($errMsg eq {} || [info exists\
            errlocalreport])} {
            reportError "Unload of switched-off $modname failed" 1
         }
         # rollback settings if some evaluation went wrong
         if {![info exists errharmless]} {
            set ret 1
            restoreSettings
            # remove from successfully evaluated module list
            registerModuleEval $context $modname 1 unload
         }
         unset -nocomplain errlocalreport errharmless
      }
      popSettings

# report all recorded messages for this evaluation
      reportMsgRecord "Unloading [sgr hi $modname]"
      popMsgRecordId
   }
   popMode

return $ret
}

proc cmdModulePurge {} {
   reportDebug called.

# create an eval id to track successful/failed module evaluations
   pushMsgRecordId purge-[getEvalModuleStackDepth] 0

# unload one by one to ensure same behavior whatever auto_handling state
   # force it to handle loaded modules in violation state
   eval cmdModuleUnload unload match 0 1 0 0 [lreverse [getLoadedModuleList]]

popMsgRecordId 0
}

proc cmdModuleReload {args} {
   # reload all loaded modules if no module list passed
   if {[llength $args] == 0} {
      set lmlist [getLoadedModuleList]
   } else {
      set lmlist $args
   }
   reportDebug "reloading $lmlist"

# create an eval id to track successful/failed module evaluations
   pushMsgRecordId reload-[getEvalModuleStackDepth] 0

# no reload of all loaded modules attempt if constraints are violated
   if {[llength $args] == 0 && ![areModuleConstraintsSatisfied]} {
      reportError {Cannot reload modules, some of their constraints are not\
         satistied}
   } else {
      pushSettings
      if {[set errCode [catch {
         # run unload then load-again phases
         array set isuasked [reloadModuleListUnloadPhase lmlist]
         reloadModuleListLoadPhase lmlist [array get isuasked]
      } errMsg]] == 1} {
         # rollback settings if some evaluation went wrong
         restoreSettings
      }
      popSettings
   }

popMsgRecordId 0
}

proc cmdModuleAliases {} {
   # disable error reporting to avoid modulefile errors
   # to mix with avail results
   inhibitErrorReport

# parse paths to fill g_moduleAlias and g_moduleVersion
   foreach dir [getModulePathList exiterronundef] {
      getModules $dir {} 0 {}
   }

reenableErrorReport

set display_list {}
   foreach name [lsort -dictionary [array names ::g_moduleAlias]] {
      # exclude hidden aliases from result
      if {![isModuleHidden $name]} {
         lappend display_list "[sgr al $name] -> $::g_moduleAlias($name)"
      }
   }
   displayElementList Aliases hi sepline 1 0 $display_list

set display_list {}
   foreach name [lsort -dictionary [array names ::g_moduleVersion]] {
      # exclude hidden versions or versions targeting an hidden module
      if {![isModuleHidden $name] && ![isModuleHidden\
         $::g_moduleVersion($name)]} {
         lappend display_list "[sgr sy $name] -> $::g_moduleVersion($name)"
      }
   }
   displayElementList Versions hi sepline 1 0 $display_list
}

proc cmdModuleAvail {show_oneperline show_mtime show_filter search_filter\
   search_match args} {
   if {[llength $args] == 0} {
      lappend args *
   }

if {$show_mtime || $show_oneperline} {
      set one_per_line 1
      set hstyle terse
      set theader_shown 0
      set theader_cols [list hi Package/Alias 39 Versions 19 {Last mod.} 19]
   } else {
      set one_per_line 0
      set hstyle sepline
   }

# set a default filter (do not print dirs with no tag) if none set
   if {$show_filter eq {}} {
      set show_filter noplaindir
   }

# disable error reporting to avoid modulefile errors
   # to mix with avail results
   inhibitErrorReport

foreach mod $args {
      # look if aliases have been defined in the global or user-specific
      # modulerc and display them if any in a dedicated list
      lassign [listModules {} $mod $show_mtime $show_filter [concat\
         $search_filter [list $search_match rc_alias_only wild]]]\
         display_list len_list max_len
      if {[llength $display_list] > 0 && $show_mtime && !$theader_shown} {
         set theader_shown 1
         eval displayTableHeader $theader_cols
      }
      displayElementList {global/user modulerc} hi $hstyle $one_per_line 0\
         $display_list $len_list $max_len

foreach dir [getModulePathList exiterronundef] {
         lassign [listModules $dir $mod $show_mtime $show_filter [concat\
            $search_filter [list $search_match wild]]] display_list len_list\
            max_len
         if {[llength $display_list] > 0 && $show_mtime && !$theader_shown} {
            set theader_shown 1
            eval displayTableHeader $theader_cols
         }
         displayElementList $dir mp $hstyle $one_per_line 0 $display_list\
            $len_list $max_len
      }
   }

reenableErrorReport
}

proc cmdModuleUse {args} {
   reportDebug $args

if {$args eq {}} {
      showModulePath
   } else {
      set pos prepend
      foreach path $args {
         switch -- $path {
            -a - --append - -append {
               set pos append
            }
            -p - --prepend - -prepend {
               set pos prepend
            }
            {} {
               reportError {Directory name empty}
            }
            default {
               # tranform given path in an absolute path to avoid dependency
               # to the current work directory. except if this path starts
               # with a variable reference
               if {[string index $path 0] ne {$}} {
                  set path [getAbsolutePath $path]
               }
               if {[file isdirectory [resolvStringWithEnv $path]]} {
                  pushMode load
                  catch {
                     add-path $pos MODULEPATH $path
                  }
                  popMode
               } else {
                  reportError "Directory '$path' not found"
               }
            }
         }
      }
   }
}

proc cmdModuleUnuse {args} {
   reportDebug $args

if {$args eq {}} {
      showModulePath
   } else {
      foreach path $args {
         # get current module path list
         # no absolute path conversion for the moment
         if {![info exists modpathlist]} {
            set modpathlist [getModulePathList returnempty 0 0]
         }

# skip empty string
         if {$path eq {}} {
            reportError {Directory name empty}
            continue
         }

# transform given path in an absolute path which should have been
         # registered in the MODULEPATH env var. however for compatibility
         # with previous behavior where relative paths were registered in
         # MODULEPATH given path is first checked against current path list
         set abspath [getAbsolutePath $path]
         if {[isInList $modpathlist $path]} {
            set unusepath $path
         } elseif {[isInList $modpathlist $abspath]} {
            set unusepath $abspath
         } else {
            set unusepath {}
         }

if {$unusepath ne {}} {
            pushMode unload
            catch {
               unload-path MODULEPATH $unusepath
            }
            popMode

# refresh path list after unload
            set modpathlist [getModulePathList returnempty 0 0]
            if {[isInList $modpathlist $unusepath]} {
               reportWarning "Did not unuse $unusepath"
            }
         }
      }
   }
}

proc cmdModuleAutoinit {} {
   reportDebug called.

# flag to make renderSettings define the module command
   set ::g_autoInit 1

# initialize env variables around module command
   pushMode load

# register command location
   setenv MODULES_CMD [getAbsolutePath $::argv0]

# define current Modules version if versioning enabled
   #if {![info exists ::env(MODULE_VERSION)]} {
   #   setenv MODULE_VERSION 4.5.2
   #   setenv MODULE_VERSION_STACK 4.5.2
   #}

# initialize MODULEPATH and LOADEDMODULES if found unset
   if {![info exists ::env(MODULEPATH)]} {
      setenv MODULEPATH {}
   }
   if {![info exists ::env(LOADEDMODULES)]} {
      setenv LOADEDMODULES {}
   }

# initialize user environment if found undefined (both MODULEPATH and
   # LOADEDMODULES empty)
   if {$::env(MODULEPATH) eq {} && $::env(LOADEDMODULES) eq {}} {
      # set modpaths defined in modulespath config file if it exists, use file
      # in etcdir if it exists, dot file in initdir elsewhere
      set modulespath [expr {[file exists /etc/environment-modules/modulespath] ?\
         {/etc/environment-modules/modulespath} : {/usr/share/Modules/init/.modulespath}}]
      if {[file readable $modulespath]} {
         set fdata [split [readFile $modulespath] \n]
         foreach fline $fdata {
            if {[regexp {^\s*(.*?)\s*(#.*|)$} $fline match patharg] == 1\
               && $patharg ne {}} {
               eval cmdModuleUse --append [split $patharg :]
            }
         }
      }

# source initialization modulerc if any and if no env already initialized
      # use initrc file in etcdir if any, modulerc file in initdir otherwise
      set initrc [expr {[file exists /etc/environment-modules/initrc] ? {/etc/environment-modules/initrc} :\
         {/usr/share/Modules/init/modulerc}}]
      if {[file exists $initrc]} {
         cmdModuleSource $initrc
      }
   }

# default MODULESHOME
   setenv MODULESHOME [getConf home]

# define Modules init script as shell startup file
   if {[getConf set_shell_startup] && [isInList [list sh csh fish]\
      $::g_shellType]} {
      # setup ENV variables to get module defined in sub-shells (works for
      # 'sh' and 'ksh' in interactive mode and 'sh' (zsh-compat), 'bash' and
      # 'ksh' (zsh-compat) in non-interactive mode.
      setenv ENV /usr/share/Modules/init/profile.sh
      setenv BASH_ENV /usr/share/Modules/init/bash
   }

popMode
}

proc cmdModuleInit {args} {
   set init_cmd [lindex $args 0]
   set init_list [lrange $args 1 end]
   set notdone 1
   set nomatch 1

reportDebug $args

# Define startup files for each shell
   set files(csh) [list .modules .cshrc .cshrc_variables .login]
   set files(tcsh) [list .modules .tcshrc .cshrc .cshrc_variables .login]
   set files(sh) [list .modules .bash_profile .bash_login .profile .bashrc]
   set files(bash) $files(sh)
   set files(ksh) $files(sh)
   set files(fish) [list .modules .config/fish/config.fish]
   set files(zsh) [list .modules .zshrc .zshenv .zlogin]

# Process startup files for this shell
   set current_files $files($::g_shell)
   foreach filename $current_files {
      if {$notdone} {
         set filepath $::env(HOME)
         append filepath / $filename

reportDebug "Looking at $filepath"
         if {[file readable $filepath] && [file isfile $filepath]} {
            set newinit {}
            set thismatch 0

foreach curline [split [readFile $filepath] \n] {
               # Find module load/add command in startup file 
               set comments {}
               if {$notdone && [regexp {^([ \t]*module[ \t]+(load|add)[\
                  \t]*)(.*)} $curline match cmd subcmd modules]} {
                  set nomatch 0
                  set thismatch 1
                  regexp {([ \t]*\#.+)} $modules match comments
                  regsub {\#.+} $modules {} modules

# remove existing references to the named module from
                  # the list Change the module command line to reflect the 
                  # given command
                  switch -- $init_cmd {
                     list {
                        if {![info exists notheader]} {
                           report "$::g_shell initialization file\
                              \$HOME/$filename loads modules:"
                           set notheader 0
                        }
                        report \t$modules
                     }
                     add {
                        foreach newmodule $init_list {
                           set modules [replaceFromList $modules $newmodule]
                        }
                        lappend newinit "$cmd$modules $init_list$comments"
                        # delete new modules in potential next lines
                        set init_cmd rm
                     }
                     prepend {
                        foreach newmodule $init_list {
                           set modules [replaceFromList $modules $newmodule]
                        }
                        lappend newinit "$cmd$init_list $modules$comments"
                        # delete new modules in potential next lines
                        set init_cmd rm
                     }
                     rm {
                        set oldmodcount [llength $modules]
                        foreach oldmodule $init_list {
                           set modules [replaceFromList $modules $oldmodule]
                        }
                        set modcount [llength $modules]
                        lappend newinit [expr {$modcount > 0 ?\
                           "$cmd$modules$comments" : [string trim $cmd]}]
                        if {$oldmodcount > $modcount} {
                           set notdone 0
                        }
                     }
                     switch {
                        set oldmodule [lindex $init_list 0]
                        set newmodule [lindex $init_list 1]
                        set newmodules [replaceFromList $modules\
                           $oldmodule $newmodule]
                        lappend newinit $cmd$newmodules$comments
                        if {$modules ne $newmodules} {
                           set notdone 0
                        }
                     }
                     clear {
                        lappend newinit [string trim $cmd]
                     }
                  }
               } elseif {$curline ne {}} {
                  # copy the line from the old file to the new
                  lappend newinit $curline
               }
            }

if {$init_cmd ne {list} && $thismatch} {
               reportDebug "Writing $filepath"
               if {[catch {
                  set fid [open $filepath w]
                  puts $fid [join $newinit \n]
                  close $fid
               } errMsg ]} {
                  reportErrorAndExit "Init file $filepath cannot be\
                     written.\n$errMsg"
               }
            }
         }
      }
   }

# quit in error if command was not performed due to no match
   if {$nomatch && $init_cmd ne {list}} {
      reportErrorAndExit "Cannot find a 'module load' command in any of the\
         '$::g_shell' startup files"
   }
}

# provide access to modulefile specific commands from the command-line, making
# them standing as a module sub-command (see module procedure)
proc cmdModuleResurface {cmd args} {
   reportDebug "cmd='$cmd', args='$args'"

pushMode load
   pushCommandName $cmd

# run modulefile command and get its result
   if {[catch {eval $cmd $args} res]} {
      # report error if any and return false
      reportError $res
   } else {
      # register result depending of return kind (false or text)
      switch -- $cmd {
         module-info {
            set ::g_return_text $res
         }
         default {
            if {$res == 0} {
               # render false if command returned false
               set ::g_return_false 1
            }
         }
      }
   }

popCommandName
   popMode
}

proc cmdModuleTest {args} {
   reportDebug "testing $args"

pushMode test
   set first_report 1
   foreach mod $args {
      lassign [getPathToModule $mod] modfile modname
      if {$modfile ne {}} {
         # only one separator lines between 2 modules
         if {$first_report} {
            displaySeparatorLine
            set first_report 0
         }
         report "Module Specific Test for [sgr hi $modfile]:\n"
         execute-modulefile $modfile $modname $mod
         displaySeparatorLine
      }
   }
   popMode
}

proc cmdModuleClear {{doit {}}} {
   reportDebug "($doit)"
   # fetch confirmation if no arg passed and force mode disabled
   if {$doit eq {} && ![getForce]} {
      # ask for it if stdin is attached to a terminal
      if {![catch {fconfigure stdin -mode}]} {
         report "Are you sure you want to clear all loaded modules!? \[n\] " 1
         flush $::reportfd
      }
      # fetch stdin content even if not attached to terminal in case some
      # content has been piped to this channel
      set doit [gets stdin]
   }

# should be confirmed or forced to proceed
   if {[string equal -nocase -length 1 $doit y] || [getForce]} {
      set vartoclear [list LOADEDMODULES MODULES_LMALTNAME MODULES_LMCONFLICT\
         MODULES_LMNOTUASKED MODULES_LMPREREQ _LMFILES_]

# add any reference counter variable to the list to unset
      set vartoclear [concat $vartoclear [array names ::env -glob *_modshare]\
         [array names ::env -glob MODULES_MODSHARE_*]]

# unset all Modules runtime variables
      pushMode load
      foreach var $vartoclear {
         unset-env $var
      }
      popMode
   } else {
      reportInfo "Modules runtime information were not cleared"
   }
}

proc cmdModuleConfig {dump_state args} {
   # parse arguments
   set nameunset 0
   switch -- [llength $args] {
      1 {
         lassign $args name
      }
      2 {
         lassign $args name value
         # check if configuration should be set or unset
         if {$name eq {--reset}} {
            set name $value
            set nameunset 1
            unset value
         }
      }
   }

reportDebug "dump_state='$dump_state', reset=$nameunset,\
      name=[expr {[info exists name] ? "'$name'" : {<undef>}}], value=[expr\
      {[info exists value] ? "'$value'" : {<undef>}}]"

foreach option [array names ::g_config_defs] {
      lassign $::g_config_defs($option) confvar($option) defval\
         conflockable($option) confvalid($option) vtrans
      set confval($option) [getConf $option <undef>]
      set confvtrans($option) {}
      for {set i 0} {$i < [llength $vtrans]} {incr i} {
         lappend confvtrans($option) [lindex $vtrans $i] [lindex\
            $confvalid($option) $i]
      }
   }

# catch any environment variable set for modulecmd run-time execution
   foreach runenvvar [array names ::env -glob MODULES_RUNENV_*] {
      set runenvconf [string tolower [string range $runenvvar 8 end]]
      set confval($runenvconf) [get-env $runenvvar]
      # enable modification of runenv conf
      set confvar($runenvconf) $runenvvar
      set confvalid($runenvconf) {}
      set conflockable($runenvconf) {}
      set confvtrans($runenvconf) {}
   }

if {[info exists name] && ![info exists confval($name)]} {
      reportErrorAndExit "Configuration option '$name' does not exist"
   # set configuration
   } elseif {[info exists name] && ($nameunset || [info exists value])} {
      if {$confvar($name) eq {}} {
         reportErrorAndExit "Configuration option '$name' cannot be altered"
      } elseif {$conflockable($name) eq {1} && [isConfigLocked $name]} {
         reportErrorAndExit "Configuration option '$name' is locked"
      } elseif {$nameunset} {
         # unset configuration variable
         pushMode load
         unsetenv $confvar($name)
         popMode
      } elseif {[llength $confvalid($name)] > 0 && [notInList\
         $confvalid($name) $value]} {
         reportErrorAndExit "Valid values for configuration option '$name'\
            are: $confvalid($name)"
      } else {
         # effectively set configuration variable
         pushMode load
         setenv $confvar($name) $value
         popMode
      }
      # clear cached value for config if any
      unsetConf $name
   # report configuration
   } else {
      reportVersion
      reportSeparateNextContent
      displayTableHeader hi {Config. name} 24 {Value (set by if default\
         overridden)} 54

# report all configs or just queried one
      if {[info exists name]} {
         set varlist [list $name]
      } else {
         set varlist [lsort [array names confval]]
      }

foreach var $varlist {
         set valrep [displayConfig $confval($var) $confvar($var) [info exists\
            ::asked_$var] $confvtrans($var) [expr {$conflockable($var) eq {1}\
            && [isConfigLocked $var]}]]
         append displist [format {%-25s %s} $var $valrep] \n
      }
      report $displist 1
      reportSeparateNextContent

if {$dump_state} {
         displayTableHeader hi {State name} 24 {Value} 54
         # define each attribute/fetched state value pair
         set state_list [list\
            cmdline "$::argv0 $::argv"\
            extra_siteconfig_loaded [info exists ::g_extra_siteconfig_loaded]\
            force [getForce]\
            is_stderr_tty [isStderrTty]\
            is_win [isWin]\
            machine [uname machine]\
            os "[uname sysname] [uname release]"\
            pager_started $::start_pager\
            paginate $::use_pager\
            path_separator [getPathSeparator]\
            rc_loaded [expr {[info exists ::g_rc_loaded] ? $::g_rc_loaded :\
               {<undef>}}]\
            siteconfig_loaded [info exists ::g_siteconfig_loaded]\
            shell $::g_shell\
            shelltype $::g_shellType\
            subcmd $::command\
            subcmd_args $::otherargv\
            tcl_ext_lib_loaded [info exists ::g_tclextlib_loaded]\
            tcl_version [info patchlevel]\
            term_columns [getTtyColumns]]

unset displist
         foreach {var val} $state_list {
            append displist [format {%-25s %s} $var $val] \n
         }
         report $displist 1
         reportSeparateNextContent

# report environment variable set related to Modules
         displayTableHeader hi {Env. variable} 24 {Value} 54
         set envvar_list {}
         foreach var [list LOADEDMODULES _LMFILES_ MODULE* *_modshare\
            *_modquar *_module*] {
            set envvar_list [concat $envvar_list [array names ::env -glob\
               $var]]
         }
         unset displist
         foreach var [lsort -unique $envvar_list] {
            append displist [format {%-25s %s} $var $::env($var)] \n
         }
         report $displist 1
      }
   }
}

proc cmdMlHelp {} {
   reportVersion
   report {Usage: ml [options] [command] [args ...]
       ml [options] [[-]modulefile ...]

Examples:
  ml                 equivalent to: module list
  ml foo bar         equivalent to: module load foo bar
  ml -foo -bar baz   equivalent to: module unload foo bar; module load baz
  ml avail -t        equivalent to: module avail -t

See 'module --help' to get available commands and options.}
}

proc cmdModuleHelp {args} {
   pushMode help
   set first_report 1
   foreach arg $args {
      lassign [getPathToModule $arg] modfile modname

if {$modfile ne {}} {
         # only one separator lines between 2 modules
         if {$first_report} {
            displaySeparatorLine
            set first_report 0
         }
         report "Module Specific Help for [sgr hi $modfile]:\n"
         execute-modulefile $modfile $modname $arg
         displaySeparatorLine
      }
   }
   popMode
   if {[llength $args] == 0} {
      reportVersion
      report {Usage: module [options] [command] [args ...]

Loading / Unloading commands:
  add | load      modulefile [...]  Load modulefile(s)
  rm | unload     modulefile [...]  Remove modulefile(s)
  purge                             Unload all loaded modulefiles
  reload | refresh                  Unload then load all loaded modulefiles
  switch | swap   [mod1] mod2       Unload mod1 and load mod2

Listing / Searching commands:
  list            [-t|-l|-j]        List loaded modules
  avail   [-d|-L] [-t|-l|-j] [-S|-C] [--indepth|--no-indepth] [mod ...]
                                    List all or matching available modules
  aliases                           List all module aliases
  whatis  [-j]    [modulefile ...]  Print whatis information of modulefile(s)
  apropos | keyword | search [-j] str
                                    Search all name and whatis containing str
  is-loaded       [modulefile ...]  Test if any of the modulefile(s) are loaded
  is-avail        modulefile [...]  Is any of the modulefile(s) available
  info-loaded     modulefile        Get full name of matching loaded module(s)

Collection of modules handling commands:
  save            [collection|file] Save current module list to collection
  restore         [collection|file] Restore module list from collection or file
  saverm          [collection]      Remove saved collection
  saveshow        [collection|file] Display information about collection
  savelist        [-t|-l|-j]        List all saved collections
  is-saved        [collection ...]  Test if any of the collection(s) exists

Shell's initialization files handling commands:
  initlist                          List all modules loaded from init file
  initadd         modulefile [...]  Add modulefile to shell init file
  initrm          modulefile [...]  Remove modulefile from shell init file
  initprepend     modulefile [...]  Add to beginning of list in init file
  initswitch      mod1 mod2         Switch mod1 with mod2 from init file
  initclear                         Clear all modulefiles from init file

Environment direct handling commands:
  prepend-path [-d c] var val [...] Prepend value to environment variable
  append-path [-d c] var val [...]  Append value to environment variable
  remove-path [-d c] var val [...]  Remove value from environment variable

Other commands:
  help            [modulefile ...]  Print this or modulefile(s) help info
  display | show  modulefile [...]  Display information about modulefile(s)
  test            [modulefile ...]  Test modulefile(s)
  use     [-a|-p] dir [...]         Add dir(s) to MODULEPATH variable
  unuse           dir [...]         Remove dir(s) from MODULEPATH variable
  is-used         [dir ...]         Is any of the dir(s) enabled in MODULEPATH
  path            modulefile        Print modulefile path
  paths           modulefile        Print path of matching available modules
  clear           [-f]              Reset Modules-specific runtime information
  source          scriptfile [...]  Execute scriptfile(s)
  config [--dump-state|name [val]]  Display or set Modules configuration

Switches:
  -t | --terse    Display output in terse format
  -l | --long     Display output in long format
  -j | --json     Display output in JSON format
  -d | --default  Only show default versions available
  -L | --latest   Only show latest versions available
  -S | --starts-with
                  Search modules whose name begins with query string
  -C | --contains Search modules whose name contains query string
  -i | --icase    Case insensitive match
  -a | --append   Append directory to MODULEPATH
  -p | --prepend  Prepend directory to MODULEPATH
  --auto          Enable automated module handling mode
  --no-auto       Disable automated module handling mode
  -f | --force    By-pass dependency consistency or confirmation dialog

Options:
  -h | --help     This usage info
  -V | --version  Module version
  -D | --debug    Enable debug messages
  -v | --verbose  Enable verbose messages
  -s | --silent   Turn off error, warning and informational messages
  --paginate      Pipe mesg output into a pager if stream attached to terminal
  --no-pager      Do not pipe message output into a pager
  --color[=WHEN]  Colorize the output; WHEN can be 'always' (default if
                  omitted), 'auto' or 'never'}
   }
}

########################################################################
# main program

# needed on a gentoo system. Shouldn't hurt since it is
# supposed to be the default behavior
fconfigure stderr -translation auto

if {[catch {
   # parse all command-line arguments before doing any action, no output is
   # made during argument parse to wait for potential paging to be setup
   set show_help 0
   set show_version 0
   set command {}
   set otherargv {}
   reportDebug "CALLING $argv0 $argv"

# Load extension library if enabled
   if {[file readable [getConf tcl_ext_lib]]} {
      reportDebug "Load Tcl extension library ([getConf tcl_ext_lib])"
      load [file normalize [getConf tcl_ext_lib]] Envmodules
      set g_tclextlib_loaded 1
   }
   # use fallback procs if extension library is not loaded
   if {[info commands readFile] eq {}} {
      rename ::__readFile ::readFile
      rename ::__getFilesInDirectory ::getFilesInDirectory
   }

# source site configuration script if any
   sourceSiteConfig

# Parse shell
   set g_shell [lindex $argv 0]
   switch -- $g_shell {
      sh - bash - ksh - zsh {
         set g_shellType sh
      }
      csh - tcsh {
         set g_shellType csh
      }
      fish - cmd - tcl - perl - python - ruby - lisp - cmake - r {
         set g_shellType $g_shell
      }
      default {
         reportErrorAndExit "Unknown shell type \'($g_shell)\'"
      }
   }

# extract options and command switches from other args
   set extraargv {}
   set ddelimarg 0
   # split first arg if multi-word string detected for compat with previous
   # doc on module usage with scripting language: module('load mod1 mod2')
   set argtoparse [if {[llength [lindex $argv 1]] > 1} {concat [split [lindex\
      $argv 1]] [lrange $argv 2 end]} {lrange $argv 1 end}]
   foreach arg $argtoparse {
      if {[info exists ignore_next_arg]} {
         unset ignore_next_arg
      } else {
         switch -glob -- $arg {
            -D - --debug {
               set asked_verbosity debug
            }
            -s - --silent {
               set asked_verbosity silent
            }
            -v - --verbose {
               set asked_verbosity verbose
            }
            --help - -h {
               set show_help 1
            }
            -V - --version {
               set show_version 1
            }
            --paginate {
               set asked_use_pager 1
            }
            --no-pager {
               set asked_use_pager 0
            }
            --auto {
               set asked_auto_handling 1
            }
            --no-auto {
               set asked_auto_handling 0
            }
            -f - --force {
               set asked_force 1
            }
            --color* {
               set asked_color [string range $arg 8 end]
               if {$asked_color eq {}} {
                  set asked_color always
               } elseif {[notInList [lindex $::g_config_defs(color) 3] $asked_color]} {
                  unset asked_color
               }
            }
            -t - --terse - -l - --long - --default - -L - --latest - -S -\
            --starts-with - -C - --contains - -j - --json {
               # command-specific switches that can for compatibility be
               # passed before the command name, so add them to a specific
               # arg list to ensure command name as first position argument
               lappend extraargv $arg
            }
            -d {
               # in case of *-path command, -d means --delim
               if {$ddelimarg} {
                  lappend otherargv $arg
               } else {
                  lappend extraargv $arg
               }
            }
            -a - --append - -append - -p - --prepend - -prepend - --delim -\
            -delim - --delim=* - -delim=* - --duplicates - --index -\
            --notuasked - --indepth - --no-indepth - --dump-state - --reset {
               # command-specific switches interpreted later on
               lappend otherargv $arg
            }
            append-path - prepend-path - remove-path {
               # detect *-path commands to say -d means --delim, not --default
               set ddelimarg 1
               lappend otherargv $arg
            }
            -i - --icase {
               set asked_icase always
            }
            --human - -c - --create - --userlvl=* {
               # ignore C-version specific option, no error only warning
               reportWarning "Unsupported option '$arg'"
            }
            -u - --userlvl {
               reportWarning "Unsupported option '$arg'"
               # also ignore argument value
               set ignore_next_arg 1
            }
            {-} - {--} - {--*} {
               reportErrorAndExit "Invalid option '$arg'\nTry 'module --help'\
                  for more information."
            }
            -* {
               # spare argument if ml command is called
               if {[lindex $otherargv 0] ne {ml}} {
                  reportErrorAndExit "Invalid option '$arg'\nTry 'module\
                     --help' for more information."
               } else {
                  lappend otherargv $arg
               }
            }
            default {
               lappend otherargv $arg
            }
         }
      }
   }

set command [lindex $otherargv 0]
   set otherargv [concat [lreplace $otherargv 0 0] $extraargv]
   # call ml frontend if it is asked command
   if {$command eq {ml}} {
      set execcmdlist [concat [list ml] $otherargv]
   } else {
      set execcmdlist [concat [list module $command] $otherargv]
   }

# now options are known initialize error report (start pager if enabled)
   initErrorReport

# put back quarantine variables in env, if quarantine mechanism supported
   if {[getConf run_quarantine] ne {} && $g_shellType ne {csh}} {
      foreach var [split [getConf run_quarantine]] {
         # check variable name is valid
         if {[regexp {^[A-Za-z_][A-Za-z0-9_]*$} $var]} {
            set quarvar ${var}_modquar
            # put back value
            if {[info exists env($quarvar)]} {
               reportDebug "Release '$var' environment variable from\
                  quarantine ($env($quarvar))"
               set env($var) $env($quarvar)
               unset env($quarvar)
            # or unset env var if no value found in quarantine
            } elseif {[info exists env($var)]} {
               reportDebug "Unset '$var' environment variable after\
                  quarantine"
               unset env($var)
            }
         } elseif {[string length $var] > 0} {
            reportWarning "Bad variable name set in MODULES_RUN_QUARANTINE\
               ($var)"
         }
      }
   }

if {$show_help} {
      if {$command eq {ml}} {
         cmdMlHelp
      } else {
         cmdModuleHelp
      }
      cleanupAndExit 0
   }
   if {$show_version} {
      reportVersion
      cleanupAndExit 0
   }

# no modulefile is currently being interpreted
   pushModuleFile {}

# eval needed to pass otherargv as list to module proc
   eval $execcmdlist
} errMsg ]} {
   # re-enable error report in case it was previously inhibited
   reenableErrorReport
   # remove any message record id to render next error
   clearAllMsgRecordId
   # render error if not done yet
   if {$errorCode ne {MODULES_ERR_RENDERED}} {
      raiseErrorCount
      renderFalse
   }
   # report stack trace in addition to the error message if error is unknown
   if {[notInList [list MODULES_ERR_RENDERED MODULES_ERR_KNOWN] $errorCode]} {
      set errMsg "$errorInfo\n[sgr hi {Please report this issue at\
         https://github.com/cea-hpc/modules/issues}]"
   }
   reportError $errMsg
   # init error report here in case the error raised before the regular init
   initErrorReport
   cleanupAndExit 1
}

cleanupAndExit 0

# ;;; Local Variables: ***
# ;;; mode:tcl ***
# ;;; End: ***
# vim:set tabstop=3 shiftwidth=3 expandtab autoindent:

Cancel