1*ebef2f37SMichael Walsh# This file is an aid in sourcing other tcl files. It provides the following 2*ebef2f37SMichael Walsh# advantages: 3*ebef2f37SMichael Walsh# - It shortens the number of lines of code needed to intelligently source 4*ebef2f37SMichael Walsh# files. 5*ebef2f37SMichael Walsh# - Its my_source procedure provides several benefits (see my_source prolog 6*ebef2f37SMichael Walsh# below). 7*ebef2f37SMichael Walsh 8*ebef2f37SMichael Walsh# By convention, this file, or a link to this file, must exist in one of the 9*ebef2f37SMichael Walsh# directories named in the PATH environment variable. 10*ebef2f37SMichael Walsh 11*ebef2f37SMichael Walsh# Example use: 12*ebef2f37SMichael Walsh# source [exec bash -c "which source.tcl"] 13*ebef2f37SMichael Walsh# my_source [list print.tcl opt.tcl] 14*ebef2f37SMichael Walsh 15*ebef2f37SMichael Walshset path_list [split $::env(PATH) :] 16*ebef2f37SMichael Walsh 17*ebef2f37SMichael Walsh 18*ebef2f37SMichael Walshproc tcl_which { file_name } { 19*ebef2f37SMichael Walsh 20*ebef2f37SMichael Walsh # Search the PATH environment variable for the first executable instance of 21*ebef2f37SMichael Walsh # $file_name and return the full path. On failure, return a blank string. 22*ebef2f37SMichael Walsh 23*ebef2f37SMichael Walsh # This procedure runs much faster than [exec bash -c "which $file_name"]. 24*ebef2f37SMichael Walsh 25*ebef2f37SMichael Walsh # Description of argument(s): 26*ebef2f37SMichael Walsh # file_name The name of the file to be found. 27*ebef2f37SMichael Walsh 28*ebef2f37SMichael Walsh global path_list 29*ebef2f37SMichael Walsh 30*ebef2f37SMichael Walsh foreach path $path_list { 31*ebef2f37SMichael Walsh set file_path $path/$file_name 32*ebef2f37SMichael Walsh if { [file executable $file_path] } { return $file_path } 33*ebef2f37SMichael Walsh } 34*ebef2f37SMichael Walsh 35*ebef2f37SMichael Walsh return "" 36*ebef2f37SMichael Walsh 37*ebef2f37SMichael Walsh} 38*ebef2f37SMichael Walsh 39*ebef2f37SMichael Walsh 40*ebef2f37SMichael Walshif { ![info exists sourced_files] } { 41*ebef2f37SMichael Walsh set sourced_files [list] 42*ebef2f37SMichael Walsh} 43*ebef2f37SMichael Walsh 44*ebef2f37SMichael Walshproc my_source { source_files } { 45*ebef2f37SMichael Walsh 46*ebef2f37SMichael Walsh # Source each file in the source_files list. 47*ebef2f37SMichael Walsh 48*ebef2f37SMichael Walsh # This procedure provides the following benefits verses just using the 49*ebef2f37SMichael Walsh # source command directly. 50*ebef2f37SMichael Walsh # - Use of PATH environment variable to locate files. 51*ebef2f37SMichael Walsh # - Better error handling. 52*ebef2f37SMichael Walsh # - Will only source each file once. 53*ebef2f37SMichael Walsh # - If "filex" is not found, this procedure will try to find "filex.tcl". 54*ebef2f37SMichael Walsh 55*ebef2f37SMichael Walsh # Description of argument(s): 56*ebef2f37SMichael Walsh # source_files A list of file names to be sourced. 57*ebef2f37SMichael Walsh 58*ebef2f37SMichael Walsh global sourced_files 59*ebef2f37SMichael Walsh global env 60*ebef2f37SMichael Walsh 61*ebef2f37SMichael Walsh foreach file_name $source_files { 62*ebef2f37SMichael Walsh 63*ebef2f37SMichael Walsh set file_path [tcl_which $file_name] 64*ebef2f37SMichael Walsh if { $file_path == "" } { 65*ebef2f37SMichael Walsh # Does the user specify a ".tcl" extension for this file? 66*ebef2f37SMichael Walsh set tcl_ext [regexp -expanded {\.tcl$} $file_name] 67*ebef2f37SMichael Walsh if { $tcl_ext } { 68*ebef2f37SMichael Walsh append message "**ERROR** Programmer error - Failed to find" 69*ebef2f37SMichael Walsh append message " \"${file_name}\" source file:\n" 70*ebef2f37SMichael Walsh append message $::env(PATH) 71*ebef2f37SMichael Walsh puts stderr $message 72*ebef2f37SMichael Walsh exit 1 73*ebef2f37SMichael Walsh } 74*ebef2f37SMichael Walsh 75*ebef2f37SMichael Walsh set file_path [tcl_which ${file_name}.tcl] 76*ebef2f37SMichael Walsh if { $file_path == "" } { 77*ebef2f37SMichael Walsh append message "**ERROR** Programmer error - Failed to find either" 78*ebef2f37SMichael Walsh append message " \"${file_name}\" or \"${file_name}.tcl\" source file:" 79*ebef2f37SMichael Walsh append message $::env(PATH) 80*ebef2f37SMichael Walsh puts stderr $message 81*ebef2f37SMichael Walsh exit 1 82*ebef2f37SMichael Walsh } 83*ebef2f37SMichael Walsh } 84*ebef2f37SMichael Walsh 85*ebef2f37SMichael Walsh # Adjust name (in case we found the .tcl version of a file). 86*ebef2f37SMichael Walsh set full_file_name "[file tail $file_path]" 87*ebef2f37SMichael Walsh 88*ebef2f37SMichael Walsh # Have we already attempted to source this file? 89*ebef2f37SMichael Walsh if { [lsearch -exact $sourced_files $full_file_name] != -1 } { continue } 90*ebef2f37SMichael Walsh # Add the file name to the list of sourced files. It is important to add 91*ebef2f37SMichael Walsh # this file to the list BEFORE we source the file. Otherwise, if there is 92*ebef2f37SMichael Walsh # a recursive source (a sources b, b sources c, c sources a), we will get 93*ebef2f37SMichael Walsh # into an infinite loop. 94*ebef2f37SMichael Walsh lappend sourced_files $full_file_name 95*ebef2f37SMichael Walsh 96*ebef2f37SMichael Walsh if { [catch { uplevel 1 source $file_path } result] } { 97*ebef2f37SMichael Walsh append message "**ERROR** Programmer error - Failed to source" 98*ebef2f37SMichael Walsh append message " \"${file_path}\":\n${result}" 99*ebef2f37SMichael Walsh puts stderr $message 100*ebef2f37SMichael Walsh 101*ebef2f37SMichael Walsh exit 1 102*ebef2f37SMichael Walsh } 103*ebef2f37SMichael Walsh } 104*ebef2f37SMichael Walsh 105*ebef2f37SMichael Walsh} 106