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