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